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

   1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
   2 #   2004, 2005, 2006 Free Software Foundation, Inc.
   3 #
   4 # This file is part of GNU Emacs.
   5 #
   6 # GNU Emacs is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2, or (at your option)
   9 # any later version.
  10 #
  11 # GNU Emacs is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with GNU Emacs; see the file COPYING.  If not, write to the
  18 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 # Boston, MA 02110-1301, USA.
  20
  21 # Force loading of symbols, enough to give us gdb_valbits etc.
  22 set main
  23
  24 # Find lwlib source files too.
  25 dir ../lwlib
  26 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
  27
  28 # Don't enter GDB when user types C-g to quit.
  29 # This has one unfortunate effect: you can't type C-c
  30 # at the GDB to stop Emacs, when using X.
  31 # However, C-z works just as well in that case.
  32 handle 2 noprint pass
  33
  34 # Make it work like SIGINT normally does.
  35 handle SIGTSTP nopass
  36
  37 # Don't pass SIGALRM to Emacs.  This makes problems when
  38 # debugging.
  39 handle SIGALRM ignore
  40
  41 # $valmask and $tagmask are mask values set up by the xreload macro below.
  42
  43 # Use $bugfix so that the value isn't a constant.
  44 # Using a constant runs into GDB bugs sometimes.
  45 define xgetptr
  46   set $bugfix = $arg0
  47   set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
  48 end
  49
  50 define xgetint
  51   set $bugfix = $arg0
  52   set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
  53 end
  54
  55 define xgettype
  56   set $bugfix = $arg0
  57   set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
  58 end
  59
  60 # Set up something to print out s-expressions.
  61 # We save and restore print_output_debug_flag to prevent the w32 port
  62 # from calling OutputDebugString, which causes GDB to display each
  63 # character twice (yuk!).
  64 define pr
  65   set $output_debug = print_output_debug_flag
  66   set print_output_debug_flag = 0
  67   set debug_print ($)
  68   set print_output_debug_flag = $output_debug
  69 end
  70 document pr
  71 Print the emacs s-expression which is $.
  72 Works only when an inferior emacs is executing.
  73 end
  74
  75 # Print out s-expressions
  76 define pp
  77   set $tmp = $arg0
  78   set $output_debug = print_output_debug_flag
  79   set print_output_debug_flag = 0
  80   set safe_debug_print ($tmp)
  81   set print_output_debug_flag = $output_debug
  82 end
  83 document pp
  84 Print the argument as an emacs s-expression
  85 Works only when an inferior emacs is executing.
  86 end
  87
  88 # Print out s-expressions from tool bar
  89 define pp1
  90   set $tmp = $arg0
  91   set $output_debug = print_output_debug_flag
  92   set print_output_debug_flag = 0
  93   set safe_debug_print ($tmp)
  94   set print_output_debug_flag = $output_debug
  95 end
  96 document pp1
  97 Print the argument as an emacs s-expression.
  98 Works only when an inferior emacs is executing.
  99 For use on tool bar when debugging in Emacs
 100 where the variable name would not otherwise
 101 be recorded in the GUD buffer.
 102 end
 103
 104 # Print value of lisp variable
 105 define pv
 106   set $tmp = "$arg0"
 107   set $output_debug = print_output_debug_flag
 108   set print_output_debug_flag = 0
 109   set safe_debug_print ( find_symbol_value (intern ($tmp)))
 110   set print_output_debug_flag = $output_debug
 111 end
 112 document pv
 113 Print the value of the lisp variable given as argument.
 114 Works only when an inferior emacs is executing.
 115 end
 116
 117 # Print value of lisp variable
 118 define pv1
 119   set $tmp = "$arg0"
 120   set $output_debug = print_output_debug_flag
 121   set print_output_debug_flag = 0
 122   set safe_debug_print (find_symbol_value (intern ($tmp)))
 123   set print_output_debug_flag = $output_debug
 124 end
 125 document pv1
 126 Print the value of the lisp variable given as argument.
 127 Works only when an inferior emacs is executing.
 128 For use when debugging in Emacs where the variable
 129 name would not otherwise be recorded in the GUD buffer.
 130 end
 131
 132 # Print out current buffer point and boundaries
 133 define ppt
 134   set $b = current_buffer
 135   set $t = $b->text
 136   printf "BUF PT: %d", $b->pt
 137   if ($b->pt != $b->pt_byte)
 138     printf "[%d]", $b->pt_byte
 139   end
 140   printf " of 1..%d", $t->z
 141   if ($t->z != $t->z_byte)
 142     printf "[%d]", $t->z_byte
 143   end
 144   if ($b->begv != 1 || $b->zv != $t->z)
 145     printf " NARROW=%d..%d", $b->begv, $b->zv
 146     if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
 147       printf " [%d..%d]", $b->begv_byte, $b->zv_byte
 148     end
 149   end
 150   printf " GAP: %d", $t->gpt
 151   if ($t->gpt != $t->gpt_byte)
 152     printf "[%d]", $t->gpt_byte
 153   end
 154   printf " SZ=%d\n", $t->gap_size
 155 end
 156 document ppt
 157 Print point, beg, end, narrow, and gap for current buffer.
 158 end
 159
 160 # Print out iterator given as first arg
 161 define pitx
 162   set $it = $arg0
 163   printf "cur=%d", $it->current.pos.charpos
 164   if ($it->current.pos.charpos != $it->current.pos.bytepos)
 165     printf "[%d]", $it->current.pos.bytepos
 166   end
 167   printf " pos=%d", $it->position.charpos
 168   if ($it->position.charpos != $it->position.bytepos)
 169     printf "[%d]", $it->position.bytepos
 170   end
 171   printf " start=%d", $it->start.pos.charpos
 172   if ($it->start.pos.charpos != $it->start.pos.bytepos)
 173     printf "[%d]", $it->start.pos.bytepos
 174   end
 175   printf " end=%d", $it->end_charpos
 176   printf " stop=%d", $it->stop_charpos
 177   printf " face=%d", $it->face_id
 178   if ($it->multibyte_p)
 179     printf " MB"
 180   end
 181   if ($it->header_line_p)
 182     printf " HL"
 183   end
 184   if ($it->n_overlay_strings > 0)
 185     printf " nov=%d", $it->n_overlay_strings
 186   end
 187   if ($it->sp != 0)
 188     printf " sp=%d", $it->sp
 189   end
 190   if ($it->what == IT_CHARACTER)
 191     if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
 192       printf " ch='%c'", $it->c
 193     else
 194       printf " ch=[%d,%d]", $it->c, $it->len
 195     end
 196   else
 197     printf " "
 198     output $it->what
 199   end
 200   if ($it->method != GET_FROM_BUFFER)
 201     printf " next="
 202     output $it->method
 203     if ($it->method == GET_FROM_STRING)
 204       printf "[%d]", $it->current.string_pos.charpos
 205     end
 206     if ($it->method == GET_FROM_IMAGE)
 207       printf "[%d]", $it->image_id
 208     end
 209     if ($it->method == GET_FROM_COMPOSITION)
 210       printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
 211     end
 212   end
 213   printf "\n"
 214   if ($it->region_beg_charpos >= 0)
 215     printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
 216   end
 217   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
 218   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
 219   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
 220   printf " w=%d", $it->pixel_width
 221   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
 222   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
 223   printf "\n"
 224   set $i = 0
 225   while ($i < $it->sp && $i < 4)
 226     set $e = $it->stack[$i]
 227     printf "stack[%d]: ", $i
 228     output $e->method
 229     printf "[%d]", $e->position.charpos
 230     printf "\n"
 231     set $i = $i + 1
 232   end
 233 end
 234 document pitx
 235 Pretty print a display iterator.
 236 Take one arg, an iterator object or pointer.
 237 end
 238
 239 define pit
 240   pitx it
 241 end
 242 document pit
 243 Pretty print the display iterator it.
 244 end
 245
 246 define prowx
 247   set $row = $arg0
 248   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
 249   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
 250   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
 251   printf " vis=%d", $row->visible_height
 252   printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
 253   printf "\n"
 254   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
 255   if ($row->enabled_p)
 256     printf " ENA"
 257   end
 258   if ($row->displays_text_p)
 259     printf " DISP"
 260   end
 261   if ($row->mode_line_p)
 262     printf " MODEL"
 263   end
 264   if ($row->continued_p)
 265     printf " CONT"
 266   end
 267   if ($row-> truncated_on_left_p)
 268     printf " TRUNC:L"
 269   end
 270   if ($row-> truncated_on_right_p)
 271     printf " TRUNC:R"
 272   end
 273   if ($row->starts_in_middle_of_char_p)
 274     printf " STARTMID"
 275   end
 276   if ($row->ends_in_middle_of_char_p)
 277     printf " ENDMID"
 278   end
 279   if ($row->ends_in_newline_from_string_p)
 280     printf " ENDNLFS"
 281   end
 282   if ($row->ends_at_zv_p)
 283     printf " ENDZV"
 284   end
 285   if ($row->overlapped_p)
 286     printf " OLAPD"
 287   end
 288   if ($row->overlapping_p)
 289     printf " OLAPNG"
 290   end
 291   printf "\n"
 292 end
 293 document prowx
 294 Pretty print information about glyph_row.
 295 Takes one argument, a row object or pointer.
 296 end
 297
 298 define prow
 299   prowx row
 300 end
 301 document prow
 302 Pretty print information about glyph_row in row.
 303 end
 304
 305
 306 define pcursorx
 307   set $cp = $arg0
 308   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
 309 end
 310 document pcursorx
 311 Pretty print a window cursor
 312 end
 313
 314 define pcursor
 315   printf "output: "
 316   pcursorx output_cursor
 317   printf "\n"
 318 end
 319 document pcursor
 320 Pretty print the output_cursor
 321 end
 322
 323 define pwinx
 324   set $w = $arg0
 325   xgetint $w->sequence_number
 326   if ($w->mini_p != Qnil)
 327     printf "Mini "
 328   end
 329   printf "Window %d ", $int
 330   xgetptr $w->buffer
 331   set $tem = (struct buffer *) $ptr
 332   xgetptr $tem->name
 333   printf "%s", ((struct Lisp_String *) $ptr)->data
 334   printf "\n"
 335   xgetptr $w->start
 336   set $tem = (struct Lisp_Marker *) $ptr
 337   printf "start=%d end:", $tem->charpos
 338   if ($w->window_end_valid != Qnil)
 339     xgetint $w->window_end_pos
 340     printf "pos=%d", $int
 341     xgetint $w->window_end_vpos
 342     printf " vpos=%d", $int
 343   else
 344     printf "invalid"
 345   end
 346   printf " vscroll=%d", $w->vscroll
 347   if ($w->force_start != Qnil)
 348     printf " FORCE_START"
 349   end
 350   if ($w->must_be_updated_p)
 351     printf " MUST_UPD"
 352   end
 353   printf "\n"
 354   printf "cursor: "
 355   pcursorx $w->cursor
 356   printf "  phys: "
 357   pcursorx $w->phys_cursor
 358   if ($w->phys_cursor_on_p)
 359     printf " ON"
 360   else
 361     printf " OFF"
 362   end
 363   printf " blk="
 364   if ($w->last_cursor_off_p != $w->cursor_off_p)
 365     if ($w->last_cursor_off_p)
 366       printf "ON->"
 367     else
 368       printf "OFF->"
 369     end
 370   end
 371   if ($w->cursor_off_p)
 372     printf "ON"
 373   else
 374     printf "OFF"
 375   end
 376   printf "\n"
 377 end
 378 document pwinx
 379 Pretty print a window structure.
 380 Takes one argument, a pointer to a window structure
 381 end
 382
 383 define pwin
 384   pwinx w
 385 end
 386 document pwin
 387 Pretty print window structure w.
 388 end
 389
 390 define pgx
 391   set $g = $arg0
 392   if ($g->type == CHAR_GLYPH)
 393     if ($g->u.ch >= ' ' && $g->u.ch < 127)
 394       printf "CHAR[%c]", $g->u.ch
 395     else
 396       printf "CHAR[0x%x]", $g->u.ch
 397     end
 398   end
 399   if ($g->type == COMPOSITE_GLYPH)
 400     printf "COMP[%d]", $g->u.cmp_id
 401   end
 402   if ($g->type == IMAGE_GLYPH)
 403     printf "IMAGE[%d]", $g->u.img_id
 404   end
 405   if ($g->type == STRETCH_GLYPH)
 406     printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
 407   end
 408   xgettype ($g->object)
 409   if ($type == Lisp_String)
 410     printf " str=%x[%d]", $g->object, $g->charpos
 411   else
 412     printf " pos=%d", $g->charpos
 413   end
 414   printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
 415   if ($g->face_id != DEFAULT_FACE_ID)
 416     printf " face=%d", $g->face_id
 417   end
 418   if ($g->voffset)
 419     printf " vof=%d", $g->voffset
 420   end
 421   if ($g->multibyte_p)
 422     printf " MB"
 423   end
 424   if ($g->padding_p)
 425     printf " PAD"
 426   end
 427   if ($g->glyph_not_available_p)
 428     printf " N/A"
 429   end
 430   if ($g->overlaps_vertically_p)
 431     printf " OVL"
 432   end
 433   if ($g->left_box_line_p)
 434     printf " ["
 435   end
 436   if ($g->right_box_line_p)
 437     printf " ]"
 438   end
 439   if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
 440     printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
 441   end
 442   printf "\n"
 443 end
 444 document pgx
 445 Pretty print a glyph structure.
 446 Takes one argument, a pointer to a glyph structure
 447 end
 448
 449 define pg
 450   set $pgidx = 0
 451   pgx glyph
 452 end
 453 document pg
 454 Pretty print glyph structure glyph.
 455 end
 456
 457 define pgi
 458   set $pgidx = $arg0
 459   pgx (&glyph[$pgidx])
 460 end
 461 document pgi
 462 Pretty print glyph structure glyph[I].
 463 Takes one argument, a integer I.
 464 end
 465
 466 define pgn
 467   set $pgidx = $pgidx + 1
 468   pgx (&glyph[$pgidx])
 469 end
 470 document pgn
 471 Pretty print next glyph structure.
 472 end
 473
 474 define pgrowx
 475   set $row = $arg0
 476   set $area = 0
 477   set $xofs = $row->x
 478   while ($area < 3)
 479     set $used = $row->used[$area]
 480     if ($used > 0)
 481       set $gl0 = $row->glyphs[$area]
 482       set $pgidx = 0
 483       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 484       while ($pgidx < $used)
 485         printf "%3d %4d: ", $pgidx, $xofs
 486         pgx $gl0[$pgidx]
 487         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 488         set $pgidx = $pgidx + 1
 489       end
 490     end
 491     set $area = $area + 1
 492   end
 493 end
 494 document pgrowx
 495 Pretty print all glyphs in a row structure.
 496 Takes one argument, a pointer to a row structure.
 497 end
 498
 499 define pgrow
 500   pgrowx row
 501 end
 502 document pgrow
 503 Pretty print all glyphs in row structure row.
 504 end
 505
 506 define xtype
 507   xgettype $
 508   output $type
 509   echo \n
 510   if $type == Lisp_Misc
 511     xmisctype
 512   else
 513     if $type == Lisp_Vectorlike
 514       xvectype
 515     end
 516   end
 517 end
 518 document xtype
 519 Print the type of $, assuming it is an Emacs Lisp value.
 520 If the first type printed is Lisp_Vector or Lisp_Misc,
 521 a second line gives the more precise type.
 522 end
 523
 524 define xvectype
 525   xgetptr $
 526   set $size = ((struct Lisp_Vector *) $ptr)->size
 527   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 528   echo \n
 529 end
 530 document xvectype
 531 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
 532 end
 533
 534 define xmisctype
 535   xgetptr $
 536   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 537   echo \n
 538 end
 539 document xmisctype
 540 Print the specific type of $, assuming it is some misc type.
 541 end
 542
 543 define xint
 544   xgetint $
 545   print $int
 546 end
 547 document xint
 548 Print $, assuming it is an Emacs Lisp integer.  This gets the sign right.
 549 end
 550
 551 define xptr
 552   xgetptr $
 553   print (void *) $ptr
 554 end
 555 document xptr
 556 Print the pointer portion of $, assuming it is an Emacs Lisp value.
 557 end
 558
 559 define xmarker
 560   xgetptr $
 561   print (struct Lisp_Marker *) $ptr
 562 end
 563 document xmarker
 564 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
 565 end
 566
 567 define xoverlay
 568   xgetptr $
 569   print (struct Lisp_Overlay *) $ptr
 570 end
 571 document xoverlay
 572 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
 573 end
 574
 575 define xmiscfree
 576   xgetptr $
 577   print (struct Lisp_Free *) $ptr
 578 end
 579 document xmiscfree
 580 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
 581 end
 582
 583 define xintfwd
 584   xgetptr $
 585   print (struct Lisp_Intfwd *) $ptr
 586 end
 587 document xintfwd
 588 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
 589 end
 590
 591 define xboolfwd
 592   xgetptr $
 593   print (struct Lisp_Boolfwd *) $ptr
 594 end
 595 document xboolfwd
 596 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
 597 end
 598
 599 define xobjfwd
 600   xgetptr $
 601   print (struct Lisp_Objfwd *) $ptr
 602 end
 603 document xobjfwd
 604 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 605 end
 606
 607 define xbufobjfwd
 608   xgetptr $
 609   print (struct Lisp_Buffer_Objfwd *) $ptr
 610 end
 611 document xbufobjfwd
 612 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 613 end
 614
 615 define xkbobjfwd
 616   xgetptr $
 617   print (struct Lisp_Kboard_Objfwd *) $ptr
 618 end
 619 document xkbobjfwd
 620 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 621 end
 622
 623 define xbuflocal
 624   xgetptr $
 625   print (struct Lisp_Buffer_Local_Value *) $ptr
 626 end
 627 document xbuflocal
 628 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
 629 end
 630
 631 define xsymbol
 632   set $sym = $
 633   xgetptr $sym
 634   print (struct Lisp_Symbol *) $ptr
 635   xprintsym $sym
 636   echo \n
 637 end
 638 document xsymbol
 639 Print the name and address of the symbol $.
 640 This command assumes that $ is an Emacs Lisp symbol value.
 641 end
 642
 643 define xstring
 644   xgetptr $
 645   print (struct Lisp_String *) $ptr
 646   xprintstr $
 647   echo \n
 648 end
 649 document xstring
 650 Print the contents and address of the string $.
 651 This command assumes that $ is an Emacs Lisp string value.
 652 end
 653
 654 define xvector
 655   xgetptr $
 656   print (struct Lisp_Vector *) $ptr
 657   output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
 658 echo \n
 659 end
 660 document xvector
 661 Print the contents and address of the vector $.
 662 This command assumes that $ is an Emacs Lisp vector value.
 663 end
 664
 665 define xprocess
 666   xgetptr $
 667   print (struct Lisp_Process *) $ptr
 668   output *$
 669   echo \n
 670 end
 671 document xprocess
 672 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
 673 end
 674
 675 define xframe
 676   xgetptr $
 677   print (struct frame *) $ptr
 678   xgetptr $->name
 679   set $ptr = (struct Lisp_String *) $ptr
 680   xprintstr $ptr
 681   echo \n
 682 end
 683 document xframe
 684 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
 685 end
 686
 687 define xcompiled
 688   xgetptr $
 689   print (struct Lisp_Vector *) $ptr
 690   output ($->contents[0])@($->size & 0xff)
 691 end
 692 document xcompiled
 693 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
 694 end
 695
 696 define xwindow
 697   xgetptr $
 698   print (struct window *) $ptr
 699   set $window = (struct window *) $ptr
 700   xgetint $window->total_cols
 701   set $width=$int
 702   xgetint $window->total_lines
 703   set $height=$int
 704   xgetint $window->left_col
 705   set $left=$int
 706   xgetint $window->top_line
 707   set $top=$int
 708   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 709 end
 710 document xwindow
 711 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 712 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 713 end
 714
 715 define xwinconfig
 716   xgetptr $
 717   print (struct save_window_data *) $ptr
 718 end
 719 document xwinconfig
 720 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
 721 end
 722
 723 define xsubr
 724   xgetptr $
 725   print (struct Lisp_Subr *) $ptr
 726   output *$
 727   echo \n
 728 end
 729 document xsubr
 730 Print the address of the subr which the Lisp_Object $ points to.
 731 end
 732
 733 define xchartable
 734   xgetptr $
 735   print (struct Lisp_Char_Table *) $ptr
 736   printf "Purpose: "
 737   xprintsym $->purpose
 738   printf "  %d extra slots", ($->size & 0x1ff) - 388
 739   echo \n
 740 end
 741 document xchartable
 742 Print the address of the char-table $, and its purpose.
 743 This command assumes that $ is an Emacs Lisp char-table value.
 744 end
 745
 746 define xboolvector
 747   xgetptr $
 748   print (struct Lisp_Bool_Vector *) $ptr
 749   output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
 750   echo \n
 751 end
 752 document xboolvector
 753 Print the contents and address of the bool-vector $.
 754 This command assumes that $ is an Emacs Lisp bool-vector value.
 755 end
 756
 757 define xbuffer
 758   xgetptr $
 759   print (struct buffer *) $ptr
 760   xgetptr $->name
 761   output ((struct Lisp_String *) $ptr)->data
 762   echo \n
 763 end
 764 document xbuffer
 765 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
 766 Print the name of the buffer.
 767 end
 768
 769 define xhashtable
 770   xgetptr $
 771   print (struct Lisp_Hash_Table *) $ptr
 772 end
 773 document xhashtable
 774 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
 775 end
 776
 777 define xcons
 778   xgetptr $
 779   print (struct Lisp_Cons *) $ptr
 780   output/x *$
 781   echo \n
 782 end
 783 document xcons
 784 Print the contents of $, assuming it is an Emacs Lisp cons.
 785 end
 786
 787 define nextcons
 788   p $.u.cdr
 789   xcons
 790 end
 791 document nextcons
 792 Print the contents of the next cell in a list.
 793 This assumes that the last thing you printed was a cons cell contents
 794 (type struct Lisp_Cons) or a pointer to one.
 795 end
 796 define xcar
 797   xgetptr $
 798   xgettype $
 799   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 800 end
 801 document xcar
 802 Print the car of $, assuming it is an Emacs Lisp pair.
 803 end
 804
 805 define xcdr
 806   xgetptr $
 807   xgettype $
 808   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 809 end
 810 document xcdr
 811 Print the cdr of $, assuming it is an Emacs Lisp pair.
 812 end
 813
 814 define xlist
 815   xgetptr $
 816   set $cons = (struct Lisp_Cons *) $ptr
 817   xgetptr Qnil
 818   set $nil = $ptr
 819   set $i = 0
 820   while $cons != $nil && $i < 10
 821     p/x $cons->car
 822     xpr
 823     xgetptr $cons->u.cdr
 824     set $cons = (struct Lisp_Cons *) $ptr
 825     set $i = $i + 1
 826     printf "---\n"
 827   end
 828   if $cons == $nil
 829     printf "nil\n"
 830   else
 831     printf "...\n"
 832     p $ptr
 833   end
 834 end
 835 document xlist
 836 Print $ assuming it is a list.
 837 end
 838
 839 define xfloat
 840   xgetptr $
 841   print ((struct Lisp_Float *) $ptr)->u.data
 842 end
 843 document xfloat
 844 Print $ assuming it is a lisp floating-point number.
 845 end
 846
 847 define xscrollbar
 848   xgetptr $
 849   print (struct scrollbar *) $ptr
 850 output *$
 851 echo \n
 852 end
 853 document xscrollbar
 854 Print $ as a scrollbar pointer.
 855 end
 856
 857 define xpr
 858   xtype
 859   if $type == Lisp_Int
 860     xint
 861   end
 862   if $type == Lisp_Symbol
 863     xsymbol
 864   end
 865   if $type == Lisp_String
 866     xstring
 867   end
 868   if $type == Lisp_Cons
 869     xcons
 870   end
 871   if $type == Lisp_Float
 872     xfloat
 873   end
 874   if $type == Lisp_Misc
 875     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 876     if $misc == Lisp_Misc_Free
 877       xmiscfree
 878     end
 879     if $misc == Lisp_Misc_Boolfwd
 880       xboolfwd
 881     end
 882     if $misc == Lisp_Misc_Marker
 883       xmarker
 884     end
 885     if $misc == Lisp_Misc_Intfwd
 886       xintfwd
 887     end
 888     if $misc == Lisp_Misc_Boolfwd
 889       xboolfwd
 890     end
 891     if $misc == Lisp_Misc_Objfwd
 892       xobjfwd
 893     end
 894     if $misc == Lisp_Misc_Buffer_Objfwd
 895       xbufobjfwd
 896     end
 897     if $misc == Lisp_Misc_Buffer_Local_Value
 898       xbuflocal
 899     end
 900 #    if $misc == Lisp_Misc_Some_Buffer_Local_Value
 901 #      xvalue
 902 #    end
 903     if $misc == Lisp_Misc_Overlay
 904       xoverlay
 905     end
 906     if $misc == Lisp_Misc_Kboard_Objfwd
 907       xkbobjfwd
 908     end
 909 #    if $misc == Lisp_Misc_Save_Value
 910 #      xsavevalue
 911 #    end
 912   end
 913   if $type == Lisp_Vectorlike
 914     set $size = ((struct Lisp_Vector *) $ptr)->size
 915     if ($size & PVEC_FLAG)
 916       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
 917       if $vec == PVEC_NORMAL_VECTOR
 918         xvector
 919       end
 920       if $vec == PVEC_PROCESS
 921         xprocess
 922       end
 923       if $vec == PVEC_FRAME
 924         xframe
 925       end
 926       if $vec == PVEC_COMPILED
 927         xcompiled
 928       end
 929       if $vec == PVEC_WINDOW
 930         xwindow
 931       end
 932       if $vec == PVEC_WINDOW_CONFIGURATION
 933         xwinconfig
 934       end
 935       if $vec == PVEC_SUBR
 936         xsubr
 937       end
 938       if $vec == PVEC_CHAR_TABLE
 939         xchartable
 940       end
 941       if $vec == PVEC_BOOL_VECTOR
 942         xboolvector
 943       end
 944       if $vec == PVEC_BUFFER
 945         xbuffer
 946       end
 947       if $vec == PVEC_HASH_TABLE
 948         xhashtable
 949       end
 950     else
 951       xvector
 952     end
 953   end
 954 end
 955 document xpr
 956 Print $ as a lisp object of any type.
 957 end
 958
 959 define xprintstr
 960   set $data = $arg0->data
 961   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
 962 end
 963
 964 define xprintsym
 965   xgetptr $arg0
 966   set $sym = (struct Lisp_Symbol *) $ptr
 967   xgetptr $sym->xname
 968   set $sym_name = (struct Lisp_String *) $ptr
 969   xprintstr $sym_name
 970 end
 971 document xprintsym
 972   Print argument as a symbol.
 973 end
 974
 975 define xbacktrace
 976   set $bt = backtrace_list
 977   while $bt
 978     xgettype (*$bt->function)
 979     if $type == Lisp_Symbol
 980       xprintsym (*$bt->function)
 981       printf " (0x%x)\n", *$bt->args
 982     else
 983       printf "0x%x ", *$bt->function
 984       if $type == Lisp_Vectorlike
 985         xgetptr (*$bt->function)
 986         set $size = ((struct Lisp_Vector *) $ptr)->size
 987         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 988       else
 989         printf "Lisp type %d", $type
 990       end
 991       echo \n
 992     end
 993     set $bt = $bt->next
 994   end
 995 end
 996 document xbacktrace
 997   Print a backtrace of Lisp function calls from backtrace_list.
 998   Set a breakpoint at Fsignal and call this to see from where
 999   an error was signaled.
