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

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