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