src/.gdbinit

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