src/.gdbinit

   1 # Copyright (C) 1992-1998, 2000-2011  Free Software Foundation, Inc.
   2 #
   3 # This file is part of GNU Emacs.
   4 #
   5 # GNU Emacs is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3, or (at your option)
   8 # any later version.
   9 #
  10 # GNU Emacs is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with GNU Emacs; see the file COPYING.  If not, write to the
  17 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  18 # Boston, MA 02110-1301, USA.
  19
  20 # Force loading of symbols, enough to give us gdb_valbits etc.
  21 set main
  22 # With some compilers, we need this to give us struct Lisp_Symbol etc.:
  23 set Fmake_symbol
  24
  25 # Find lwlib source files too.
  26 dir ../lwlib
  27 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
  28
  29 # Don't enter GDB when user types C-g to quit.
  30 # This has one unfortunate effect: you can't type C-c
  31 # at the GDB to stop Emacs, when using X.
  32 # However, C-z works just as well in that case.
  33 handle 2 noprint pass
  34
  35 # Make it work like SIGINT normally does.
  36 handle SIGTSTP nopass
  37
  38 # Pass on user signals
  39 handle SIGUSR1 noprint pass
  40 handle SIGUSR2 noprint pass
  41
  42 # Don't pass SIGALRM to Emacs.  This makes problems when
  43 # debugging.
  44 handle SIGALRM ignore
  45
  46 # $valmask and $tagmask are mask values set up by the xreload macro below.
  47
  48 # Use $bugfix so that the value isn't a constant.
  49 # Using a constant runs into GDB bugs sometimes.
  50 define xgetptr
  51   set $bugfix = $arg0
  52   set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
  53 end
  54
  55 define xgetint
  56   set $bugfix = $arg0
  57   set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
  58 end
  59
  60 define xgettype
  61   set $bugfix = $arg0
  62   set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
  63 end
  64
  65 # Set up something to print out s-expressions.
  66 # We save and restore print_output_debug_flag to prevent the w32 port
  67 # from calling OutputDebugString, which causes GDB to display each
  68 # character twice (yuk!).
  69 define pr
  70   set $output_debug = print_output_debug_flag
  71   set print_output_debug_flag = 0
  72   set debug_print ($)
  73   set print_output_debug_flag = $output_debug
  74 end
  75 document pr
  76 Print the emacs s-expression which is $.
  77 Works only when an inferior emacs is executing.
  78 end
  79
  80 # Print out s-expressions
  81 define pp
  82   set $tmp = $arg0
  83   set $output_debug = print_output_debug_flag
  84   set print_output_debug_flag = 0
  85   set safe_debug_print ($tmp)
  86   set print_output_debug_flag = $output_debug
  87 end
  88 document pp
  89 Print the argument as an emacs s-expression
  90 Works only when an inferior emacs is executing.
  91 end
  92
  93 # Print out s-expressions from tool bar
  94 define pp1
  95   set $tmp = $arg0
  96   set $output_debug = print_output_debug_flag
  97   set print_output_debug_flag = 0
  98   set safe_debug_print ($tmp)
  99   set print_output_debug_flag = $output_debug
 100 end
 101 document pp1
 102 Print the argument as an emacs s-expression.
 103 Works only when an inferior emacs is executing.
 104 For use on tool bar when debugging in Emacs
 105 where the variable name would not otherwise
 106 be recorded in the GUD buffer.
 107 end
 108
 109 # Print value of lisp variable
 110 define pv
 111   set $tmp = "$arg0"
 112   set $output_debug = print_output_debug_flag
 113   set print_output_debug_flag = 0
 114   set safe_debug_print ( find_symbol_value (intern ($tmp)))
 115   set print_output_debug_flag = $output_debug
 116 end
 117 document pv
 118 Print the value of the lisp variable given as argument.
 119 Works only when an inferior emacs is executing.
 120 end
 121
 122 # Print value of lisp variable
 123 define pv1
 124   set $tmp = "$arg0"
 125   set $output_debug = print_output_debug_flag
 126   set print_output_debug_flag = 0
 127   set safe_debug_print (find_symbol_value (intern ($tmp)))
 128   set print_output_debug_flag = $output_debug
 129 end
 130 document pv1
 131 Print the value of the lisp variable given as argument.
 132 Works only when an inferior emacs is executing.
 133 For use when debugging in Emacs where the variable
 134 name would not otherwise be recorded in the GUD buffer.
 135 end
 136
 137 # Print out current buffer point and boundaries
 138 define ppt
 139   set $b = current_buffer
 140   set $t = $b->text
 141   printf "BUF PT: %d", $b->pt
 142   if ($b->pt != $b->pt_byte)
 143     printf "[%d]", $b->pt_byte
 144   end
 145   printf " of 1..%d", $t->z
 146   if ($t->z != $t->z_byte)
 147     printf "[%d]", $t->z_byte
 148   end
 149   if ($b->begv != 1 || $b->zv != $t->z)
 150     printf " NARROW=%d..%d", $b->begv, $b->zv
 151     if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
 152       printf " [%d..%d]", $b->begv_byte, $b->zv_byte
 153     end
 154   end
 155   printf " GAP: %d", $t->gpt
 156   if ($t->gpt != $t->gpt_byte)
 157     printf "[%d]", $t->gpt_byte
 158   end
 159   printf " SZ=%d\n", $t->gap_size
 160 end
 161 document ppt
 162 Print current buffer's point and boundaries.
 163 Prints values of point, beg, end, narrow, and gap for current buffer.
 164 end
 165
 166 define pitmethod
 167   set $itmethod = $arg0
 168   # output $itmethod
 169   if ($itmethod == 0)
 170     printf "GET_FROM_BUFFER"
 171   end
 172   if ($itmethod == 1)
 173     printf "GET_FROM_DISPLAY_VECTOR"
 174   end
 175   if ($itmethod == 2)
 176     printf "GET_FROM_STRING"
 177   end
 178   if ($itmethod == 3)
 179     printf "GET_FROM_C_STRING"
 180   end
 181   if ($itmethod == 4)
 182     printf "GET_FROM_IMAGE"
 183   end
 184   if ($itmethod == 5)
 185     printf "GET_FROM_STRETCH"
 186   end
 187   if ($itmethod < 0 || $itmethod > 5)
 188     output $itmethod
 189   end
 190 end
 191 document pitmethod
 192 Pretty print it->method given as first arg
 193 end
 194
 195 # Print out iterator given as first arg
 196 define pitx
 197   set $it = $arg0
 198   printf "cur=%d", $it->current.pos.charpos
 199   if ($it->current.pos.charpos != $it->current.pos.bytepos)
 200     printf "[%d]", $it->current.pos.bytepos
 201   end
 202   printf " pos=%d", $it->position.charpos
 203   if ($it->position.charpos != $it->position.bytepos)
 204     printf "[%d]", $it->position.bytepos
 205   end
 206   printf " start=%d", $it->start.pos.charpos
 207   if ($it->start.pos.charpos != $it->start.pos.bytepos)
 208     printf "[%d]", $it->start.pos.bytepos
 209   end
 210   printf " end=%d", $it->end_charpos
 211   printf " stop=%d", $it->stop_charpos
 212   printf " face=%d", $it->face_id
 213   if ($it->multibyte_p)
 214     printf " MB"
 215   end
 216   if ($it->header_line_p)
 217     printf " HL"
 218   end
 219   if ($it->n_overlay_strings > 0)
 220     printf " nov=%d", $it->n_overlay_strings
 221   end
 222   if ($it->sp != 0)
 223     printf " sp=%d", $it->sp
 224   end
 225   # IT_CHARACTER
 226   if ($it->what == 0)
 227     if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
 228       printf " ch='%c'", $it->c
 229     else
 230       printf " ch=[%d,%d]", $it->c, $it->len
 231     end
 232   else
 233     printf " "
 234     # output $it->what
 235     if ($it->what == 0)
 236       printf "IT_CHARACTER"
 237     end
 238     if ($it->what == 1)
 239       printf "IT_COMPOSITION"
 240     end
 241     if ($it->what == 2)
 242       printf "IT_IMAGE"
 243     end
 244     if ($it->what == 3)
 245       printf "IT_STRETCH"
 246     end
 247     if ($it->what == 4)
 248       printf "IT_EOB"
 249     end
 250     if ($it->what == 5)
 251       printf "IT_TRUNCATION"
 252     end
 253     if ($it->what == 6)
 254       printf "IT_CONTINUATION"
 255     end
 256     if ($it->what < 0 || $it->what > 6)
 257       output $it->what
 258     end
 259   end
 260   if ($it->method != 0)
 261     # !GET_FROM_BUFFER
 262     printf " next="
 263     pitmethod $it->method
 264     if ($it->method == 2)
 265       # GET_FROM_STRING
 266       printf "[%d]", $it->current.string_pos.charpos
 267     end
 268     if ($it->method == 4)
 269       # GET_FROM_IMAGE
 270       printf "[%d]", $it->image_id
 271     end
 272   end
 273   printf "\n"
 274   if ($it->bidi_p)
 275     printf "BIDI: base_stop=%d prev_stop=%d level=%d\n", $it->base_level_stop, $it->prev_stop, $it->bidi_it.resolved_level
 276   end
 277   if ($it->region_beg_charpos >= 0)
 278     printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
 279   end
 280   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
 281   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
 282   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
 283   printf " w=%d", $it->pixel_width
 284   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
 285   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
 286   printf "\n"
 287   set $i = 0
 288   while ($i < $it->sp && $i < 4)
 289     set $e = $it->stack[$i]
 290     printf "stack[%d]: ", $i
 291     pitmethod $e->method
 292     printf "[%d]", $e->position.charpos
 293     printf "\n"
 294     set $i = $i + 1
 295   end
 296 end
 297 document pitx
 298 Pretty print a display iterator.
 299 Take one arg, an iterator object or pointer.
 300 end
 301
 302 define pit
 303   pitx it
 304 end
 305 document pit
 306 Pretty print the display iterator it.
 307 end
 308
 309 define prowx
 310   set $row = $arg0
 311   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
 312   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
 313   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
 314   printf " vis=%d", $row->visible_height
 315   printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
 316   printf "\n"
 317   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
 318   if ($row->enabled_p)
 319     printf " ENA"
 320   end
 321   if ($row->displays_text_p)
 322     printf " DISP"
 323   end
 324   if ($row->mode_line_p)
 325     printf " MODEL"
 326   end
 327   if ($row->continued_p)
 328     printf " CONT"
 329   end
 330   if ($row-> truncated_on_left_p)
 331     printf " TRUNC:L"
 332   end
 333   if ($row-> truncated_on_right_p)
 334     printf " TRUNC:R"
 335   end
 336   if ($row->starts_in_middle_of_char_p)
 337     printf " STARTMID"
 338   end
 339   if ($row->ends_in_middle_of_char_p)
 340     printf " ENDMID"
 341   end
 342   if ($row->ends_in_newline_from_string_p)
 343     printf " ENDNLFS"
 344   end
 345   if ($row->ends_at_zv_p)
 346     printf " ENDZV"
 347   end
 348   if ($row->overlapped_p)
 349     printf " OLAPD"
 350   end
 351   if ($row->overlapping_p)
 352     printf " OLAPNG"
 353   end
 354   printf "\n"
 355 end
 356 document prowx
 357 Pretty print information about glyph_row.
 358 Takes one argument, a row object or pointer.
 359 end
 360
 361 define prow
 362   prowx row
 363 end
 364 document prow
 365 Pretty print information about glyph_row in row.
 366 end
 367
 368
 369 define pcursorx
 370   set $cp = $arg0
 371   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
 372 end
 373 document pcursorx
 374 Pretty print a window cursor.
 375 end
 376
 377 define pcursor
 378   printf "output: "
 379   pcursorx output_cursor
 380   printf "\n"
 381 end
 382 document pcursor
 383 Pretty print the output_cursor.
 384 end
 385
 386 define pwinx
 387   set $w = $arg0
 388   xgetint $w->sequence_number
 389   if ($w->mini_p != Qnil)
 390     printf "Mini "
 391   end
 392   printf "Window %d ", $int
 393   xgetptr $w->buffer
 394   set $tem = (struct buffer *) $ptr
 395   xgetptr $tem->name_
 396   printf "%s", ((struct Lisp_String *) $ptr)->data
 397   printf "\n"
 398   xgetptr $w->start
 399   set $tem = (struct Lisp_Marker *) $ptr
 400   printf "start=%d end:", $tem->charpos
 401   if ($w->window_end_valid != Qnil)
 402     xgetint $w->window_end_pos
 403     printf "pos=%d", $int
 404     xgetint $w->window_end_vpos
 405     printf " vpos=%d", $int
 406   else
 407     printf "invalid"
 408   end
 409   printf " vscroll=%d", $w->vscroll
 410   if ($w->force_start != Qnil)
 411     printf " FORCE_START"
 412   end
 413   if ($w->must_be_updated_p)
 414     printf " MUST_UPD"
 415   end
 416   printf "\n"
 417   printf "cursor: "
 418   pcursorx $w->cursor
 419   printf "  phys: "
 420   pcursorx $w->phys_cursor
 421   if ($w->phys_cursor_on_p)
 422     printf " ON"
 423   else
 424     printf " OFF"
 425   end
 426   printf " blk="
 427   if ($w->last_cursor_off_p != $w->cursor_off_p)
 428     if ($w->last_cursor_off_p)
 429       printf "ON->"
 430     else
 431       printf "OFF->"
 432     end
 433   end
 434   if ($w->cursor_off_p)
 435     printf "ON"
 436   else
 437     printf "OFF"
 438   end
 439   printf "\n"
 440 end
 441 document pwinx
 442 Pretty print a window structure.
 443 Takes one argument, a pointer to a window structure.
 444 end
 445
 446 define pwin
 447   pwinx w
 448 end
 449 document pwin
 450 Pretty print window structure w.
 451 end
 452
 453 define pbiditype
 454   if ($arg0 == 0)
 455     printf "UNDEF"
 456   end
 457   if ($arg0 == 1)
 458     printf "L"
 459   end
 460   if ($arg0 == 2)
 461     printf "R"
 462   end
 463   if ($arg0 == 3)
 464     printf "EN"
 465   end
 466   if ($arg0 == 4)
 467     printf "AN"
 468   end
 469   if ($arg0 == 5)
 470     printf "BN"
 471   end
 472   if ($arg0 == 6)
 473     printf "B"
 474   end
 475   if ($arg0 < 0 || $arg0 > 6)
 476     printf "%d??", $arg0
 477   end
 478 end
 479 document pbiditype
 480 Print textual description of bidi type given as first argument.
 481 end
 482
 483 define pgx
 484   set $g = $arg0
 485   # CHAR_GLYPH
 486   if ($g->type == 0)
 487     if ($g->u.ch >= ' ' && $g->u.ch < 127)
 488       printf "CHAR[%c]", $g->u.ch
 489     else
 490       printf "CHAR[0x%x]", $g->u.ch
 491     end
 492   end
 493   # COMPOSITE_GLYPH
 494   if ($g->type == 1)
 495     printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->slice.cmp.from, $g->slice.cmp.to
 496   end
 497   # GLYPHLESS_GLYPH
 498   if ($g->type == 2)
 499     printf "GLYPHLESS["
 500     if ($g->u.glyphless.method == 0)
 501       printf "THIN]"
 502     end
 503     if ($g->u.glyphless.method == 1)
 504       printf "EMPTY]"
 505     end
 506     if ($g->u.glyphless.method == 2)
 507       printf "ACRO]"
 508     end
 509     if ($g->u.glyphless.method == 3)
 510       printf "HEX]"
 511     end
 512   end
 513   # IMAGE_GLYPH
 514   if ($g->type == 3)
 515     printf "IMAGE[%d]", $g->u.img_id
 516   end
 517   # STRETCH_GLYPH
 518   if ($g->type == 4)
 519     printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
 520   end
 521   xgettype ($g->object)
 522   if ($type == Lisp_String)
 523     printf " str=%x[%d]", $g->object, $g->charpos
 524   else
 525     printf " pos=%d", $g->charpos
 526   end
 527   # For characters, print their resolved level and bidi type
 528   if ($g->type == 0)
 529     printf " blev=%d,btyp=", $g->resolved_level
 530     pbiditype $g->bidi_type
 531   end
 532   printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
 533   # If not DEFAULT_FACE_ID
 534   if ($g->face_id != 0)
 535     printf " face=%d", $g->face_id
 536   end
 537   if ($g->voffset)
 538     printf " vof=%d", $g->voffset
 539   end
 540   if ($g->multibyte_p)
 541     printf " MB"
 542   end
 543   if ($g->padding_p)
 544     printf " PAD"
 545   end
 546   if ($g->glyph_not_available_p)
 547     printf " N/A"
 548   end
 549   if ($g->overlaps_vertically_p)
 550     printf " OVL"
 551   end
 552   if ($g->avoid_cursor_p)
 553     printf " AVOID"
 554   end
 555   if ($g->left_box_line_p)
 556     printf " ["
 557   end
 558   if ($g->right_box_line_p)
 559     printf " ]"
 560   end
 561   if ($g->slice.img.x || $g->slice.img.y || $g->slice.img.width || $g->slice.img.height)
 562     printf " slice=%d,%d,%d,%d" ,$g->slice.img.x, $g->slice.img.y, $g->slice.img.width, $g->slice.img.height
 563   end
 564   printf "\n"
 565 end
 566 document pgx
 567 Pretty print a glyph structure.
 568 Takes one argument, a pointer to a glyph structure.
 569 end
 570
 571 define pg
 572   set $pgidx = 0
 573   pgx glyph
 574 end
 575 document pg
 576 Pretty print glyph structure glyph.
 577 end
 578
 579 define pgi
 580   set $pgidx = $arg0
 581   pgx (&glyph[$pgidx])
 582 end
 583 document pgi
 584 Pretty print glyph structure glyph[I].
 585 Takes one argument, a integer I.
 586 end
 587
 588 define pgn
 589   set $pgidx = $pgidx + 1
 590   pgx (&glyph[$pgidx])
 591 end
 592 document pgn
 593 Pretty print next glyph structure.
 594 end
 595
 596 define pgrowx
 597   set $row = $arg0
 598   set $area = 0
 599   set $xofs = $row->x
 600   while ($area < 3)
 601     set $used = $row->used[$area]
 602     if ($used > 0)
 603       set $gl0 = $row->glyphs[$area]
 604       set $pgidx = 0
 605       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 606       while ($pgidx < $used)
 607         printf "%3d %4d: ", $pgidx, $xofs
 608         pgx $gl0[$pgidx]
 609         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 610         set $pgidx = $pgidx + 1
 611       end
 612     end
 613     set $area = $area + 1
 614   end
 615 end
 616 document pgrowx
 617 Pretty print all glyphs in a row structure.
 618 Takes one argument, a pointer to a row structure.
 619 end
 620
 621 define pgrow
 622   pgrowx row
 623 end
 624 document pgrow
 625 Pretty print all glyphs in row structure row.
 626 end
 627
 628 define pgrowit
 629   pgrowx it->glyph_row
 630 end
 631 document pgrowit
 632 Pretty print all glyphs in it->glyph_row.
 633 end
 634
 635 define prowlims
 636   printf "edges=(%d,%d),r2l=%d,cont=%d,trunc=(%d,%d),at_zv=%d\n", $arg0->minpos.charpos, $arg0->maxpos.charpos, $arg0->reversed_p, $arg0->continued_p, $arg0->truncated_on_left_p, $arg0->truncated_on_right_p, $arg0->ends_at_zv_p
 637 end
 638 document prowlims
 639 Print important attributes of a glyph_row structure.
 640 Takes one argument, a pointer to a glyph_row structure.
 641 end
 642
 643 define pmtxrows
 644   set $mtx = $arg0
 645   set $gl = $mtx->rows
 646   set $glend = $mtx->rows + $mtx->nrows - 1
 647   set $i = 0
 648   while ($gl < $glend)
 649     printf "%d: ", $i
 650     prowlims $gl
 651     set $gl = $gl + 1
 652     set $i = $i + 1
 653   end
 654 end
 655 document pmtxrows
 656 Print data about glyph rows in a glyph matrix.
 657 Takes one argument, a pointer to a glyph_matrix structure.
 658 end
 659
 660 define xtype
 661   xgettype $
 662   output $type
 663   echo \n
 664   if $type == Lisp_Misc
 665     xmisctype
 666   else
 667     if $type == Lisp_Vectorlike
 668       xvectype
 669     end
 670   end
 671 end
 672 document xtype
 673 Print the type of $, assuming it is an Emacs Lisp value.
 674 If the first type printed is Lisp_Vector or Lisp_Misc,
 675 a second line gives the more precise type.
 676 end
 677
 678 define xvectype
 679   xgetptr $
 680   set $size = ((struct Lisp_Vector *) $ptr)->size
 681   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 682   echo \n
 683 end
 684 document xvectype
 685 Print the size or vector subtype of $.
 686 This command assumes that $ is a vector or pseudovector.
 687 end
 688
 689 define xmisctype
 690   xgetptr $
 691   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 692   echo \n
 693 end
 694 document xmisctype
 695 Assume that $ is some misc type and print its specific type.
 696 end
 697
 698 define xint
 699   xgetint $
 700   print $int
 701 end
 702 document xint
 703 Print $ as an Emacs Lisp integer.  This gets the sign right.
 704 end
 705
 706 define xptr
 707   xgetptr $
 708   print (void *) $ptr
 709 end
 710 document xptr
 711 Print the pointer portion of an Emacs Lisp value in $.
 712 end
 713
 714 define xmarker
 715   xgetptr $
 716   print (struct Lisp_Marker *) $ptr
 717 end
 718 document xmarker
 719 Print $ as a marker pointer.
 720 This command assumes that $ is an Emacs Lisp marker value.
 721 end
 722
 723 define xoverlay
 724   xgetptr $
 725   print (struct Lisp_Overlay *) $ptr
 726 end
 727 document xoverlay
 728 Print $ as a overlay pointer.
 729 This command assumes that $ is an Emacs Lisp overlay value.
 730 end
 731
 732 define xmiscfree
 733   xgetptr $
 734   print (struct Lisp_Free *) $ptr
 735 end
 736 document xmiscfree
 737 Print $ as a misc free-cell pointer.
 738 This command assumes that $ is an Emacs Lisp Misc value.
 739 end
 740
 741 define xintfwd
 742   xgetptr $
 743   print (struct Lisp_Intfwd *) $ptr
 744 end
 745 document xintfwd
 746 Print $ as an integer forwarding pointer.
 747 This command assumes that $ is an Emacs Lisp Misc value.
 748 end
 749
 750 define xboolfwd
 751   xgetptr $
 752   print (struct Lisp_Boolfwd *) $ptr
 753 end
 754 document xboolfwd
 755 Print $ as a boolean forwarding pointer.
 756 This command assumes that $ is an Emacs Lisp Misc value.
 757 end
 758
 759 define xobjfwd
 760   xgetptr $
 761   print (struct Lisp_Objfwd *) $ptr
 762 end
 763 document xobjfwd
 764 Print $ as an object forwarding pointer.
 765 This command assumes that $ is an Emacs Lisp Misc value.
 766 end
 767
 768 define xbufobjfwd
 769   xgetptr $
 770   print (struct Lisp_Buffer_Objfwd *) $ptr
 771 end
 772 document xbufobjfwd
 773 Print $ as a buffer-local object forwarding pointer.
 774 This command assumes that $ is an Emacs Lisp Misc value.
 775 end
 776
 777 define xkbobjfwd
 778   xgetptr $
 779   print (struct Lisp_Kboard_Objfwd *) $ptr
 780 end
 781 document xkbobjfwd
 782 Print $ as a kboard-local object forwarding pointer.
 783 This command assumes that $ is an Emacs Lisp Misc value.
 784 end
 785
 786 define xbuflocal
 787   xgetptr $
 788   print (struct Lisp_Buffer_Local_Value *) $ptr
 789 end
 790 document xbuflocal
 791 Print $ as a buffer-local-value pointer.
 792 This command assumes that $ is an Emacs Lisp Misc value.
 793 end
 794
 795 define xsymbol
 796   set $sym = $
 797   xgetptr $sym
 798   print (struct Lisp_Symbol *) $ptr
 799   xprintsym $sym
 800   echo \n
 801 end
 802 document xsymbol
 803 Print the name and address of the symbol $.
 804 This command assumes that $ is an Emacs Lisp symbol value.
 805 end
 806
 807 define xstring
 808   xgetptr $
 809   print (struct Lisp_String *) $ptr
 810   xprintstr $
 811   echo \n
 812 end
 813 document xstring
 814 Print the contents and address of the string $.
 815 This command assumes that $ is an Emacs Lisp string value.
 816 end
 817
 818 define xvector
 819   xgetptr $
 820   print (struct Lisp_Vector *) $ptr
 821   output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
 822 echo \n
 823 end
 824 document xvector
 825 Print the contents and address of the vector $.
 826 This command assumes that $ is an Emacs Lisp vector value.
 827 end
 828
 829 define xprocess
 830   xgetptr $
 831   print (struct Lisp_Process *) $ptr
 832   output *$
 833   echo \n
 834 end
 835 document xprocess
 836 Print the address of the struct Lisp_process to which $ points.
 837 This command assumes that $ is a Lisp_Object.
 838 end
 839
 840 define xframe
 841   xgetptr $
 842   print (struct frame *) $ptr
 843   xgetptr $->name
 844   set $ptr = (struct Lisp_String *) $ptr
 845   xprintstr $ptr
 846   echo \n
 847 end
 848 document xframe
 849 Print $ as a frame pointer.
 850 This command assumes $ is an Emacs Lisp frame value.
 851 end
 852
 853 define xcompiled
 854   xgetptr $
 855   print (struct Lisp_Vector *) $ptr
 856   output ($->contents[0])@($->size & 0xff)
 857 end
 858 document xcompiled
 859 Print $ as a compiled function pointer.
 860 This command assumes that $ is an Emacs Lisp compiled value.
 861 end
 862
 863 define xwindow
 864   xgetptr $
 865   print (struct window *) $ptr
 866   set $window = (struct window *) $ptr
 867   xgetint $window->total_cols
 868   set $width=$int
 869   xgetint $window->total_lines
 870   set $height=$int
 871   xgetint $window->left_col
 872   set $left=$int
 873   xgetint $window->top_line
 874   set $top=$int
 875   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 876 end
 877 document xwindow
 878 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 879 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 880 end
 881
 882 define xwinconfig
 883   xgetptr $
 884   print (struct save_window_data *) $ptr
 885 end
 886 document xwinconfig
 887 Print $ as a window configuration pointer.
 888 This command assumes that $ is an Emacs Lisp window configuration value.
 889 end
 890
 891 define xsubr
 892   xgetptr $
 893   print (struct Lisp_Subr *) $ptr
 894   output *$
 895   echo \n
 896 end
 897 document xsubr
 898 Print the address of the subr which the Lisp_Object $ points to.
 899 end
 900
 901 define xchartable
 902   xgetptr $
 903   print (struct Lisp_Char_Table *) $ptr
 904   printf "Purpose: "
 905   xprintsym $->purpose
 906   printf "  %d extra slots", ($->size & 0x1ff) - 68
 907   echo \n
 908 end
 909 document xchartable
 910 Print the address of the char-table $, and its purpose.
 911 This command assumes that $ is an Emacs Lisp char-table value.
 912 end
 913
 914 define xsubchartable
 915   xgetptr $
 916   print (struct Lisp_Sub_Char_Table *) $ptr
 917   xgetint $->depth
 918   set $depth = $int
 919   xgetint $->min_char
 920   printf "Depth: %d, Min char: %d (0x%x)\n", $depth, $int, $int
 921 end
 922 document xsubchartable
 923 Print the address of the sub-char-table $, its depth and min-char.
 924 This command assumes that $ is an Emacs Lisp sub-char-table value.
 925 end
 926
 927 define xboolvector
 928   xgetptr $
 929   print (struct Lisp_Bool_Vector *) $ptr
 930   output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
 931   echo \n
 932 end
 933 document xboolvector
 934 Print the contents and address of the bool-vector $.
 935 This command assumes that $ is an Emacs Lisp bool-vector value.
 936 end
 937
 938 define xbuffer
 939   xgetptr $
 940   print (struct buffer *) $ptr
 941   xgetptr $->name_
 942   output ((struct Lisp_String *) $ptr)->data
 943   echo \n
 944 end
 945 document xbuffer
 946 Set $ as a buffer pointer and the name of the buffer.
 947 This command assumes $ is an Emacs Lisp buffer value.
 948 end
 949
 950 define xhashtable
 951   xgetptr $
 952   print (struct Lisp_Hash_Table *) $ptr
 953 end
 954 document xhashtable
 955 Set $ as a hash table pointer.
 956 This command assumes that $ is an Emacs Lisp hash table value.
 957 end
 958
 959 define xcons
 960   xgetptr $
 961   print (struct Lisp_Cons *) $ptr
 962   output/x *$
 963   echo \n
 964 end
 965 document xcons
 966 Print the contents of $ as an Emacs Lisp cons.
 967 end
 968
 969 define nextcons
 970   p $.u.cdr
 971   xcons
 972 end
 973 document nextcons
 974 Print the contents of the next cell in a list.
 975 This command assumes that the last thing you printed was a cons cell contents
 976 (type struct Lisp_Cons) or a pointer to one.
 977 end
 978 define xcar
 979   xgetptr $
 980   xgettype $
 981   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 982 end
 983 document xcar
 984 Assume that $ is an Emacs Lisp pair and print its car.
 985 end
 986
 987 define xcdr
 988   xgetptr $
 989   xgettype $
 990   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 991 end
 992 document xcdr
 993 Assume that $ is an Emacs Lisp pair and print its cdr.
 994 end
 995
 996 define xlist
 997   xgetptr $
 998   set $cons = (struct Lisp_Cons *) $ptr
 999   xgetptr Qnil
