code.delx.au - gnu-emacs/blob - src/.gdbinit

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