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