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

   1 # Copyright (C) 1992-1998, 2000-2013 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 : $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   xgetint $w->sequence_number
 362   if ($w->mini_p != Qnil)
 363     printf "Mini "
 364   end
 365   printf "Window %d ", $int
 366   xgetptr $w->buffer
 367   set $tem = (struct buffer *) $ptr
 368   xgetptr $tem->name_
 369   printf "%s", ((struct Lisp_String *) $ptr)->data
 370   printf "\n"
 371   xgetptr $w->start
 372   set $tem = (struct Lisp_Marker *) $ptr
 373   printf "start=%d end:", $tem->charpos
 374   if ($w->window_end_valid != Qnil)
 375     xgetint $w->window_end_pos
 376     printf "pos=%d", $int
 377     xgetint $w->window_end_vpos
 378     printf " vpos=%d", $int
 379   else
 380     printf "invalid"
 381   end
 382   printf " vscroll=%d", $w->vscroll
 383   if ($w->force_start != Qnil)
 384     printf " FORCE_START"
 385   end
 386   if ($w->must_be_updated_p)
 387     printf " MUST_UPD"
 388   end
 389   printf "\n"
 390   printf "cursor: "
 391   pcursorx $w->cursor
 392   printf "  phys: "
 393   pcursorx $w->phys_cursor
 394   if ($w->phys_cursor_on_p)
 395     printf " ON"
 396   else
 397     printf " OFF"
 398   end
 399   printf " blk="
 400   if ($w->last_cursor_off_p != $w->cursor_off_p)
 401     if ($w->last_cursor_off_p)
 402       printf "ON->"
 403     else
 404       printf "OFF->"
 405     end
 406   end
 407   if ($w->cursor_off_p)
 408     printf "ON"
 409   else
 410     printf "OFF"
 411   end
 412   printf "\n"
 413 end
 414 document pwinx
 415 Pretty print a window structure.
 416 Takes one argument, a pointer to a window structure.
 417 end
 418
 419 define pwin
 420   pwinx w
 421 end
 422 document pwin
 423 Pretty print window structure w.
 424 end
 425
 426 define pbiditype
 427   if ($arg0 == 0)
 428     printf "UNDEF"
 429   end
 430   if ($arg0 == 1)
 431     printf "L"
 432   end
 433   if ($arg0 == 2)
 434     printf "R"
 435   end
 436   if ($arg0 == 3)
 437     printf "EN"
 438   end
 439   if ($arg0 == 4)
 440     printf "AN"
 441   end
 442   if ($arg0 == 5)
 443     printf "BN"
 444   end
 445   if ($arg0 == 6)
 446     printf "B"
 447   end
 448   if ($arg0 < 0 || $arg0 > 6)
 449     printf "%d??", $arg0
 450   end
 451 end
 452 document pbiditype
 453 Print textual description of bidi type given as first argument.
 454 end
 455
 456 define pgx
 457   set $g = $arg0
 458   # CHAR_GLYPH
 459   if ($g.type == 0)
 460     if ($g.u.ch >= ' ' && $g.u.ch < 127)
 461       printf "CHAR[%c]", $g.u.ch
 462     else
 463       printf "CHAR[0x%x]", $g.u.ch
 464     end
 465   end
 466   # COMPOSITE_GLYPH
 467   if ($g.type == 1)
 468     printf "COMP[%d (%d..%d)]", $g.u.cmp.id, $g.slice.cmp.from, $g.slice.cmp.to
 469   end
 470   # GLYPHLESS_GLYPH
 471   if ($g.type == 2)
 472     printf "GLYPHLESS["
 473     if ($g.u.glyphless.method == 0)
 474       printf "THIN]"
 475     end
 476     if ($g.u.glyphless.method == 1)
 477       printf "EMPTY]"
 478     end
 479     if ($g.u.glyphless.method == 2)
 480       printf "ACRO]"
 481     end
 482     if ($g.u.glyphless.method == 3)
 483       printf "HEX]"
 484     end
 485   end
 486   # IMAGE_GLYPH
 487   if ($g.type == 3)
 488     printf "IMAGE[%d]", $g.u.img_id
 489   end
 490   # STRETCH_GLYPH
 491   if ($g.type == 4)
 492     printf "STRETCH[%d+%d]", $g.u.stretch.height, $g.u.stretch.ascent
 493   end
 494   xgettype ($g.object)
 495   if ($type == Lisp_String)
 496     xgetptr $g.object
 497     printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->data, $g.charpos
 498   else
 499     printf " pos=%d", $g.charpos
 500   end
 501   # For characters, print their resolved level and bidi type
 502   if ($g.type == 0)
 503     printf " blev=%d,btyp=", $g.resolved_level
 504     pbiditype $g.bidi_type
 505   end
 506   printf " w=%d a+d=%d+%d", $g.pixel_width, $g.ascent, $g.descent
 507   # If not DEFAULT_FACE_ID
 508   if ($g.face_id != 0)
 509     printf " face=%d", $g.face_id
 510   end
 511   if ($g.voffset)
 512     printf " vof=%d", $g.voffset
 513   end
 514   if ($g.multibyte_p)
 515     printf " MB"
 516   end
 517   if ($g.padding_p)
 518     printf " PAD"
 519   end
 520   if ($g.glyph_not_available_p)
 521     printf " N/A"
 522   end
 523   if ($g.overlaps_vertically_p)
 524     printf " OVL"
 525   end
 526   if ($g.avoid_cursor_p)
 527     printf " AVOID"
 528   end
 529   if ($g.left_box_line_p)
 530     printf " ["
 531   end
 532   if ($g.right_box_line_p)
 533     printf " ]"
 534   end
 535   if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
 536     printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height
 537   end
 538   printf "\n"
 539 end
 540 document pgx
 541 Pretty print a glyph structure.
 542 Takes one argument, a pointer to a glyph structure.
 543 end
 544
 545 define pg
 546   set $pgidx = 0
 547   pgx glyph
 548 end
 549 document pg
 550 Pretty print glyph structure glyph.
 551 end
 552
 553 define pgi
 554   set $pgidx = $arg0
 555   pgx (&glyph[$pgidx])
 556 end
 557 document pgi
 558 Pretty print glyph structure glyph[I].
 559 Takes one argument, a integer I.
 560 end
 561
 562 define pgn
 563   set $pgidx = $pgidx + 1
 564   pgx (&glyph[$pgidx])
 565 end
 566 document pgn
 567 Pretty print next glyph structure.
 568 end
 569
 570 define pgrowx
 571   set $row = $arg0
 572   set $area = 0
 573   set $xofs = $row->x
 574   while ($area < 3)
 575     set $used = $row->used[$area]
 576     if ($used > 0)
 577       set $gl0 = $row->glyphs[$area]
 578       set $pgidx = 0
 579       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 580       while ($pgidx < $used)
 581         printf "%3d %4d: ", $pgidx, $xofs
 582         pgx $gl0[$pgidx]
 583         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 584         set $pgidx = $pgidx + 1
 585       end
 586     end
 587     set $area = $area + 1
 588   end
 589 end
 590 document pgrowx
 591 Pretty print all glyphs in a row structure.
 592 Takes one argument, a pointer to a row structure.
 593 end
 594
 595 define pgrow
 596   pgrowx row
 597 end
 598 document pgrow
 599 Pretty print all glyphs in row structure row.
 600 end
 601
 602 define pgrowit
 603   pgrowx it->glyph_row
 604 end
 605 document pgrowit
 606 Pretty print all glyphs in it->glyph_row.
 607 end
 608
 609 define prowlims
 610   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
 611 end
 612 document prowlims
 613 Print important attributes of a glyph_row structure.
 614 Takes one argument, a pointer to a glyph_row structure.
 615 end
 616
 617 define pmtxrows
 618   set $mtx = $arg0
 619   set $gl = $mtx->rows
 620   set $glend = $mtx->rows + $mtx->nrows - 1
 621   set $i = 0
 622   while ($gl < $glend)
 623     printf "%d: ", $i
 624     prowlims $gl
 625     set $gl = $gl + 1
 626     set $i = $i + 1
 627   end
 628 end
 629 document pmtxrows
 630 Print data about glyph rows in a glyph matrix.
 631 Takes one argument, a pointer to a glyph_matrix structure.
 632 end
 633
 634 define xtype
 635   xgettype $
 636   output $type
 637   echo \n
 638   if $type == Lisp_Misc
 639     xmisctype
 640   else
 641     if $type == Lisp_Vectorlike
 642       xvectype
 643     end
 644   end
 645 end
 646 document xtype
 647 Print the type of $, assuming it is an Emacs Lisp value.
 648 If the first type printed is Lisp_Vector or Lisp_Misc,
 649 a second line gives the more precise type.
 650 end
 651
 652 define pvectype
 653   set $size = ((struct Lisp_Vector *) $arg0)->header.size
 654   if ($size & PSEUDOVECTOR_FLAG)
 655     output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
 656   else
 657     output PVEC_NORMAL_VECTOR
 658   end
 659   echo \n
 660 end
 661 document pvectype
 662 Print the subtype of vectorlike object.
 663 Takes one argument, a pointer to an object.
 664 end
 665
 666 define xvectype
 667   xgetptr $
 668   pvectype $ptr
 669 end
 670 document xvectype
 671 Print the subtype of vectorlike object.
 672 This command assumes that $ is a Lisp_Object.
 673 end
 674
 675 define pvecsize
 676   set $size = ((struct Lisp_Vector *) $arg0)->header.size
 677   if ($size & PSEUDOVECTOR_FLAG)
 678     output ($size & PSEUDOVECTOR_SIZE_MASK)
 679     echo \n
 680     output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS)
 681   else
 682     output ($size & ~ARRAY_MARK_FLAG)
 683   end
 684   echo \n
 685 end
 686 document pvecsize
 687 Print the size of vectorlike object.
 688 Takes one argument, a pointer to an object.
 689 end
 690
 691 define xvecsize
 692   xgetptr $
 693   pvecsize $ptr
 694 end
 695 document xvecsize
 696 Print the size of $
 697 This command assumes that $ is a Lisp_Object.
 698 end
 699
 700 define xmisctype
 701   xgetptr $
 702   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 703   echo \n
 704 end
 705 document xmisctype
 706 Assume that $ is some misc type and print its specific type.
 707 end
 708
 709 define xint
 710   xgetint $
 711   print $int
 712 end
 713 document xint
 714 Print $ as an Emacs Lisp integer.  This gets the sign right.
 715 end
 716
 717 define xptr
 718   xgetptr $
 719   print (void *) $ptr
 720 end
 721 document xptr
 722 Print the pointer portion of an Emacs Lisp value in $.
 723 end
 724
 725 define xmarker
 726   xgetptr $
 727   print (struct Lisp_Marker *) $ptr
 728 end
 729 document xmarker
 730 Print $ as a marker pointer.
 731 This command assumes that $ is an Emacs Lisp marker value.
 732 end
 733
 734 define xoverlay
 735   xgetptr $
 736   print (struct Lisp_Overlay *) $ptr
 737 end
 738 document xoverlay
 739 Print $ as a overlay pointer.
 740 This command assumes that $ is an Emacs Lisp overlay value.
 741 end
 742
 743 define xmiscfree
 744   xgetptr $
 745   print (struct Lisp_Free *) $ptr
 746 end
 747 document xmiscfree
 748 Print $ as a misc free-cell pointer.
 749 This command assumes that $ is an Emacs Lisp Misc value.
 750 end
 751
 752 define xsymbol
 753   set $sym = $
 754   xgetptr $sym
 755   print (struct Lisp_Symbol *) $ptr
 756   xprintsym $sym
 757   echo \n
 758 end
 759 document xsymbol
 760 Print the name and address of the symbol $.
 761 This command assumes that $ is an Emacs Lisp symbol value.
 762 end
 763
 764 define xstring
 765   xgetptr $
 766   print (struct Lisp_String *) $ptr
 767   xprintstr $
 768   echo \n
 769 end
 770 document xstring
 771 Print the contents and address of the string $.
 772 This command assumes that $ is an Emacs Lisp string value.
 773 end
 774
 775 define xvector
 776   xgetptr $
 777   print (struct Lisp_Vector *) $ptr
 778   output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
 779 echo \n
 780 end
 781 document xvector
 782 Print the contents and address of the vector $.
 783 This command assumes that $ is an Emacs Lisp vector value.
 784 end
 785
 786 define xprocess
 787   xgetptr $
 788   print (struct Lisp_Process *) $ptr
 789   output *$
 790   echo \n
 791 end
 792 document xprocess
 793 Print the address of the struct Lisp_process to which $ points.
 794 This command assumes that $ is a Lisp_Object.
 795 end
 796
 797 define xframe
 798   xgetptr $
 799   print (struct frame *) $ptr
 800   xgetptr $->name
 801   set $ptr = (struct Lisp_String *) $ptr
 802   xprintstr $ptr
 803   echo \n
 804 end
 805 document xframe
 806 Print $ as a frame pointer.
 807 This command assumes $ is an Emacs Lisp frame value.
 808 end
 809
 810 define xcompiled
 811   xgetptr $
 812   print (struct Lisp_Vector *) $ptr
 813   output ($->contents[0])@($->header.size & 0xff)
 814 end
 815 document xcompiled
 816 Print $ as a compiled function pointer.
 817 This command assumes that $ is an Emacs Lisp compiled value.
 818 end
 819
 820 define xwindow
 821   xgetptr $
 822   print (struct window *) $ptr
 823   set $window = (struct window *) $ptr
 824   xgetint $window->total_cols
 825   set $width=$int
 826   xgetint $window->total_lines
 827   set $height=$int
 828   xgetint $window->left_col
 829   set $left=$int
 830   xgetint $window->top_line
 831   set $top=$int
 832   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 833 end
 834 document xwindow
 835 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 836 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 837 end
 838
 839 define xwinconfig
 840   xgetptr $
 841   print (struct save_window_data *) $ptr
 842 end
 843 document xwinconfig
 844 Print $ as a window configuration pointer.
 845 This command assumes that $ is an Emacs Lisp window configuration value.
 846 end
 847
 848 define xsubr
 849   xgetptr $
 850   print (struct Lisp_Subr *) $ptr
 851   output *$
 852   echo \n
 853 end
 854 document xsubr
 855 Print the address of the subr which the Lisp_Object $ points to.
 856 end
 857
 858 define xchartable
 859   xgetptr $
 860   print (struct Lisp_Char_Table *) $ptr
 861   printf "Purpose: "
 862   xprintsym $->purpose
 863   printf "  %d extra slots", ($->header.size & 0x1ff) - 68
 864   echo \n
 865 end
 866 document xchartable
 867 Print the address of the char-table $, and its purpose.
 868 This command assumes that $ is an Emacs Lisp char-table value.
 869 end
 870
 871 define xsubchartable
 872   xgetptr $
 873   print (struct Lisp_Sub_Char_Table *) $ptr
 874   xgetint $->depth
 875   set $depth = $int
 876   xgetint $->min_char
 877   printf "Depth: %d, Min char: %d (0x%x)\n", $depth, $int, $int
 878 end
 879 document xsubchartable
 880 Print the address of the sub-char-table $, its depth and min-char.
 881 This command assumes that $ is an Emacs Lisp sub-char-table value.
 882 end
 883
 884 define xboolvector
 885   xgetptr $
 886   print (struct Lisp_Bool_Vector *) $ptr
 887   output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
 888   echo \n
 889 end
 890 document xboolvector
 891 Print the contents and address of the bool-vector $.
 892 This command assumes that $ is an Emacs Lisp bool-vector value.
 893 end
 894
 895 define xbuffer
 896   xgetptr $
 897   print (struct buffer *) $ptr
 898   xgetptr $->name_
 899   output ((struct Lisp_String *) $ptr)->data
 900   echo \n
 901 end
 902 document xbuffer
 903 Set $ as a buffer pointer and the name of the buffer.
 904 This command assumes $ is an Emacs Lisp buffer value.
 905 end
 906
 907 define xhashtable
 908   xgetptr $
 909   print (struct Lisp_Hash_Table *) $ptr
 910 end
 911 document xhashtable
 912 Set $ as a hash table pointer.
 913 This command assumes that $ is an Emacs Lisp hash table value.
 914 end
 915
 916 define xcons
 917   xgetptr $
 918   print (struct Lisp_Cons *) $ptr
 919   output/x *$
 920   echo \n
 921 end
 922 document xcons
 923 Print the contents of $ as an Emacs Lisp cons.
 924 end
 925
 926 define nextcons
 927   p $.u.cdr
 928   xcons
 929 end
 930 document nextcons
 931 Print the contents of the next cell in a list.
 932 This command assumes that the last thing you printed was a cons cell contents
 933 (type struct Lisp_Cons) or a pointer to one.
 934 end
 935 define xcar
 936   xgetptr $
 937   xgettype $
 938   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 939 end
 940 document xcar
 941 Assume that $ is an Emacs Lisp pair and print its car.
 942 end
 943
 944 define xcdr
 945   xgetptr $
 946   xgettype $
 947   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 948 end
 949 document xcdr
 950 Assume that $ is an Emacs Lisp pair and print its cdr.
 951 end
 952
 953 define xlist
 954   xgetptr $
 955   set $cons = (struct Lisp_Cons *) $ptr
 956   xgetptr Qnil
 957   set $nil = $ptr
 958   set $i = 0
 959   while $cons != $nil && $i < 10
 960     p/x $cons->car
 961     xpr
 962     xgetptr $cons->u.cdr
 963     set $cons = (struct Lisp_Cons *) $ptr
 964     set $i = $i + 1
 965     printf "---\n"
 966   end
 967   if $cons == $nil
 968     printf "nil\n"
 969   else
 970     printf "...\n"
 971     p $ptr
 972   end
 973 end
 974 document xlist
 975 Print $ assuming it is a list.
 976 end
 977
 978 define xfloat
 979   xgetptr $
 980   print ((struct Lisp_Float *) $ptr)->u.data
 981 end
 982 document xfloat
 983 Print $ assuming it is a lisp floating-point number.
 984 end
 985
 986 define xscrollbar
 987   xgetptr $
 988   print (struct scrollbar *) $ptr
 989 output *$
 990 echo \n
 991 end
 992 document xscrollbar
 993 Print $ as a scrollbar pointer.
 994 end
 995
 996 define xpr
 997   xtype
 998   if $type == Lisp_Int0 || $type == Lisp_Int1
 999     xint
