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 xvectype
 655   xgetptr $
 656   set $size = ((struct Lisp_Vector *) $ptr)->header.size
 657   if ($size & PSEUDOVECTOR_FLAG)
 658     output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
 659   else
 660     output $size & ~ARRAY_MARK_FLAG
 661   end
 662   echo \n
 663 end
 664 document xvectype
 665 Print the size or vector subtype of $.
 666 This command assumes that $ is a vector or pseudovector.
 667 end
 668
 669 define xmisctype
 670   xgetptr $
 671   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 672   echo \n
 673 end
 674 document xmisctype
 675 Assume that $ is some misc type and print its specific type.
 676 end
 677
 678 define xint
 679   xgetint $
 680   print $int
 681 end
 682 document xint
 683 Print $ as an Emacs Lisp integer.  This gets the sign right.
 684 end
 685
 686 define xptr
 687   xgetptr $
 688   print (void *) $ptr
 689 end
 690 document xptr
 691 Print the pointer portion of an Emacs Lisp value in $.
 692 end
 693
 694 define xmarker
 695   xgetptr $
 696   print (struct Lisp_Marker *) $ptr
 697 end
 698 document xmarker
 699 Print $ as a marker pointer.
 700 This command assumes that $ is an Emacs Lisp marker value.
 701 end
 702
 703 define xoverlay
 704   xgetptr $
 705   print (struct Lisp_Overlay *) $ptr
 706 end
 707 document xoverlay
 708 Print $ as a overlay pointer.
 709 This command assumes that $ is an Emacs Lisp overlay value.
 710 end
 711
 712 define xmiscfree
 713   xgetptr $
 714   print (struct Lisp_Free *) $ptr
 715 end
 716 document xmiscfree
 717 Print $ as a misc free-cell pointer.
 718 This command assumes that $ is an Emacs Lisp Misc value.
 719 end
 720
 721 define xsymbol
 722   set $sym = $
 723   xgetptr $sym
 724   print (struct Lisp_Symbol *) $ptr
 725   xprintsym $sym
 726   echo \n
 727 end
 728 document xsymbol
 729 Print the name and address of the symbol $.
 730 This command assumes that $ is an Emacs Lisp symbol value.
 731 end
 732
 733 define xstring
 734   xgetptr $
 735   print (struct Lisp_String *) $ptr
 736   xprintstr $
 737   echo \n
 738 end
 739 document xstring
 740 Print the contents and address of the string $.
 741 This command assumes that $ is an Emacs Lisp string value.
 742 end
 743
 744 define xvector
 745   xgetptr $
 746   print (struct Lisp_Vector *) $ptr
 747   output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
 748 echo \n
 749 end
 750 document xvector
 751 Print the contents and address of the vector $.
 752 This command assumes that $ is an Emacs Lisp vector value.
 753 end
 754
 755 define xprocess
 756   xgetptr $
 757   print (struct Lisp_Process *) $ptr
 758   output *$
 759   echo \n
 760 end
 761 document xprocess
 762 Print the address of the struct Lisp_process to which $ points.
 763 This command assumes that $ is a Lisp_Object.
 764 end
 765
 766 define xframe
 767   xgetptr $
 768   print (struct frame *) $ptr
 769   xgetptr $->name
 770   set $ptr = (struct Lisp_String *) $ptr
 771   xprintstr $ptr
 772   echo \n
 773 end
 774 document xframe
 775 Print $ as a frame pointer.
 776 This command assumes $ is an Emacs Lisp frame value.
 777 end
 778
 779 define xcompiled
 780   xgetptr $
 781   print (struct Lisp_Vector *) $ptr
 782   output ($->contents[0])@($->header.size & 0xff)
 783 end
 784 document xcompiled
 785 Print $ as a compiled function pointer.
 786 This command assumes that $ is an Emacs Lisp compiled value.
 787 end
 788
 789 define xwindow
 790   xgetptr $
 791   print (struct window *) $ptr
 792   set $window = (struct window *) $ptr
 793   xgetint $window->total_cols
 794   set $width=$int
 795   xgetint $window->total_lines
 796   set $height=$int
 797   xgetint $window->left_col
 798   set $left=$int
 799   xgetint $window->top_line
 800   set $top=$int
 801   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 802 end
 803 document xwindow
 804 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 805 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 806 end
 807
 808 define xwinconfig
 809   xgetptr $
 810   print (struct save_window_data *) $ptr
 811 end
 812 document xwinconfig
 813 Print $ as a window configuration pointer.
 814 This command assumes that $ is an Emacs Lisp window configuration value.
 815 end
 816
 817 define xsubr
 818   xgetptr $
 819   print (struct Lisp_Subr *) $ptr
 820   output *$
 821   echo \n
 822 end
 823 document xsubr
 824 Print the address of the subr which the Lisp_Object $ points to.
 825 end
 826
 827 define xchartable
 828   xgetptr $
 829   print (struct Lisp_Char_Table *) $ptr
 830   printf "Purpose: "
 831   xprintsym $->purpose
 832   printf "  %d extra slots", ($->header.size & 0x1ff) - 68
 833   echo \n
 834 end
 835 document xchartable
 836 Print the address of the char-table $, and its purpose.
 837 This command assumes that $ is an Emacs Lisp char-table value.
 838 end
 839
 840 define xsubchartable
 841   xgetptr $
 842   print (struct Lisp_Sub_Char_Table *) $ptr
 843   xgetint $->depth
 844   set $depth = $int
 845   xgetint $->min_char
 846   printf "Depth: %d, Min char: %d (0x%x)\n", $depth, $int, $int
 847 end
 848 document xsubchartable
 849 Print the address of the sub-char-table $, its depth and min-char.
 850 This command assumes that $ is an Emacs Lisp sub-char-table value.
 851 end
 852
 853 define xboolvector
 854   xgetptr $
 855   print (struct Lisp_Bool_Vector *) $ptr
 856   output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
 857   echo \n
 858 end
 859 document xboolvector
 860 Print the contents and address of the bool-vector $.
 861 This command assumes that $ is an Emacs Lisp bool-vector value.
 862 end
 863
 864 define xbuffer
 865   xgetptr $
 866   print (struct buffer *) $ptr
 867   xgetptr $->name_
 868   output ((struct Lisp_String *) $ptr)->data
 869   echo \n
 870 end
 871 document xbuffer
 872 Set $ as a buffer pointer and the name of the buffer.
 873 This command assumes $ is an Emacs Lisp buffer value.
 874 end
 875
 876 define xhashtable
 877   xgetptr $
 878   print (struct Lisp_Hash_Table *) $ptr
 879 end
 880 document xhashtable
 881 Set $ as a hash table pointer.
 882 This command assumes that $ is an Emacs Lisp hash table value.
 883 end
 884
 885 define xcons
 886   xgetptr $
 887   print (struct Lisp_Cons *) $ptr
 888   output/x *$
 889   echo \n
 890 end
 891 document xcons
 892 Print the contents of $ as an Emacs Lisp cons.
 893 end
 894
 895 define nextcons
 896   p $.u.cdr
 897   xcons
 898 end
 899 document nextcons
 900 Print the contents of the next cell in a list.
 901 This command assumes that the last thing you printed was a cons cell contents
 902 (type struct Lisp_Cons) or a pointer to one.
 903 end
 904 define xcar
 905   xgetptr $
 906   xgettype $
 907   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 908 end
 909 document xcar
 910 Assume that $ is an Emacs Lisp pair and print its car.
 911 end
 912
 913 define xcdr
 914   xgetptr $
 915   xgettype $
 916   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 917 end
 918 document xcdr
 919 Assume that $ is an Emacs Lisp pair and print its cdr.
 920 end
 921
 922 define xlist
 923   xgetptr $
 924   set $cons = (struct Lisp_Cons *) $ptr
 925   xgetptr Qnil
 926   set $nil = $ptr
 927   set $i = 0
 928   while $cons != $nil && $i < 10
 929     p/x $cons->car
 930     xpr
 931     xgetptr $cons->u.cdr
 932     set $cons = (struct Lisp_Cons *) $ptr
 933     set $i = $i + 1
 934     printf "---\n"
 935   end
 936   if $cons == $nil
 937     printf "nil\n"
 938   else
 939     printf "...\n"
 940     p $ptr
 941   end
 942 end
 943 document xlist
 944 Print $ assuming it is a list.
 945 end
 946
 947 define xfloat
 948   xgetptr $
 949   print ((struct Lisp_Float *) $ptr)->u.data
 950 end
 951 document xfloat
 952 Print $ assuming it is a lisp floating-point number.
 953 end
 954
 955 define xscrollbar
 956   xgetptr $
 957   print (struct scrollbar *) $ptr
 958 output *$
 959 echo \n
 960 end
 961 document xscrollbar
 962 Print $ as a scrollbar pointer.
 963 end
 964
 965 define xpr
 966   xtype
 967   if $type == Lisp_Int0 || $type == Lisp_Int1
 968     xint
 969   end
 970   if $type == Lisp_Symbol
 971     xsymbol
 972   end
 973   if $type == Lisp_String
 974     xstring
 975   end
 976   if $type == Lisp_Cons
 977     xcons
 978   end
 979   if $type == Lisp_Float
 980     xfloat
 981   end
 982   if $type == Lisp_Misc
 983     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 984     if $misc == Lisp_Misc_Free
 985       xmiscfree
 986     end
 987     if $misc == Lisp_Misc_Marker
 988       xmarker
 989     end
 990     if $misc == Lisp_Misc_Overlay
 991       xoverlay
 992     end
 993 #    if $misc == Lisp_Misc_Save_Value
 994 #      xsavevalue
 995 #    end
 996   end
 997   if $type == Lisp_Vectorlike
 998     set $size = ((struct Lisp_Vector *) $ptr)->header.size
 999     if ($size & PSEUDOVECTOR_FLAG)
1000       set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
1001       if $vec == PVEC_NORMAL_VECTOR
1002         xvector
1003       end
1004       if $vec == PVEC_PROCESS
1005         xprocess
1006       end
1007       if $vec == PVEC_FRAME
1008         xframe
1009       end
1010       if $vec == PVEC_COMPILED
1011         xcompiled
1012       end
1013       if $vec == PVEC_WINDOW
1014         xwindow
1015       end
1016       if $vec == PVEC_WINDOW_CONFIGURATION
1017         xwinconfig
1018       end
1019       if $vec == PVEC_SUBR
1020         xsubr
1021       end
1022       if $vec == PVEC_CHAR_TABLE
1023         xchartable
1024       end
1025       if $vec == PVEC_BOOL_VECTOR
1026         xboolvector
1027       end
1028       if $vec == PVEC_BUFFER
1029         xbuffer
1030       end
1031       if $vec == PVEC_HASH_TABLE
1032         xhashtable
1033       end
1034     else
1035       xvector
1036     end
1037   end
1038 end
1039 document xpr
1040 Print $ as a lisp object of any type.
1041 end
1042
1043 define xprintstr
1044   set $data = (char *) $arg0->data
1045   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
1046 end
1047
1048 define xprintsym
1049   xgetptr $arg0
1050   set $sym = (struct Lisp_Symbol *) $ptr
1051   xgetptr $sym->name
1052   set $sym_name = (struct Lisp_String *) $ptr
1053   xprintstr $sym_name
1054 end
1055 document xprintsym
1056   Print argument as a symbol.
1057 end
1058
1059 define xcoding
1060   set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & VALMASK) | DATA_SEG_BITS)
1061   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
1062   set $name = $tmp->contents[$arg0 * 2]
1063   print $name
1064   pr
1065   print $tmp->contents[$arg0 * 2 + 1]
1066   pr
1067 end
1068 document xcoding
1069   Print the name and attributes of coding system that has ID (argument).
1070 end
1071
1072 define xcharset
1073   set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & VALMASK) | DATA_SEG_BITS)
1074   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
1075   p $tmp->contents[charset_table[$arg0].hash_index * 2]
1076   pr
1077 end
1078 document xcharset
1079   Print the name of charset that has ID (argument).
1080 end
1081
1082 define xfontset
1083   xgetptr $
1084   set $tbl = (struct Lisp_Char_Table *) $ptr
1085   print $tbl
1086   xgetint $tbl->extras[0]
1087   printf " ID:%d", $int
1088   xgettype $tbl->extras[1]
1089   xgetptr $tbl->extras[1]
1090   if $type == Lisp_String
1091     set $ptr = (struct Lisp_String *) $ptr
1092     printf " Name:"
1093     xprintstr $ptr
1094   else
1095     xgetptr $tbl->extras[2]
1096     set $ptr = (struct Lisp_Char_Table *) $ptr
1097     xgetptr $ptr->extras[1]
1098     set $ptr = (struct Lisp_String *) $ptr
1099     printf " Realized from:"
1100     xprintstr $ptr
1101   end
1102   echo \n
1103 end
1104
1105 define xfont
1106   xgetptr $
1107   set $size = (((struct Lisp_Vector *) $ptr)->header.size & 0x1FF)
1108   if $size == FONT_SPEC_MAX
1109     print (struct font_spec *) $ptr
1110   else
1111     if $size == FONT_ENTITY_MAX
1112       print (struct font_entity *) $ptr
1113     else
1114       print (struct font *) $ptr
1115     end
1116   end
1117 end
1118 document xfont
1119 Print $ assuming it is a list font (font-spec, font-entity, or font-object).
1120 end
1121
1122 define xbacktrace
1123   set $bt = backtrace_list
1124   while $bt
1125     xgettype ($bt->function)
1126     if $type == Lisp_Symbol
1127       xprintsym ($bt->function)
1128       printf " (0x%x)\n", $bt->args
1129     else
1130       xgetptr $bt->function
1131       printf "0x%x ", $ptr
1132       if $type == Lisp_Vectorlike
1133         xgetptr ($bt->function)
1134         set $size = ((struct Lisp_Vector *) $ptr)->header.size
1135         if ($size & PSEUDOVECTOR_FLAG)
1136           output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
1137         else
1138           output $size & ~ARRAY_MARK_FLAG
1139         end
1140       else
1141         printf "Lisp type %d", $type
1142       end
1143       echo \n
1144     end
1145     set $bt = $bt->next
1146   end
1147 end
1148 document xbacktrace
1149   Print a backtrace of Lisp function calls from backtrace_list.
1150   Set a breakpoint at Fsignal and call this to see from where
1151   an error was signaled.
1152 end
1153
1154 define xprintbytestr
1155   set $data = (char *) $arg0->data
1156   printf "Bytecode: "
1157   output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
1158 end
1159 document xprintbytestr
1160   Print a string of byte code.
1161 end
1162
1163 define xwhichsymbols
1164   set $output_debug = print_output_debug_flag
1165   set print_output_debug_flag = 0
1166   call safe_debug_print (which_symbols ($arg0, $arg1))
1167   set print_output_debug_flag = $output_debug
1168 end
1169 document xwhichsymbols
1170   Print symbols which references a given lisp object
1171   either as its symbol value or symbol function.
1172   Call with two arguments: the lisp object and the
1173   maximum number of symbols referencing it to produce.
1174 end
1175
1176 define xbytecode
1177   set $bt = byte_stack_list
1178   while $bt
1179     xgetptr $bt->byte_string
1180     set $ptr = (struct Lisp_String *) $ptr
1181     xprintbytestr $ptr
1182     printf "\n0x%x => ", $bt->byte_string
1183     xwhichsymbols $bt->byte_string 5
1184     set $bt = $bt->next
1185   end
1186 end
1187 document xbytecode
1188   Print a backtrace of the byte code stack.
1189 end
1190
1191 # Show Lisp backtrace after normal backtrace.
1192 define hookpost-backtrace
1193   set $bt = backtrace_list
1194   if $bt
1195     echo \n
1196     echo Lisp Backtrace:\n
1197     xbacktrace
1198   end
1199 end
1200
1201 # Flush display (X only)
1202 define ff
1203   set x_flush (0)
1204 end
1205 document ff
1206 Flush pending X window display updates to screen.
1207 Works only when an inferior emacs is executing.
1208 end
1209
1210
1211 set print pretty on
1212 set print sevenbit-strings
1213
1214 show environment DISPLAY
1215 show environment TERM
1216
1217 # When debugging, it is handy to be able to "return" from
1218 # terminate_due_to_signal when an assertion failure is non-fatal.
1219 break terminate_due_to_signal
1220
1221 # x_error_quitter is defined only on X.  But window-system is set up
1222 # only at run time, during Emacs startup, so we need to defer setting
1223 # the breakpoint.  init_sys_modes is the first function called on
1224 # every platform after init_display, where window-system is set.
1225 tbreak init_sys_modes
1226 commands
1227   silent
1228   xgetptr globals.f_Vinitial_window_system
1229   set $tem = (struct Lisp_Symbol *) $ptr
1230   xgetptr $tem->name
1231   set $tem = (struct Lisp_String *) $ptr
1232   set $tem = (char *) $tem->data
1233   # If we are running in synchronous mode, we want a chance to look
1234   # around before Emacs exits.  Perhaps we should put the break
1235   # somewhere else instead...
1236   if $tem[0] == 'x' && $tem[1] == '\0'
1237     break x_error_quitter
1238   end
1239   continue
1240 end