src/.gdbinit

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