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 # Access the name of a symbol
  74 define xsymname
  75   if (CHECK_LISP_OBJECT_TYPE)
  76     set $bugfix = $arg0.i
  77   else
  78     set $bugfix = $arg0
  79   end
  80   set $symname = ((struct Lisp_Symbol *) ((char *)lispsym + $bugfix))->name
  81 end
  82
  83 # Set up something to print out s-expressions.
  84 # We save and restore print_output_debug_flag to prevent the w32 port
  85 # from calling OutputDebugString, which causes GDB to display each
  86 # character twice (yuk!).
  87 define pr
  88   pp $
  89 end
  90 document pr
  91 Print the emacs s-expression which is $.
  92 Works only when an inferior emacs is executing.
  93 end
  94
  95 # Print out s-expressions
  96 define pp
  97   set $tmp = $arg0
  98   set $output_debug = print_output_debug_flag
  99   set print_output_debug_flag = 0
 100   call safe_debug_print ($tmp)
 101   set print_output_debug_flag = $output_debug
 102 end
 103 document pp
 104 Print the argument as an emacs s-expression
 105 Works only when an inferior emacs is executing.
 106 end
 107
 108 # Print value of lisp variable
 109 define pv
 110   set $tmp = "$arg0"
 111   set $output_debug = print_output_debug_flag
 112   set print_output_debug_flag = 0
 113   call safe_debug_print (find_symbol_value (intern ($tmp)))
 114   set print_output_debug_flag = $output_debug
 115 end
 116 document pv
 117 Print the value of the lisp variable given as argument.
 118 Works only when an inferior emacs is executing.
 119 end
 120
 121 # Print out current buffer point and boundaries
 122 define ppt
 123   set $b = current_buffer
 124   set $t = $b->text
 125   printf "BUF PT: %d", $b->pt
 126   if ($b->pt != $b->pt_byte)
 127     printf "[%d]", $b->pt_byte
 128   end
 129   printf " of 1..%d", $t->z
 130   if ($t->z != $t->z_byte)
 131     printf "[%d]", $t->z_byte
 132   end
 133   if ($b->begv != 1 || $b->zv != $t->z)
 134     printf " NARROW=%d..%d", $b->begv, $b->zv
 135     if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
 136       printf " [%d..%d]", $b->begv_byte, $b->zv_byte
 137     end
 138   end
 139   printf " GAP: %d", $t->gpt
 140   if ($t->gpt != $t->gpt_byte)
 141     printf "[%d]", $t->gpt_byte
 142   end
 143   printf " SZ=%d\n", $t->gap_size
 144 end
 145 document ppt
 146 Print current buffer's point and boundaries.
 147 Prints values of point, beg, end, narrow, and gap for current buffer.
 148 end
 149
 150 define pitmethod
 151   set $itmethod = $arg0
 152   # output $itmethod
 153   if ($itmethod == 0)
 154     printf "GET_FROM_BUFFER"
 155   end
 156   if ($itmethod == 1)
 157     printf "GET_FROM_DISPLAY_VECTOR"
 158   end
 159   if ($itmethod == 2)
 160     printf "GET_FROM_STRING"
 161   end
 162   if ($itmethod == 3)
 163     printf "GET_FROM_C_STRING"
 164   end
 165   if ($itmethod == 4)
 166     printf "GET_FROM_IMAGE"
 167   end
 168   if ($itmethod == 5)
 169     printf "GET_FROM_STRETCH"
 170   end
 171   if ($itmethod < 0 || $itmethod > 5)
 172     output $itmethod
 173   end
 174 end
 175 document pitmethod
 176 Pretty print it->method given as first arg
 177 end
 178
 179 # Print out iterator given as first arg
 180 define pitx
 181   set $it = $arg0
 182   printf "cur=%d", $it->current.pos.charpos
 183   if ($it->current.pos.charpos != $it->current.pos.bytepos)
 184     printf "[%d]", $it->current.pos.bytepos
 185   end
 186   printf " pos=%d", $it->position.charpos
 187   if ($it->position.charpos != $it->position.bytepos)
 188     printf "[%d]", $it->position.bytepos
 189   end
 190   printf " start=%d", $it->start.pos.charpos
 191   if ($it->start.pos.charpos != $it->start.pos.bytepos)
 192     printf "[%d]", $it->start.pos.bytepos
 193   end
 194   printf " end=%d", $it->end_charpos
 195   printf " stop=%d", $it->stop_charpos
 196   printf " face=%d", $it->face_id
 197   if ($it->multibyte_p)
 198     printf " MB"
 199   end
 200   if ($it->header_line_p)
 201     printf " HL"
 202   end
 203   if ($it->n_overlay_strings > 0)
 204     printf " nov=%d", $it->n_overlay_strings
 205   end
 206   if ($it->sp != 0)
 207     printf " sp=%d", $it->sp
 208   end
 209   # IT_CHARACTER
 210   if ($it->what == 0)
 211     if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
 212       printf " ch='%c'", $it->c
 213     else
 214       printf " ch=[%d,%d]", $it->c, $it->len
 215     end
 216   else
 217     printf " "
 218     # output $it->what
 219     if ($it->what == 0)
 220       printf "IT_CHARACTER"
 221     end
 222     if ($it->what == 1)
 223       printf "IT_COMPOSITION"
 224     end
 225     if ($it->what == 2)
 226       printf "IT_IMAGE"
 227     end
 228     if ($it->what == 3)
 229       printf "IT_STRETCH"
 230     end
 231     if ($it->what == 4)
 232       printf "IT_EOB"
 233     end
 234     if ($it->what == 5)
 235       printf "IT_TRUNCATION"
 236     end
 237     if ($it->what == 6)
 238       printf "IT_CONTINUATION"
 239     end
 240     if ($it->what < 0 || $it->what > 6)
 241       output $it->what
 242     end
 243   end
 244   if ($it->method != 0)
 245     # !GET_FROM_BUFFER
 246     printf " next="
 247     pitmethod $it->method
 248     if ($it->method == 2)
 249       # GET_FROM_STRING
 250       printf "[%d]", $it->current.string_pos.charpos
 251     end
 252     if ($it->method == 4)
 253       # GET_FROM_IMAGE
 254       printf "[%d]", $it->image_id
 255     end
 256   end
 257   printf "\n"
 258   if ($it->bidi_p)
 259     printf "BIDI: base_stop=%d prev_stop=%d level=%d\n", $it->base_level_stop, $it->prev_stop, $it->bidi_it.resolved_level
 260   end
 261   if ($it->region_beg_charpos >= 0)
 262     printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
 263   end
 264   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
 265   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
 266   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
 267   printf " w=%d", $it->pixel_width
 268   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
 269   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
 270   printf "\n"
 271   set $i = 0
 272   while ($i < $it->sp && $i < 4)
 273     set $e = $it->stack[$i]
 274     printf "stack[%d]: ", $i
 275     pitmethod $e.method
 276     printf "[%d]", $e.position.charpos
 277     printf "\n"
 278     set $i = $i + 1
 279   end
 280 end
 281 document pitx
 282 Pretty print a display iterator.
 283 Take one arg, an iterator object or pointer.
 284 end
 285
 286 define pit
 287   pitx it
 288 end
 289 document pit
 290 Pretty print the display iterator it.
 291 end
 292
 293 define prowx
 294   set $row = $arg0
 295   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
 296   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
 297   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
 298   printf " vis=%d\n", $row->visible_height
 299   printf "used=(LMargin=%d,Text=%d,RMargin=%d) Hash=%d\n", $row->used[0], $row->used[1], $row->used[2], $row->hash
 300   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
 301   if ($row->enabled_p)
 302     printf " ENA"
 303   end
 304   if ($row->displays_text_p)
 305     printf " DISP"
 306   end
 307   if ($row->mode_line_p)
 308     printf " MODEL"
 309   end
 310   if ($row->continued_p)
 311     printf " CONT"
 312   end
 313   if ($row-> truncated_on_left_p)
 314     printf " TRUNC:L"
 315   end
 316   if ($row-> truncated_on_right_p)
 317     printf " TRUNC:R"
 318   end
 319   if ($row->starts_in_middle_of_char_p)
 320     printf " STARTMID"
 321   end
 322   if ($row->ends_in_middle_of_char_p)
 323     printf " ENDMID"
 324   end
 325   if ($row->ends_in_newline_from_string_p)
 326     printf " ENDNLFS"
 327   end
 328   if ($row->ends_at_zv_p)
 329     printf " ENDZV"
 330   end
 331   if ($row->overlapped_p)
 332     printf " OLAPD"
 333   end
 334   if ($row->overlapping_p)
 335     printf " OLAPNG"
 336   end
 337   printf "\n"
 338 end
 339 document prowx
 340 Pretty print information about glyph_row.
 341 Takes one argument, a row object or pointer.
 342 end
 343
 344 define prow
 345   prowx row
 346 end
 347 document prow
 348 Pretty print information about glyph_row in row.
 349 end
 350
 351
 352 define pcursorx
 353   set $cp = $arg0
 354   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
 355 end
 356 document pcursorx
 357 Pretty print a window cursor.
 358 end
 359
 360 define pcursor
 361   printf "output: "
 362   pcursorx output_cursor
 363   printf "\n"
 364 end
 365 document pcursor
 366 Pretty print the output_cursor.
 367 end
 368
 369 define pwinx
 370   set $w = $arg0
 371   if ($w->mini_p != Qnil)
 372     printf "Mini "
 373   end
 374   printf "Window %d ", $int
 375   xgetptr $w->buffer
 376   set $tem = (struct buffer *) $ptr
 377   xgetptr $tem->name_
 378   printf "%s", ((struct Lisp_String *) $ptr)->data
 379   printf "\n"
 380   xgetptr $w->start
 381   set $tem = (struct Lisp_Marker *) $ptr
 382   printf "start=%d end:", $tem->charpos
 383   if ($w->window_end_valid != Qnil)
 384     xgetint $w->window_end_pos
 385     printf "pos=%d", $int
 386     xgetint $w->window_end_vpos
 387     printf " vpos=%d", $int
 388   else
 389     printf "invalid"
 390   end
 391   printf " vscroll=%d", $w->vscroll
 392   if ($w->force_start != Qnil)
 393     printf " FORCE_START"
 394   end
 395   if ($w->must_be_updated_p)
 396     printf " MUST_UPD"
 397   end
 398   printf "\n"
 399   printf "cursor: "
 400   pcursorx $w->cursor
 401   printf "  phys: "
 402   pcursorx $w->phys_cursor
 403   if ($w->phys_cursor_on_p)
 404     printf " ON"
 405   else
 406     printf " OFF"
 407   end
 408   printf " blk="
 409   if ($w->last_cursor_off_p != $w->cursor_off_p)
 410     if ($w->last_cursor_off_p)
 411       printf "ON->"
 412     else
 413       printf "OFF->"
 414     end
 415   end
 416   if ($w->cursor_off_p)
 417     printf "ON"
 418   else
 419     printf "OFF"
 420   end
 421   printf "\n"
 422 end
 423 document pwinx
 424 Pretty print a window structure.
 425 Takes one argument, a pointer to a window structure.
 426 end
 427
 428 define pwin
 429   pwinx w
 430 end
 431 document pwin
 432 Pretty print window structure w.
 433 end
 434
 435 define pbiditype
 436   if ($arg0 == 0)
 437     printf "UNDEF"
 438   end
 439   if ($arg0 == 1)
 440     printf "L"
 441   end
 442   if ($arg0 == 2)
 443     printf "R"
 444   end
 445   if ($arg0 == 3)
 446     printf "EN"
 447   end
 448   if ($arg0 == 4)
 449     printf "AN"
 450   end
 451   if ($arg0 == 5)
 452     printf "BN"
 453   end
 454   if ($arg0 == 6)
 455     printf "B"
 456   end
 457   if ($arg0 < 0 || $arg0 > 6)
 458     printf "%d??", $arg0
 459   end
 460 end
 461 document pbiditype
 462 Print textual description of bidi type given as first argument.
 463 end
 464
 465 define pgx
 466   set $g = $arg0
 467   # CHAR_GLYPH
 468   if ($g.type == 0)
 469     if ($g.u.ch >= ' ' && $g.u.ch < 127)
 470       printf "CHAR[%c]", $g.u.ch
 471     else
 472       printf "CHAR[0x%x]", $g.u.ch
 473     end
 474   end
 475   # COMPOSITE_GLYPH
 476   if ($g.type == 1)
 477     printf "COMP[%d (%d..%d)]", $g.u.cmp.id, $g.slice.cmp.from, $g.slice.cmp.to
 478   end
 479   # GLYPHLESS_GLYPH
 480   if ($g.type == 2)
 481     printf "G-LESS["
 482     if ($g.u.glyphless.method == 0)
 483       printf "THIN;0x%x]", $g.u.glyphless.ch
 484     end
 485     if ($g.u.glyphless.method == 1)
 486       printf "EMPTY;0x%x]", $g.u.glyphless.ch
 487     end
 488     if ($g.u.glyphless.method == 2)
 489       printf "ACRO;0x%x]", $g.u.glyphless.ch
 490     end
 491     if ($g.u.glyphless.method == 3)
 492       printf "HEX;0x%x]", $g.u.glyphless.ch
 493     end
 494   end
 495   # IMAGE_GLYPH
 496   if ($g.type == 3)
 497     printf "IMAGE[%d]", $g.u.img_id
 498   end
 499   # STRETCH_GLYPH
 500   if ($g.type == 4)
 501     printf "STRETCH[%d+%d]", $g.u.stretch.height, $g.u.stretch.ascent
 502   end
 503   xgettype ($g.object)
 504   if ($type == Lisp_String)
 505     xgetptr $g.object
 506     printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->data, $g.charpos
 507   else
 508     printf " pos=%d", $g.charpos
 509   end
 510   # For characters, print their resolved level and bidi type
 511   if ($g.type == 0 || $g.type == 2)
 512     printf " blev=%d,btyp=", $g.resolved_level
 513     pbiditype $g.bidi_type
 514   end
 515   printf " w=%d a+d=%d+%d", $g.pixel_width, $g.ascent, $g.descent
 516   # If not DEFAULT_FACE_ID
 517   if ($g.face_id != 0)
 518     printf " face=%d", $g.face_id
 519   end
 520   if ($g.voffset)
 521     printf " vof=%d", $g.voffset
 522   end
 523   if ($g.multibyte_p)
 524     printf " MB"
 525   end
 526   if ($g.padding_p)
 527     printf " PAD"
 528   end
 529   if ($g.glyph_not_available_p)
 530     printf " N/A"
 531   end
 532   if ($g.overlaps_vertically_p)
 533     printf " OVL"
 534   end
 535   if ($g.avoid_cursor_p)
 536     printf " AVOID"
 537   end
 538   if ($g.left_box_line_p)
 539     printf " ["
 540   end
 541   if ($g.right_box_line_p)
 542     printf " ]"
 543   end
 544   if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
 545     printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height
 546   end
 547   printf "\n"
 548 end
 549 document pgx
 550 Pretty print a glyph structure.
 551 Takes one argument, a pointer to a glyph structure.
 552 end
 553
 554 define pg
 555   set $pgidx = 0
 556   pgx glyph
 557 end
 558 document pg
 559 Pretty print glyph structure glyph.
 560 end
 561
 562 define pgi
 563   set $pgidx = $arg0
 564   pgx (&glyph[$pgidx])
 565 end
 566 document pgi
 567 Pretty print glyph structure glyph[I].
 568 Takes one argument, a integer I.
 569 end
 570
 571 define pgn
 572   set $pgidx = $pgidx + 1
 573   pgx (&glyph[$pgidx])
 574 end
 575 document pgn
 576 Pretty print next glyph structure.
 577 end
 578
 579 define pgrowx
 580   set $row = $arg0
 581   set $area = 0
 582   set $xofs = $row->x
 583   while ($area < 3)
 584     set $used = $row->used[$area]
 585     if ($used > 0)
 586       set $gl0 = $row->glyphs[$area]
 587       set $pgidx = 0
 588       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 589       while ($pgidx < $used)
 590         printf "%3d %4d: ", $pgidx, $xofs
 591         pgx $gl0[$pgidx]
 592         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 593         set $pgidx = $pgidx + 1
 594       end
 595     end
 596     set $area = $area + 1
 597   end
 598 end
 599 document pgrowx
 600 Pretty print all glyphs in a row structure.
 601 Takes one argument, a pointer to a row structure.
 602 end
 603
 604 define pgrow
 605   pgrowx row
 606 end
 607 document pgrow
 608 Pretty print all glyphs in row structure row.
 609 end
 610
 611 define pgrowit
 612   pgrowx it->glyph_row
 613 end
 614 document pgrowit
 615 Pretty print all glyphs in it->glyph_row.
 616 end
 617
 618 define prowlims
 619   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
 620 end
 621 document prowlims
 622 Print important attributes of a glyph_row structure.
 623 Takes one argument, a pointer to a glyph_row structure.
 624 end
 625
 626 define pmtxrows
 627   set $mtx = $arg0
 628   set $gl = $mtx->rows
 629   set $glend = $mtx->rows + $mtx->nrows - 1
 630   set $i = 0
 631   while ($gl < $glend)
 632     printf "%d: ", $i
 633     prowlims $gl
 634     set $gl = $gl + 1
 635     set $i = $i + 1
 636   end
 637 end
 638 document pmtxrows
 639 Print data about glyph rows in a glyph matrix.
 640 Takes one argument, a pointer to a glyph_matrix structure.
 641 end
 642
 643 define xtype
 644   xgettype $
 645   output $type
 646   echo \n
 647   if $type == Lisp_Misc
 648     xmisctype
 649   else
 650     if $type == Lisp_Vectorlike
 651       xvectype
 652     end
 653   end
 654 end
 655 document xtype
 656 Print the type of $, assuming it is an Emacs Lisp value.
 657 If the first type printed is Lisp_Vector or Lisp_Misc,
 658 a second line gives the more precise type.
 659 end
 660
 661 define pvectype
 662   set $size = ((struct Lisp_Vector *) $arg0)->header.size
 663   if ($size & PSEUDOVECTOR_FLAG)
 664     output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
 665   else
 666     output PVEC_NORMAL_VECTOR
 667   end
 668   echo \n
 669 end
 670 document pvectype
 671 Print the subtype of vectorlike object.
 672 Takes one argument, a pointer to an object.
 673 end
 674
 675 define xvectype
 676   xgetptr $
 677   pvectype $ptr
 678 end
 679 document xvectype
 680 Print the subtype of vectorlike object.
 681 This command assumes that $ is a Lisp_Object.
 682 end
 683
 684 define pvecsize
 685   set $size = ((struct Lisp_Vector *) $arg0)->header.size
 686   if ($size & PSEUDOVECTOR_FLAG)
 687     output ($size & PSEUDOVECTOR_SIZE_MASK)
 688     echo \n
 689     output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS)
 690   else
 691     output ($size & ~ARRAY_MARK_FLAG)
 692   end
 693   echo \n
 694 end
 695 document pvecsize
 696 Print the size of vectorlike object.
 697 Takes one argument, a pointer to an object.
 698 end
 699
 700 define xvecsize
 701   xgetptr $
 702   pvecsize $ptr
 703 end
 704 document xvecsize
 705 Print the size of $
 706 This command assumes that $ is a Lisp_Object.
 707 end
 708
 709 define xmisctype
 710   xgetptr $
 711   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 712   echo \n
 713 end
 714 document xmisctype
 715 Assume that $ is some misc type and print its specific type.
 716 end
 717
 718 define xint
 719   xgetint $
 720   print $int
 721 end
 722 document xint
 723 Print $ as an Emacs Lisp integer.  This gets the sign right.
 724 end
 725
 726 define xptr
 727   xgetptr $
 728   print (void *) $ptr
 729 end
 730 document xptr
 731 Print the pointer portion of an Emacs Lisp value in $.
 732 end
 733
 734 define xmarker
 735   xgetptr $
 736   print (struct Lisp_Marker *) $ptr
 737 end
 738 document xmarker
 739 Print $ as a marker pointer.
 740 This command assumes that $ is an Emacs Lisp marker value.
 741 end
 742
 743 define xoverlay
 744   xgetptr $
 745   print (struct Lisp_Overlay *) $ptr
 746 end
 747 document xoverlay
 748 Print $ as a overlay pointer.
 749 This command assumes that $ is an Emacs Lisp overlay value.
 750 end
 751
 752 define xmiscfree
 753   xgetptr $
 754   print (struct Lisp_Free *) $ptr
 755 end
 756 document xmiscfree
 757 Print $ as a misc free-cell pointer.
 758 This command assumes that $ is an Emacs Lisp Misc value.
 759 end
 760
 761 define xsymbol
 762   set $sym = $
 763   xgetptr $sym
 764   print (struct Lisp_Symbol *) $ptr
 765   xprintsym $sym
 766   echo \n
 767 end
 768 document xsymbol
 769 Print the name and address of the symbol $.
 770 This command assumes that $ is an Emacs Lisp symbol value.
 771 end
 772
 773 define xstring
 774   xgetptr $
 775   print (struct Lisp_String *) $ptr
 776   xprintstr $
 777   echo \n
 778 end
 779 document xstring
 780 Print the contents and address of the string $.
 781 This command assumes that $ is an Emacs Lisp string value.
 782 end
 783
 784 define xvector
 785   xgetptr $
 786   print (struct Lisp_Vector *) $ptr
 787   output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
 788 echo \n
 789 end
 790 document xvector
 791 Print the contents and address of the vector $.
 792 This command assumes that $ is an Emacs Lisp vector value.
 793 end
 794
 795 define xprocess
 796   xgetptr $
 797   print (struct Lisp_Process *) $ptr
 798   output *$
 799   echo \n
 800 end
 801 document xprocess
 802 Print the address of the struct Lisp_process to which $ points.
 803 This command assumes that $ is a Lisp_Object.
 804 end
 805
 806 define xframe
 807   xgetptr $
 808   print (struct frame *) $ptr
 809   xgetptr $->name
 810   set $ptr = (struct Lisp_String *) $ptr
 811   xprintstr $ptr
 812   echo \n
 813 end
 814 document xframe
 815 Print $ as a frame pointer.
 816 This command assumes $ is an Emacs Lisp frame value.
 817 end
 818
 819 define xcompiled
 820   xgetptr $
 821   print (struct Lisp_Vector *) $ptr
 822   output ($->contents[0])@($->header.size & 0xff)
 823 end
 824 document xcompiled
 825 Print $ as a compiled function pointer.
 826 This command assumes that $ is an Emacs Lisp compiled value.
 827 end
 828
 829 define xwindow
 830   xgetptr $
 831   print (struct window *) $ptr
 832   set $window = (struct window *) $ptr
 833   printf "%dx%d+%d+%d\n", $window->total_cols, $window->total_lines, $window->left_col, $window->top_line
 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   set $subchartab = (struct Lisp_Sub_Char_Table *) $ptr
 876   printf "Depth: %d, Min char: %d (0x%x)\n", $subchartab->depth, $subchartab->min_char, $subchartab->min_char
 877 end
 878 document xsubchartable
 879 Print the address of the sub-char-table $, its depth and min-char.
 880 This command assumes that $ is an Emacs Lisp sub-char-table value.
 881 end
 882
 883 define xboolvector
 884   xgetptr $
 885   print (struct Lisp_Bool_Vector *) $ptr
 886   output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
 887   echo \n
 888 end
 889 document xboolvector
 890 Print the contents and address of the bool-vector $.
 891 This command assumes that $ is an Emacs Lisp bool-vector value.
 892 end
 893
 894 define xbuffer
 895   xgetptr $
 896   print (struct buffer *) $ptr
 897   xgetptr $->name_
 898   output ((struct Lisp_String *) $ptr)->data
 899   echo \n
 900 end
 901 document xbuffer
 902 Set $ as a buffer pointer and the name of the buffer.
 903 This command assumes $ is an Emacs Lisp buffer value.
 904 end
 905
 906 define xhashtable
 907   xgetptr $
 908   print (struct Lisp_Hash_Table *) $ptr
 909 end
 910 document xhashtable
 911 Set $ as a hash table pointer.
 912 This command assumes that $ is an Emacs Lisp hash table value.
 913 end
 914
 915 define xcons
 916   xgetptr $
 917   print (struct Lisp_Cons *) $ptr
 918   output/x *$
 919   echo \n
 920 end
 921 document xcons
 922 Print the contents of $ as an Emacs Lisp cons.
 923 end
 924
 925 define nextcons
 926   p $.u.cdr
 927   xcons
 928 end
 929 document nextcons
 930 Print the contents of the next cell in a list.
 931 This command assumes that the last thing you printed was a cons cell contents
 932 (type struct Lisp_Cons) or a pointer to one.
 933 end
 934 define xcar
 935   xgetptr $
 936   xgettype $
 937   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 938 end
 939 document xcar
 940 Assume that $ is an Emacs Lisp pair and print its car.
 941 end
 942
 943 define xcdr
 944   xgetptr $
 945   xgettype $
 946   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 947 end
 948 document xcdr
 949 Assume that $ is an Emacs Lisp pair and print its cdr.
 950 end
 951
 952 define xlist
 953   xgetptr $
 954   set $cons = (struct Lisp_Cons *) $ptr
 955   xgetptr Qnil
 956   set $nil = $ptr
 957   set $i = 0
 958   while $cons != $nil && $i < 10
 959     p/x $cons->car
 960     xpr
 961     xgetptr $cons->u.cdr
 962     set $cons = (struct Lisp_Cons *) $ptr
 963     set $i = $i + 1
 964     printf "---\n"
 965   end
 966   if $cons == $nil
 967     printf "nil\n"
 968   else
 969     printf "...\n"
 970     p $ptr
 971   end
 972 end
 973 document xlist
 974 Print $ assuming it is a list.
 975 end
 976
 977 define xfloat
 978   xgetptr $
 979   print ((struct Lisp_Float *) $ptr)->u.data
 980 end
 981 document xfloat
 982 Print $ assuming it is a lisp floating-point number.
 983 end
 984
 985 define xscrollbar
 986   xgetptr $
 987   print (struct scrollbar *) $ptr
 988 output *$
 989 echo \n
 990 end
 991 document xscrollbar
 992 Print $ as a scrollbar pointer.
 993 end
 994
 995 define xpr
 996   xtype
 997   if $type == Lisp_Int0 || $type == Lisp_Int1
 998     xint
 999   end