1000   set $nil = $ptr
1001   set $i = 0
1002   while $cons != $nil && $i < 10
1003     p/x $cons->car
1004     xpr
1005     xgetptr $cons->u.cdr
1006     set $cons = (struct Lisp_Cons *) $ptr
1007     set $i = $i + 1
1008     printf "---\n"
1009   end
1010   if $cons == $nil
1011     printf "nil\n"
1012   else
1013     printf "...\n"
1014     p $ptr
1015   end
1016 end
1017 document xlist
1018 Print $ assuming it is a list.
1019 end
1020
1021 define xfloat
1022   xgetptr $
1023   print ((struct Lisp_Float *) $ptr)->u.data
1024 end
1025 document xfloat
1026 Print $ assuming it is a lisp floating-point number.
1027 end
1028
1029 define xscrollbar
1030   xgetptr $
1031   print (struct scrollbar *) $ptr
1032 output *$
1033 echo \n
1034 end
1035 document xscrollbar
1036 Print $ as a scrollbar pointer.
1037 end
1038
1039 define xpr
1040   xtype
1041   if $type == Lisp_Int
1042     xint
1043   end
1044   if $type == Lisp_Symbol
1045     xsymbol
1046   end
1047   if $type == Lisp_String
1048     xstring
1049   end
1050   if $type == Lisp_Cons
1051     xcons
1052   end
1053   if $type == Lisp_Float
1054     xfloat
1055   end
1056   if $type == Lisp_Misc
1057     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
1058     if $misc == Lisp_Misc_Free
1059       xmiscfree
1060     end
1061     if $misc == Lisp_Misc_Boolfwd
1062       xboolfwd
1063     end
1064     if $misc == Lisp_Misc_Marker
1065       xmarker
1066     end
1067     if $misc == Lisp_Misc_Intfwd
1068       xintfwd
1069     end
1070     if $misc == Lisp_Misc_Boolfwd
1071       xboolfwd
1072     end
1073     if $misc == Lisp_Misc_Objfwd
1074       xobjfwd
1075     end
1076     if $misc == Lisp_Misc_Buffer_Objfwd
1077       xbufobjfwd
1078     end
1079     if $misc == Lisp_Misc_Buffer_Local_Value
1080       xbuflocal
1081     end
1082 #    if $misc == Lisp_Misc_Some_Buffer_Local_Value
1083 #      xvalue
1084 #    end
1085     if $misc == Lisp_Misc_Overlay
1086       xoverlay
1087     end
1088     if $misc == Lisp_Misc_Kboard_Objfwd
1089       xkbobjfwd
1090     end
1091 #    if $misc == Lisp_Misc_Save_Value
1092 #      xsavevalue
1093 #    end
1094   end
1095   if $type == Lisp_Vectorlike
1096     set $size = ((struct Lisp_Vector *) $ptr)->size
1097     if ($size & PVEC_FLAG)
1098       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
1099       if $vec == PVEC_NORMAL_VECTOR
1100         xvector
1101       end
1102       if $vec == PVEC_PROCESS
1103         xprocess
1104       end
1105       if $vec == PVEC_FRAME
1106         xframe
1107       end
1108       if $vec == PVEC_COMPILED
1109         xcompiled
1110       end
1111       if $vec == PVEC_WINDOW
1112         xwindow
1113       end
1114       if $vec == PVEC_WINDOW_CONFIGURATION
1115         xwinconfig
1116       end
1117       if $vec == PVEC_SUBR
1118         xsubr
1119       end
1120       if $vec == PVEC_CHAR_TABLE
1121         xchartable
1122       end
1123       if $vec == PVEC_BOOL_VECTOR
1124         xboolvector
1125       end
1126       if $vec == PVEC_BUFFER
1127         xbuffer
1128       end
1129       if $vec == PVEC_HASH_TABLE
1130         xhashtable
1131       end
1132     else
1133       xvector
1134     end
1135   end
1136 end
1137 document xpr
1138 Print $ as a lisp object of any type.
1139 end
1140
1141 define xprintstr
1142   set $data = (char *) $arg0->data
1143   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
1144 end
1145
1146 define xprintsym
1147   xgetptr $arg0
1148   set $sym = (struct Lisp_Symbol *) $ptr
1149   xgetptr $sym->xname
1150   set $sym_name = (struct Lisp_String *) $ptr
1151   xprintstr $sym_name
1152 end
1153 document xprintsym
1154   Print argument as a symbol.
1155 end
1156
1157 define xcoding
1158   set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits)
1159   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
1160   set $name = $tmp->contents[$arg0 * 2]
1161   print $name
1162   pr
1163   print $tmp->contents[$arg0 * 2 + 1]
1164   pr
1165 end
1166 document xcoding
1167   Print the name and attributes of coding system that has ID (argument).
1168 end
1169
1170 define xcharset
1171   set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits)
1172   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
1173   p $tmp->contents[charset_table[$arg0].hash_index * 2]
1174   pr
1175 end
1176 document xcharset
1177   Print the name of charset that has ID (argument).
1178 end
1179
1180 define xfontset
1181   xgetptr $
1182   set $tbl = (struct Lisp_Char_Table *) $ptr
1183   print $tbl
1184   xgetint $tbl->extras[0]
1185   printf " ID:%d", $int
1186   xgettype $tbl->extras[1]
1187   xgetptr $tbl->extras[1]
1188   if $type == Lisp_String
1189     set $ptr = (struct Lisp_String *) $ptr
1190     printf " Name:"
1191     xprintstr $ptr
1192   else
1193     xgetptr $tbl->extras[2]
1194     set $ptr = (struct Lisp_Char_Table *) $ptr
1195     xgetptr $ptr->extras[1]
1196     set $ptr = (struct Lisp_String *) $ptr
1197     printf " Realized from:"
1198     xprintstr $ptr
1199   end
1200   echo \n
1201 end
1202
1203 define xfont
1204   xgetptr $
1205   set $size = (((struct Lisp_Vector *) $ptr)->size & 0x1FF)
1206   if $size == FONT_SPEC_MAX
1207     print (struct font_spec *) $ptr
1208   else
1209     if $size == FONT_ENTITY_MAX
1210       print (struct font_entity *) $ptr
1211     else
1212       print (struct font *) $ptr
1213     end
1214   end
1215 end
1216 document xfont
1217 Print $ assuming it is a list font (font-spec, font-entity, or font-object).
1218 end
1219
1220 define xbacktrace
1221   set $bt = backtrace_list
1222   while $bt
1223     xgettype (*$bt->function)
1224     if $type == Lisp_Symbol
1225       xprintsym (*$bt->function)
1226       printf " (0x%x)\n", $bt->args
1227     else
1228       xgetptr *$bt->function
1229       printf "0x%x ", $ptr
1230       if $type == Lisp_Vectorlike
1231         xgetptr (*$bt->function)
1232         set $size = ((struct Lisp_Vector *) $ptr)->size
1233         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
1234       else
1235         printf "Lisp type %d", $type
1236       end
1237       echo \n
1238     end
1239     set $bt = $bt->next
1240   end
1241 end
1242 document xbacktrace
1243   Print a backtrace of Lisp function calls from backtrace_list.
1244   Set a breakpoint at Fsignal and call this to see from where
1245   an error was signaled.
1246 end
1247
1248 define which
1249   set debug_print (which_symbols ($arg0))
1250 end
1251 document which
1252   Print symbols which references a given lisp object
1253   either as its symbol value or symbol function.
1254 end
1255
1256 define xbytecode
1257   set $bt = byte_stack_list
1258   while $bt
1259     xgettype ($bt->byte_string)
1260     printf "0x%x => ", $bt->byte_string
1261     which $bt->byte_string
1262     set $bt = $bt->next
1263   end
1264 end
1265 document xbytecode
1266   Print a backtrace of the byte code stack.
1267 end
1268
1269 # Show Lisp backtrace after normal backtrace.
1270 define hookpost-backtrace
1271   set $bt = backtrace_list
1272   if $bt
1273     echo \n
1274     echo Lisp Backtrace:\n
1275     xbacktrace
1276   end
1277 end
1278
1279 define xreload
1280   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1281   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1282 end
1283 document xreload
1284   When starting Emacs a second time in the same gdb session under
1285   FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1286   their values.  (The same happens on current (2000) versions of GNU/Linux
1287   with gdb 5.0.)
1288   This function reloads them.
1289 end
1290 xreload
1291
1292 # Flush display (X only)
1293 define ff
1294   set x_flush (0)
1295 end
1296 document ff
1297 Flush pending X window display updates to screen.
1298 Works only when an inferior emacs is executing.
1299 end
1300
1301
1302 define hook-run
1303   xreload
1304 end
1305
1306 # Call xreload if a new Emacs executable is loaded.
1307 define hookpost-run
1308   xreload
1309 end
1310
1311 set print pretty on
1312 set print sevenbit-strings
1313
1314 show environment DISPLAY
1315 show environment TERM
1316
1317 # People get bothered when they see messages about non-existent functions...
1318 xgetptr globals.f_Vsystem_type
1319 # $ptr is NULL in temacs
1320 if ($ptr != 0)
1321   set $tem = (struct Lisp_Symbol *) $ptr
1322   xgetptr $tem->xname
1323   set $tem = (struct Lisp_String *) $ptr
1324   set $tem = (char *) $tem->data
1325
1326   # Don't let abort actually run, as it will make stdio stop working and
1327   # therefore the `pr' command above as well.
1328   if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1329     # The windows-nt build replaces abort with its own function.
1330     break w32_abort
1331   else
1332     break abort
1333   end
1334 end
1335
1336 # x_error_quitter is defined only on X.  But window-system is set up
1337 # only at run time, during Emacs startup, so we need to defer setting
1338 # the breakpoint.  init_sys_modes is the first function called on
1339 # every platform after init_display, where window-system is set.
1340 tbreak init_sys_modes
1341 commands
1342   silent
1343   xgetptr globals.f_Vinitial_window_system
1344   set $tem = (struct Lisp_Symbol *) $ptr
1345   xgetptr $tem->xname
1346   set $tem = (struct Lisp_String *) $ptr
1347   set $tem = (char *) $tem->data
1348   # If we are running in synchronous mode, we want a chance to look
1349   # around before Emacs exits.  Perhaps we should put the break
1350   # somewhere else instead...
1351   if $tem[0] == 'x' && $tem[1] == '\0'
1352     break x_error_quitter
1353   end
1354   continue
1355 end