code.delx.au - gnu-emacs/blob - src/.gdbinit

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