1000   if $type == Lisp_Symbol
1001     xsymbol
1002   end
1003   if $type == Lisp_String
1004     xstring
1005   end
1006   if $type == Lisp_Cons
1007     xcons
1008   end
1009   if $type == Lisp_Float
1010     xfloat
1011   end
1012   if $type == Lisp_Misc
1013     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
1014     if $misc == Lisp_Misc_Free
1015       xmiscfree
1016     end
1017     if $misc == Lisp_Misc_Marker
1018       xmarker
1019     end
1020     if $misc == Lisp_Misc_Overlay
1021       xoverlay
1022     end
1023 #    if $misc == Lisp_Misc_Save_Value
1024 #      xsavevalue
1025 #    end
1026   end
1027   if $type == Lisp_Vectorlike
1028     set $size = ((struct Lisp_Vector *) $ptr)->header.size
1029     if ($size & PSEUDOVECTOR_FLAG)
1030       set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
1031       if $vec == PVEC_NORMAL_VECTOR
1032         xvector
1033       end
1034       if $vec == PVEC_PROCESS
1035         xprocess
1036       end
1037       if $vec == PVEC_FRAME
1038         xframe
1039       end
1040       if $vec == PVEC_COMPILED
1041         xcompiled
1042       end
1043       if $vec == PVEC_WINDOW
1044         xwindow
1045       end
1046       if $vec == PVEC_WINDOW_CONFIGURATION
1047         xwinconfig
1048       end
1049       if $vec == PVEC_SUBR
1050         xsubr
1051       end
1052       if $vec == PVEC_CHAR_TABLE
1053         xchartable
1054       end
1055       if $vec == PVEC_BOOL_VECTOR
1056         xboolvector
1057       end
1058       if $vec == PVEC_BUFFER
1059         xbuffer
1060       end
1061       if $vec == PVEC_HASH_TABLE
1062         xhashtable
1063       end
1064     else
1065       xvector
1066     end
1067   end
1068 end
1069 document xpr
1070 Print $ as a lisp object of any type.
1071 end
1072
1073 define xprintstr
1074   set $data = (char *) $arg0->data
1075   set $strsize = ($arg0->size_byte < 0) ? ($arg0->size & ~ARRAY_MARK_FLAG) : $arg0->size_byte
1076   # GDB doesn't like zero repetition counts
1077   if $strsize == 0
1078     output ""
1079   else
1080     output ($arg0->size > 1000) ? 0 : ($data[0])@($strsize)
1081   end
1082 end
1083
1084 define xprintsym
1085   xgetptr $arg0
1086   xsymname $ptr
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