1000 end
1001
1002 define which
1003   set debug_print (which_symbols ($arg0))
1004 end
1005 document which
1006   Print symbols which references a given lisp object,
1007   either as its symbol value or symbol function.
1008 end
1009
1010 define xbytecode
1011   set $bt = byte_stack_list
1012   while $bt
1013     xgettype ($bt->byte_string)
1014     printf "0x%x => ", $bt->byte_string
1015     which $bt->byte_string
1016     set $bt = $bt->next
1017   end
1018 end
1019 document xbytecode
1020   Print a backtrace of the byte code stack.
1021 end
1022
1023 # Show Lisp backtrace after normal backtrace.
1024 define hookpost-backtrace
1025   set $bt = backtrace_list
1026   if $bt
1027     echo \n
1028     echo Lisp Backtrace:\n
1029     xbacktrace
1030   end
1031 end
1032
1033 define xreload
1034   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1035   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1036 end
1037 document xreload
1038   When starting Emacs a second time in the same gdb session under
1039   FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1040   their values.  (The same happens on current (2000) versions of GNU/Linux
1041   with gdb 5.0.)
1042   This function reloads them.
1043 end
1044 xreload
1045
1046 # Flush display (X only)
1047 define ff
1048   set x_flush (0)
1049 end
1050 document ff
1051 Flush pending X window display updates to screen.
1052 Works only when an inferior emacs is executing.
1053 end
1054
1055
1056 define hook-run
1057   xreload
1058 end
1059
1060 # Call xreload if a new Emacs executable is loaded.
1061 define hookpost-run
1062   xreload
1063 end
1064
1065 set print pretty on
1066 set print sevenbit-strings
1067
1068 show environment DISPLAY
1069 show environment TERM
1070 set args -geometry 80x40+0+0
1071
1072 # People get bothered when they see messages about non-existent functions...
1073 xgetptr Vsystem_type
1074 # $ptr is NULL in temacs
1075 if ($ptr != 0)
1076   set $tem = (struct Lisp_Symbol *) $ptr
1077   xgetptr $tem->xname
1078   set $tem = (struct Lisp_String *) $ptr
1079   set $tem = (char *) $tem->data
1080
1081   # Don't let abort actually run, as it will make stdio stop working and
1082   # therefore the `pr' command above as well.
1083   if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1084     # The windows-nt build replaces abort with its own function.
1085     break w32_abort
1086   else
1087     break abort
1088   end
1089 end
1090
1091 # x_error_quitter is defined only on X.  But window-system is set up
1092 # only at run time, during Emacs startup, so we need to defer setting
1093 # the breakpoint.  init_sys_modes is the first function called on
1094 # every platform after init_display, where window-system is set.
1095 tbreak init_sys_modes
1096 commands
1097   silent
1098   xgetptr Vwindow_system
1099   set $tem = (struct Lisp_Symbol *) $ptr
1100   xgetptr $tem->xname
1101   set $tem = (struct Lisp_String *) $ptr
1102   set $tem = (char *) $tem->data
1103   # If we are running in synchronous mode, we want a chance to look
1104   # around before Emacs exits.  Perhaps we should put the break
1105   # somewhere else instead...
1106   if $tem[0] == 'x' && $tem[1] == '\0'
1107     break x_error_quitter
1108   end
1109   continue
1110 end
1111 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe