src/.gdbinit

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