1000   end
1001   if $type == Lisp_Symbol
1002     xsymbol
1003   end
1004   if $type == Lisp_String
1005     xstring
1006   end
1007   if $type == Lisp_Cons
1008     xcons
1009   end
1010   if $type == Lisp_Float
1011     xfloat
1012   end
1013   if $type == Lisp_Misc
1014     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
1015     if $misc == Lisp_Misc_Free
1016       xmiscfree
1017     end
1018     if $misc == Lisp_Misc_Marker
1019       xmarker
1020     end
1021     if $misc == Lisp_Misc_Overlay
1022       xoverlay
1023     end
1024 #    if $misc == Lisp_Misc_Save_Value
1025 #      xsavevalue
1026 #    end
1027   end
1028   if $type == Lisp_Vectorlike
1029     set $size = ((struct Lisp_Vector *) $ptr)->header.size
1030     if ($size & PSEUDOVECTOR_FLAG)
1031       set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
1032       if $vec == PVEC_NORMAL_VECTOR
1033         xvector
1034       end
1035       if $vec == PVEC_PROCESS
1036         xprocess
1037       end
1038       if $vec == PVEC_FRAME
1039         xframe
1040       end
1041       if $vec == PVEC_COMPILED
1042         xcompiled
1043       end
1044       if $vec == PVEC_WINDOW
1045         xwindow
1046       end
1047       if $vec == PVEC_WINDOW_CONFIGURATION
1048         xwinconfig
1049       end
1050       if $vec == PVEC_SUBR
1051         xsubr
1052       end
1053       if $vec == PVEC_CHAR_TABLE
1054         xchartable
1055       end
1056       if $vec == PVEC_BOOL_VECTOR
1057         xboolvector
1058       end
1059       if $vec == PVEC_BUFFER
1060         xbuffer
1061       end
1062       if $vec == PVEC_HASH_TABLE
1063         xhashtable
1064       end
1065     else
1066       xvector
1067     end
1068   end
1069 end
1070 document xpr
1071 Print $ as a lisp object of any type.
1072 end
1073
1074 define xprintstr
1075   set $data = (char *) $arg0->data
1076   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
1077 end
1078
1079 define xprintsym
1080   xgetptr $arg0
1081   set $sym = (struct Lisp_Symbol *) $ptr
1082   xgetptr $sym->name
1083   set $sym_name = (struct Lisp_String *) $ptr
1084   xprintstr $sym_name
1085 end
1086 document xprintsym
1087   Print argument as a symbol.
1088 end
1089
1090 define xcoding
1091   set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & VALMASK) | DATA_SEG_BITS)
1092   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
1093   set $name = $tmp->contents[$arg0 * 2]
1094   print $name
1095   pr
1096   print $tmp->contents[$arg0 * 2 + 1]
1097   pr
1098 end
1099 document xcoding
1100   Print the name and attributes of coding system that has ID (argument).
1101 end
1102
1103 define xcharset
1104   set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & VALMASK) | DATA_SEG_BITS)
1105   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
1106   p $tmp->contents[charset_table[$arg0].hash_index * 2]
1107   pr
1108 end
1109 document xcharset
1110   Print the name of charset that has ID (argument).
1111 end
1112
1113 define xfontset
1114   xgetptr $
1115   set $tbl = (struct Lisp_Char_Table *) $ptr
1116   print $tbl
1117   xgetint $tbl->extras[0]
1118   printf " ID:%d", $int
1119   xgettype $tbl->extras[1]
1120   xgetptr $tbl->extras[1]
1121   if $type == Lisp_String
1122     set $ptr = (struct Lisp_String *) $ptr
1123     printf " Name:"
1124     xprintstr $ptr
1125   else
1126     xgetptr $tbl->extras[2]
1127     set $ptr = (struct Lisp_Char_Table *) $ptr
1128     xgetptr $ptr->extras[1]
1129     set $ptr = (struct Lisp_String *) $ptr
1130     printf " Realized from:"
1131     xprintstr $ptr
1132   end
1133   echo \n
1134 end
1135
1136 define xfont
1137   xgetptr $
1138   set $size = (((struct Lisp_Vector *) $ptr)->header.size & 0x1FF)
1139   if $size == FONT_SPEC_MAX
1140     print (struct font_spec *) $ptr
1141   else
1142     if $size == FONT_ENTITY_MAX
1143       print (struct font_entity *) $ptr
1144     else
1145       print (struct font *) $ptr
1146     end
1147   end
1148 end
1149 document xfont
1150 Print $ assuming it is a list font (font-spec, font-entity, or font-object).
1151 end
1152
1153 define xbacktrace
1154   set $bt = backtrace_list
1155   while $bt
1156     xgettype ($bt->function)
1157     if $type == Lisp_Symbol
1158       xprintsym ($bt->function)
1159       printf " (0x%x)\n", $bt->args
1160     else
1161       xgetptr $bt->function
1162       printf "0x%x ", $ptr
1163       if $type == Lisp_Vectorlike
1164         xgetptr ($bt->function)
1165         set $size = ((struct Lisp_Vector *) $ptr)->header.size
1166         if ($size & PSEUDOVECTOR_FLAG)
1167           output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
1168         else
1169           output $size & ~ARRAY_MARK_FLAG
1170         end
1171       else
1172         printf "Lisp type %d", $type
1173       end
1174       echo \n
1175     end
1176     set $bt = $bt->next
1177   end
1178 end
1179 document xbacktrace
1180   Print a backtrace of Lisp function calls from backtrace_list.
1181   Set a breakpoint at Fsignal and call this to see from where
1182   an error was signaled.
1183 end
1184
1185 define xprintbytestr
1186   set $data = (char *) $arg0->data
1187   printf "Bytecode: "
1188   output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
1189 end
1190 document xprintbytestr
1191   Print a string of byte code.
1192 end
1193
1194 define xwhichsymbols
1195   set $output_debug = print_output_debug_flag
1196   set print_output_debug_flag = 0
1197   call safe_debug_print (which_symbols ($arg0, $arg1))
1198   set print_output_debug_flag = $output_debug
1199 end
1200 document xwhichsymbols
1201   Print symbols which references a given lisp object
1202   either as its symbol value or symbol function.
1203   Call with two arguments: the lisp object and the
1204   maximum number of symbols referencing it to produce.
1205 end
1206
1207 define xbytecode
1208   set $bt = byte_stack_list
1209   while $bt
1210     xgetptr $bt->byte_string
1211     set $ptr = (struct Lisp_String *) $ptr
1212     xprintbytestr $ptr
1213     printf "\n0x%x => ", $bt->byte_string
1214     xwhichsymbols $bt->byte_string 5
1215     set $bt = $bt->next
1216   end
1217 end
1218 document xbytecode
1219   Print a backtrace of the byte code stack.
1220 end
1221
1222 # Show Lisp backtrace after normal backtrace.
1223 define hookpost-backtrace
1224   set $bt = backtrace_list
1225   if $bt
1226     echo \n
1227     echo Lisp Backtrace:\n
1228     xbacktrace
1229   end
1230 end
1231
1232 # Flush display (X only)
1233 define ff
1234   set x_flush (0)
1235 end
1236 document ff
1237 Flush pending X window display updates to screen.
1238 Works only when an inferior emacs is executing.
1239 end
1240
1241
1242 set print pretty on
1243 set print sevenbit-strings
1244
1245 show environment DISPLAY
1246 show environment TERM
1247
1248 # When debugging, it is handy to be able to "return" from
1249 # terminate_due_to_signal when an assertion failure is non-fatal.
1250 break terminate_due_to_signal
1251
1252 # x_error_quitter is defined only on X.  But window-system is set up
1253 # only at run time, during Emacs startup, so we need to defer setting
1254 # the breakpoint.  init_sys_modes is the first function called on
1255 # every platform after init_display, where window-system is set.
1256 tbreak init_sys_modes
1257 commands
1258   silent
1259   xgetptr globals.f_Vinitial_window_system
1260   set $tem = (struct Lisp_Symbol *) $ptr
1261   xgetptr $tem->name
1262   set $tem = (struct Lisp_String *) $ptr
1263   set $tem = (char *) $tem->data
1264   # If we are running in synchronous mode, we want a chance to look
1265   # around before Emacs exits.  Perhaps we should put the break
1266   # somewhere else instead...
1267   if $tem[0] == 'x' && $tem[1] == '\0'
1268     break x_error_quitter
1269   end
1270   continue
1271 end