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

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