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