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