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   set $i = 0
 221   while ($i < $it->sp)
 222     set $e = $it->stack[$i]
 223     printf "stack[%d]: ", $i
 224     output $e->method
 225     printf "[%d]", $e->position.charpos
 226     printf "\n"
 227     set $i = $i + 1
 228   end
 229 end
 230 document pitx
 231 Pretty print a display iterator.
 232 Take one arg, an iterator object or pointer.
 233 end
 234
 235 define pit
 236   pitx it
 237 end
 238 document pit
 239 Pretty print the display iterator it.
 240 end
 241
 242 define prowx
 243   set $row = $arg0
 244   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
 245   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
 246   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
 247   printf " vis=%d", $row->visible_height
 248   printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
 249   printf "\n"
 250   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
 251   if ($row->enabled_p)
 252     printf " ENA"
 253   end
 254   if ($row->displays_text_p)
 255     printf " DISP"
 256   end
 257   if ($row->mode_line_p)
 258     printf " MODEL"
 259   end
 260   if ($row->continued_p)
 261     printf " CONT"
 262   end
 263   if ($row-> truncated_on_left_p)
 264     printf " TRUNC:L"
 265   end
 266   if ($row-> truncated_on_right_p)
 267     printf " TRUNC:R"
 268   end
 269   if ($row->starts_in_middle_of_char_p)
 270     printf " STARTMID"
 271   end
 272   if ($row->ends_in_middle_of_char_p)
 273     printf " ENDMID"
 274   end
 275   if ($row->ends_in_newline_from_string_p)
 276     printf " ENDNLFS"
 277   end
 278   if ($row->ends_at_zv_p)
 279     printf " ENDZV"
 280   end
 281   if ($row->overlapped_p)
 282     printf " OLAPD"
 283   end
 284   if ($row->overlapping_p)
 285     printf " OLAPNG"
 286   end
 287   printf "\n"
 288 end
 289 document prowx
 290 Pretty print information about glyph_row.
 291 Takes one argument, a row object or pointer.
 292 end
 293
 294 define prow
 295   prowx row
 296 end
 297 document prow
 298 Pretty print information about glyph_row in row.
 299 end
 300
 301
 302 define pcursorx
 303   set $cp = $arg0
 304   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
 305 end
 306 document pcursorx
 307 Pretty print a window cursor
 308 end
 309
 310 define pcursor
 311   printf "output: "
 312   pcursorx output_cursor
 313   printf "\n"
 314 end
 315 document pcursor
 316 Pretty print the output_cursor
 317 end
 318
 319 define pwinx
 320   set $w = $arg0
 321   xgetint $w->sequence_number
 322   if ($w->mini_p != Qnil)
 323     printf "Mini "
 324   end
 325   printf "Window %d ", $int
 326   xgetptr $w->buffer
 327   set $tem = (struct buffer *) $ptr
 328   xgetptr $tem->name
 329   printf "%s", ((struct Lisp_String *) $ptr)->data
 330   printf "\n"
 331   xgetptr $w->start
 332   set $tem = (struct Lisp_Marker *) $ptr
 333   printf "start=%d end:", $tem->charpos
 334   if ($w->window_end_valid != Qnil)
 335     xgetint $w->window_end_pos
 336     printf "pos=%d", $int
 337     xgetint $w->window_end_vpos
 338     printf " vpos=%d", $int
 339   else
 340     printf "invalid"
 341   end
 342   printf " vscroll=%d", $w->vscroll
 343   if ($w->force_start != Qnil)
 344     printf " FORCE_START"
 345   end
 346   if ($w->must_be_updated_p)
 347     printf " MUST_UPD"
 348   end
 349   printf "\n"
 350   printf "cursor: "
 351   pcursorx $w->cursor
 352   printf "  phys: "
 353   pcursorx $w->phys_cursor
 354   if ($w->phys_cursor_on_p)
 355     printf " ON"
 356   else
 357     printf " OFF"
 358   end
 359   printf " blk="
 360   if ($w->last_cursor_off_p != $w->cursor_off_p)
 361     if ($w->last_cursor_off_p)
 362       printf "ON->"
 363     else
 364       printf "OFF->"
 365     end
 366   end
 367   if ($w->cursor_off_p)
 368     printf "ON"
 369   else
 370     printf "OFF"
 371   end
 372   printf "\n"
 373 end
 374 document pwinx
 375 Pretty print a window structure.
 376 Takes one argument, a pointer to a window structure
 377 end
 378
 379 define pwin
 380   pwinx w
 381 end
 382 document pwin
 383 Pretty print window structure w.
 384 end
 385
 386 define pgx
 387   set $g = $arg0
 388   if ($g->type == CHAR_GLYPH)
 389     if ($g->u.ch >= ' ' && $g->u.ch < 127)
 390       printf "CHAR[%c]", $g->u.ch
 391     else
 392       printf "CHAR[0x%x]", $g->u.ch
 393     end
 394   end
 395   if ($g->type == COMPOSITE_GLYPH)
 396     printf "COMP[%d]", $g->u.cmp_id
 397   end
 398   if ($g->type == IMAGE_GLYPH)
 399     printf "IMAGE[%d]", $g->u.img_id
 400   end
 401   if ($g->type == STRETCH_GLYPH)
 402     printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
 403   end
 404   xgettype ($g->object)
 405   if ($type == Lisp_String)
 406     printf " str=%x[%d]", $g->object, $g->charpos
 407   else
 408     printf " pos=%d", $g->charpos
 409   end
 410   printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
 411   if ($g->face_id != DEFAULT_FACE_ID)
 412     printf " face=%d", $g->face_id
 413   end
 414   if ($g->voffset)
 415     printf " vof=%d", $g->voffset
 416   end
 417   if ($g->multibyte_p)
 418     printf " MB"
 419   end
 420   if ($g->padding_p)
 421     printf " PAD"
 422   end
 423   if ($g->glyph_not_available_p)
 424     printf " N/A"
 425   end
 426   if ($g->overlaps_vertically_p)
 427     printf " OVL"
 428   end
 429   if ($g->left_box_line_p)
 430     printf " ["
 431   end
 432   if ($g->right_box_line_p)
 433     printf " ]"
 434   end
 435   if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
 436     printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
 437   end
 438   printf "\n"
 439 end
 440 document pgx
 441 Pretty print a glyph structure.
 442 Takes one argument, a pointer to a glyph structure
 443 end
 444
 445 define pg
 446   set $pgidx = 0
 447   pgx glyph
 448 end
 449 document pg
 450 Pretty print glyph structure glyph.
 451 end
 452
 453 define pgi
 454   set $pgidx = $arg0
 455   pgx (&glyph[$pgidx])
 456 end
 457 document pgi
 458 Pretty print glyph structure glyph[I].
 459 Takes one argument, a integer I.
 460 end
 461
 462 define pgn
 463   set $pgidx = $pgidx + 1
 464   pgx (&glyph[$pgidx])
 465 end
 466 document pgn
 467 Pretty print next glyph structure.
 468 end
 469
 470 define pgrowx
 471   set $row = $arg0
 472   set $area = 0
 473   set $xofs = $row->x
 474   while ($area < 3)
 475     set $used = $row->used[$area]
 476     if ($used > 0)
 477       set $gl0 = $row->glyphs[$area]
 478       set $pgidx = 0
 479       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 480       while ($pgidx < $used)
 481         printf "%3d %4d: ", $pgidx, $xofs
 482         pgx $gl0[$pgidx]
 483         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 484         set $pgidx = $pgidx + 1
 485       end
 486     end
 487     set $area = $area + 1
 488   end
 489 end
 490 document pgrowx
 491 Pretty print all glyphs in a row structure.
 492 Takes one argument, a pointer to a row structure.
 493 end
 494
 495 define pgrow
 496   pgrowx row
 497 end
 498 document pgrow
 499 Pretty print all glyphs in row structure row.
 500 end
 501
 502 define xtype
 503   xgettype $
 504   output $type
 505   echo \n
 506   if $type == Lisp_Misc
 507     xmisctype
 508   else
 509     if $type == Lisp_Vectorlike
 510       xvectype
 511     end
 512   end
 513 end
 514 document xtype
 515 Print the type of $, assuming it is an Emacs Lisp value.
 516 If the first type printed is Lisp_Vector or Lisp_Misc,
 517 a second line gives the more precise type.
 518 end
 519
 520 define xvectype
 521   xgetptr $
 522   set $size = ((struct Lisp_Vector *) $ptr)->size
 523   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 524   echo \n
 525 end
 526 document xvectype
 527 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
 528 end
 529
 530 define xmisctype
 531   xgetptr $
 532   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 533   echo \n
 534 end
 535 document xmisctype
 536 Print the specific type of $, assuming it is some misc type.
 537 end
 538
 539 define xint
 540   xgetint $
 541   print $int
 542 end
 543 document xint
 544 Print $, assuming it is an Emacs Lisp integer.  This gets the sign right.
 545 end
 546
 547 define xptr
 548   xgetptr $
 549   print (void *) $ptr
 550 end
 551 document xptr
 552 Print the pointer portion of $, assuming it is an Emacs Lisp value.
 553 end
 554
 555 define xmarker
 556   xgetptr $
 557   print (struct Lisp_Marker *) $ptr
 558 end
 559 document xmarker
 560 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
 561 end
 562
 563 define xoverlay
 564   xgetptr $
 565   print (struct Lisp_Overlay *) $ptr
 566 end
 567 document xoverlay
 568 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
 569 end
 570
 571 define xmiscfree
 572   xgetptr $
 573   print (struct Lisp_Free *) $ptr
 574 end
 575 document xmiscfree
 576 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
 577 end
 578
 579 define xintfwd
 580   xgetptr $
 581   print (struct Lisp_Intfwd *) $ptr
 582 end
 583 document xintfwd
 584 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
 585 end
 586
 587 define xboolfwd
 588   xgetptr $
 589   print (struct Lisp_Boolfwd *) $ptr
 590 end
 591 document xboolfwd
 592 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
 593 end
 594
 595 define xobjfwd
 596   xgetptr $
 597   print (struct Lisp_Objfwd *) $ptr
 598 end
 599 document xobjfwd
 600 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 601 end
 602
 603 define xbufobjfwd
 604   xgetptr $
 605   print (struct Lisp_Buffer_Objfwd *) $ptr
 606 end
 607 document xbufobjfwd
 608 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 609 end
 610
 611 define xkbobjfwd
 612   xgetptr $
 613   print (struct Lisp_Kboard_Objfwd *) $ptr
 614 end
 615 document xkbobjfwd
 616 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
 617 end
 618
 619 define xbuflocal
 620   xgetptr $
 621   print (struct Lisp_Buffer_Local_Value *) $ptr
 622 end
 623 document xbuflocal
 624 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
 625 end
 626
 627 define xsymbol
 628   set $sym = $
 629   xgetptr $sym
 630   print (struct Lisp_Symbol *) $ptr
 631   xprintsym $sym
 632   echo \n
 633 end
 634 document xsymbol
 635 Print the name and address of the symbol $.
 636 This command assumes that $ is an Emacs Lisp symbol value.
 637 end
 638
 639 define xstring
 640   xgetptr $
 641   print (struct Lisp_String *) $ptr
 642   xprintstr $
 643   echo \n
 644 end
 645 document xstring
 646 Print the contents and address of the string $.
 647 This command assumes that $ is an Emacs Lisp string value.
 648 end
 649
 650 define xvector
 651   xgetptr $
 652   print (struct Lisp_Vector *) $ptr
 653   output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
 654 echo \n
 655 end
 656 document xvector
 657 Print the contents and address of the vector $.
 658 This command assumes that $ is an Emacs Lisp vector value.
 659 end
 660
 661 define xprocess
 662   xgetptr $
 663   print (struct Lisp_Process *) $ptr
 664   output *$
 665   echo \n
 666 end
 667 document xprocess
 668 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
 669 end
 670
 671 define xframe
 672   xgetptr $
 673   print (struct frame *) $ptr
 674   xgetptr $->name
 675   set $ptr = (struct Lisp_String *) $ptr
 676   xprintstr $ptr
 677   echo \n
 678 end
 679 document xframe
 680 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
 681 end
 682
 683 define xcompiled
 684   xgetptr $
 685   print (struct Lisp_Vector *) $ptr
 686   output ($->contents[0])@($->size & 0xff)
 687 end
 688 document xcompiled
 689 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
 690 end
 691
 692 define xwindow
 693   xgetptr $
 694   print (struct window *) $ptr
 695   set $window = (struct window *) $ptr
 696   xgetint $window->total_cols
 697   set $width=$int
 698   xgetint $window->total_lines
 699   set $height=$int
 700   xgetint $window->left_col
 701   set $left=$int
 702   xgetint $window->top_line
 703   set $top=$int
 704   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 705 end
 706 document xwindow
 707 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 708 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 709 end
 710
 711 define xwinconfig
 712   xgetptr $
 713   print (struct save_window_data *) $ptr
 714 end
 715 document xwinconfig
 716 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
 717 end
 718
 719 define xsubr
 720   xgetptr $
 721   print (struct Lisp_Subr *) $ptr
 722   output *$
 723   echo \n
 724 end
 725 document xsubr
 726 Print the address of the subr which the Lisp_Object $ points to.
 727 end
 728
 729 define xchartable
 730   xgetptr $
 731   print (struct Lisp_Char_Table *) $ptr
 732   printf "Purpose: "
 733   xprintsym $->purpose
 734   printf "  %d extra slots", ($->size & 0x1ff) - 388
 735   echo \n
 736 end
 737 document xchartable
 738 Print the address of the char-table $, and its purpose.
 739 This command assumes that $ is an Emacs Lisp char-table value.
 740 end
 741
 742 define xboolvector
 743   xgetptr $
 744   print (struct Lisp_Bool_Vector *) $ptr
 745   output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
 746   echo \n
 747 end
 748 document xboolvector
 749 Print the contents and address of the bool-vector $.
 750 This command assumes that $ is an Emacs Lisp bool-vector value.
 751 end
 752
 753 define xbuffer
 754   xgetptr $
 755   print (struct buffer *) $ptr
 756   xgetptr $->name
 757   output ((struct Lisp_String *) $ptr)->data
 758   echo \n
 759 end
 760 document xbuffer
 761 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
 762 Print the name of the buffer.
 763 end
 764
 765 define xhashtable
 766   xgetptr $
 767   print (struct Lisp_Hash_Table *) $ptr
 768 end
 769 document xhashtable
 770 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
 771 end
 772
 773 define xcons
 774   xgetptr $
 775   print (struct Lisp_Cons *) $ptr
 776   output/x *$
 777   echo \n
 778 end
 779 document xcons
 780 Print the contents of $, assuming it is an Emacs Lisp cons.
 781 end
 782
 783 define nextcons
 784   p $.u.cdr
 785   xcons
 786 end
 787 document nextcons
 788 Print the contents of the next cell in a list.
 789 This assumes that the last thing you printed was a cons cell contents
 790 (type struct Lisp_Cons) or a pointer to one.
 791 end
 792 define xcar
 793   xgetptr $
 794   xgettype $
 795   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 796 end
 797 document xcar
 798 Print the car of $, assuming it is an Emacs Lisp pair.
 799 end
 800
 801 define xcdr
 802   xgetptr $
 803   xgettype $
 804   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 805 end
 806 document xcdr
 807 Print the cdr of $, assuming it is an Emacs Lisp pair.
 808 end
 809
 810 define xlist
 811   xgetptr $
 812   set $cons = (struct Lisp_Cons *) $ptr
 813   xgetptr Qnil
 814   set $nil = $ptr
 815   set $i = 0
 816   while $cons != $nil && $i < 10
 817     p/x $cons->car
 818     xpr
 819     xgetptr $cons->u.cdr
 820     set $cons = (struct Lisp_Cons *) $ptr
 821     set $i = $i + 1
 822     printf "---\n"
 823   end
 824   if $cons == $nil
 825     printf "nil\n"
 826   else
 827     printf "...\n"
 828     p $ptr
 829   end
 830 end
 831 document xlist
 832 Print $ assuming it is a list.
 833 end
 834
 835 define xfloat
 836   xgetptr $
 837   print ((struct Lisp_Float *) $ptr)->u.data
 838 end
 839 document xfloat
 840 Print $ assuming it is a lisp floating-point number.
 841 end
 842
 843 define xscrollbar
 844   xgetptr $
 845   print (struct scrollbar *) $ptr
 846 output *$
 847 echo \n
 848 end
 849 document xscrollbar
 850 Print $ as a scrollbar pointer.
 851 end
 852
 853 define xpr
 854   xtype
 855   if $type == Lisp_Int
 856     xint
 857   end
 858   if $type == Lisp_Symbol
 859     xsymbol
 860   end
 861   if $type == Lisp_String
 862     xstring
 863   end
 864   if $type == Lisp_Cons
 865     xcons
 866   end
 867   if $type == Lisp_Float
 868     xfloat
 869   end
 870   if $type == Lisp_Misc
 871     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 872     if $misc == Lisp_Misc_Free
 873       xmiscfree
 874     end
 875     if $misc == Lisp_Misc_Boolfwd
 876       xboolfwd
 877     end
 878     if $misc == Lisp_Misc_Marker
 879       xmarker
 880     end
 881     if $misc == Lisp_Misc_Intfwd
 882       xintfwd
 883     end
 884     if $misc == Lisp_Misc_Boolfwd
 885       xboolfwd
 886     end
 887     if $misc == Lisp_Misc_Objfwd
 888       xobjfwd
 889     end
 890     if $misc == Lisp_Misc_Buffer_Objfwd
 891       xbufobjfwd
 892     end
 893     if $misc == Lisp_Misc_Buffer_Local_Value
 894       xbuflocal
 895     end
 896 #    if $misc == Lisp_Misc_Some_Buffer_Local_Value
 897 #      xvalue
 898 #    end
 899     if $misc == Lisp_Misc_Overlay
 900       xoverlay
 901     end
 902     if $misc == Lisp_Misc_Kboard_Objfwd
 903       xkbobjfwd
 904     end
 905 #    if $misc == Lisp_Misc_Save_Value
 906 #      xsavevalue
 907 #    end
 908   end
 909   if $type == Lisp_Vectorlike
 910     set $size = ((struct Lisp_Vector *) $ptr)->size
 911     if ($size & PVEC_FLAG)
 912       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
 913       if $vec == PVEC_NORMAL_VECTOR
 914         xvector
 915       end
 916       if $vec == PVEC_PROCESS
 917         xprocess
 918       end
 919       if $vec == PVEC_FRAME
 920         xframe
 921       end
 922       if $vec == PVEC_COMPILED
 923         xcompiled
 924       end
 925       if $vec == PVEC_WINDOW
 926         xwindow
 927       end
 928       if $vec == PVEC_WINDOW_CONFIGURATION
 929         xwinconfig
 930       end
 931       if $vec == PVEC_SUBR
 932         xsubr
 933       end
 934       if $vec == PVEC_CHAR_TABLE
 935         xchartable
 936       end
 937       if $vec == PVEC_BOOL_VECTOR
 938         xboolvector
 939       end
 940       if $vec == PVEC_BUFFER
 941         xbuffer
 942       end
 943       if $vec == PVEC_HASH_TABLE
 944         xhashtable
 945       end
 946     else
 947       xvector
 948     end
 949   end
 950 end
 951 document xpr
 952 Print $ as a lisp object of any type.
 953 end
 954
 955 define xprintstr
 956   set $data = $arg0->data
 957   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
 958 end
 959
 960 define xprintsym
 961   xgetptr $arg0
 962   set $sym = (struct Lisp_Symbol *) $ptr
 963   xgetptr $sym->xname
 964   set $sym_name = (struct Lisp_String *) $ptr
 965   xprintstr $sym_name
 966 end
 967 document xprintsym
 968   Print argument as a symbol.
 969 end
 970
 971 define xbacktrace
 972   set $bt = backtrace_list
 973   while $bt
 974     xgettype (*$bt->function)
 975     if $type == Lisp_Symbol
 976       xprintsym (*$bt->function)
 977       printf " (0x%x)\n", *$bt->args
 978     else
 979       printf "0x%x ", *$bt->function
 980       if $type == Lisp_Vectorlike
 981         xgetptr (*$bt->function)
 982         set $size = ((struct Lisp_Vector *) $ptr)->size
 983         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 984       else
 985         printf "Lisp type %d", $type
 986       end
 987       echo \n
 988     end
 989     set $bt = $bt->next
 990   end
 991 end
 992 document xbacktrace
 993   Print a backtrace of Lisp function calls from backtrace_list.
 994   Set a breakpoint at Fsignal and call this to see from where
 995   an error was signaled.
 996 end
 997
 998 define which
 999   set debug_print (which_symbols ($arg0))
1000 end
1001 document which
1002   Print symbols which references a given lisp object,
1003   either as its symbol value or symbol function.
1004 end
1005
1006 define xbytecode
1007   set $bt = byte_stack_list
1008   while $bt
1009     xgettype ($bt->byte_string)
1010     printf "0x%x => ", $bt->byte_string
1011     which $bt->byte_string
1012     set $bt = $bt->next
1013   end
1014 end
1015 document xbytecode
1016   Print a backtrace of the byte code stack.
1017 end
1018
1019 # Show Lisp backtrace after normal backtrace.
1020 define hookpost-backtrace
1021   set $bt = backtrace_list
1022   if $bt
1023     echo \n
1024     echo Lisp Backtrace:\n
1025     xbacktrace
1026   end
1027 end
1028
1029 define xreload
1030   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1031   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1032 end
1033 document xreload
1034   When starting Emacs a second time in the same gdb session under
1035   FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1036   their values.  (The same happens on current (2000) versions of GNU/Linux
1037   with gdb 5.0.)
1038   This function reloads them.
1039 end
1040 xreload
1041
1042 # Flush display (X only)
1043 define ff
1044   set x_flush (0)
1045 end
1046 document ff
1047 Flush pending X window display updates to screen.
1048 Works only when an inferior emacs is executing.
1049 end
1050
1051
1052 define hook-run
1053   xreload
1054 end
1055
1056 # Call xreload if a new Emacs executable is loaded.
1057 define hookpost-run
1058   xreload
1059 end
1060
1061 set print pretty on
1062 set print sevenbit-strings
1063
1064 show environment DISPLAY
1065 show environment TERM
1066 set args -geometry 80x40+0+0
1067
1068 # People get bothered when they see messages about non-existent functions...
1069 xgetptr Vsystem_type
1070 # $ptr is NULL in temacs
1071 if ($ptr != 0)
1072   set $tem = (struct Lisp_Symbol *) $ptr
1073   xgetptr $tem->xname
1074   set $tem = (struct Lisp_String *) $ptr
1075   set $tem = (char *) $tem->data
1076
1077   # Don't let abort actually run, as it will make stdio stop working and
1078   # therefore the `pr' command above as well.
1079   if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1080     # The windows-nt build replaces abort with its own function.
1081     break w32_abort
1082   else
1083     break abort
1084   end
1085 end
1086
1087 # x_error_quitter is defined only on X.  But window-system is set up
1088 # only at run time, during Emacs startup, so we need to defer setting
1089 # the breakpoint.  init_sys_modes is the first function called on
1090 # every platform after init_display, where window-system is set.
1091 tbreak init_sys_modes
1092 commands
1093   silent
1094   xgetptr Vwindow_system
1095   set $tem = (struct Lisp_Symbol *) $ptr
1096   xgetptr $tem->xname
1097   set $tem = (struct Lisp_String *) $ptr
1098   set $tem = (char *) $tem->data
1099   # If we are running in synchronous mode, we want a chance to look
1100   # around before Emacs exits.  Perhaps we should put the break
1101   # somewhere else instead...
1102   if $tem[0] == 'x' && $tem[1] == '\0'
1103     break x_error_quitter
1104   end
1105   continue
1106 end
1107 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe