.gdbinit 32.1 KB
Newer Older
Paul Eggert's avatar
Paul Eggert committed
1
# Copyright (C) 1992-1998, 2000-2020 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
2 3 4 5 6
#
# This file is part of GNU Emacs.
#
# GNU Emacs is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3, or (at your option)
Gerd Moellmann's avatar
Gerd Moellmann committed
8 9 10 11 12 13 14 15
# any later version.
#
# GNU Emacs is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
16
# along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Gerd Moellmann's avatar
Gerd Moellmann committed
17

18
# Force loading of symbols, enough to give us VALBITS etc.
19
set $dummy = main + 8
20
# With some compilers, we need this to give us struct Lisp_Symbol etc.:
21
set $dummy = Fmake_symbol + 8
22

Richard M. Stallman's avatar
Richard M. Stallman committed
23 24
# Find lwlib source files too.
dir ../lwlib
25
#dir /gd/gnu/lesstif-0.89.9/lib/Xm
Richard M. Stallman's avatar
Richard M. Stallman committed
26

Karl Heuer's avatar
Karl Heuer committed
27 28 29 30 31 32
# Don't enter GDB when user types C-g to quit.
# This has one unfortunate effect: you can't type C-c
# at the GDB to stop Emacs, when using X.
# However, C-z works just as well in that case.
handle 2 noprint pass

33 34 35
# Make it work like SIGINT normally does.
handle SIGTSTP nopass

36 37 38 39
# Pass on user signals
handle SIGUSR1 noprint pass
handle SIGUSR2 noprint pass

Gerd Moellmann's avatar
Gerd Moellmann committed
40 41 42 43
# Don't pass SIGALRM to Emacs.  This makes problems when
# debugging.
handle SIGALRM ignore

44 45
# Use $bugfix so that the value isn't a constant.
# Using a constant runs into GDB bugs sometimes.
Kenichi Handa's avatar
Kenichi Handa committed
46
define xgetptr
Paul Eggert's avatar
Paul Eggert committed
47 48 49 50 51
  if (CHECK_LISP_OBJECT_TYPE)
    set $bugfix = $arg0.i
  else
    set $bugfix = $arg0
  end
52
  set $ptr = (EMACS_INT) $bugfix & VALMASK
Kenichi Handa's avatar
Kenichi Handa committed
53 54 55
end

define xgetint
Paul Eggert's avatar
Paul Eggert committed
56 57 58 59 60
  if (CHECK_LISP_OBJECT_TYPE)
    set $bugfix = $arg0.i
  else
    set $bugfix = $arg0
  end
61
  set $int = (EMACS_INT) $bugfix << (USE_LSB_TAG ? 0 : INTTYPEBITS) >> INTTYPEBITS
Kenichi Handa's avatar
Kenichi Handa committed
62 63 64
end

define xgettype
Paul Eggert's avatar
Paul Eggert committed
65 66 67 68 69
  if (CHECK_LISP_OBJECT_TYPE)
    set $bugfix = $arg0.i
  else
    set $bugfix = $arg0
  end
70
  set $type = (enum Lisp_Type) (USE_LSB_TAG ? (EMACS_INT) $bugfix & (1 << GCTYPEBITS) - 1 : (EMACS_UINT) $bugfix >> VALBITS)
Kenichi Handa's avatar
Kenichi Handa committed
71
end
72

73 74
define xgetsym
  xgetptr $arg0
75
  set $ptr = ((struct Lisp_Symbol *) ((char *) &lispsym + $ptr))
76 77
end

78 79
# Access the name of a symbol
define xsymname
80
  xgetsym $arg0
81
  set $symname = $ptr->u.s.name
82 83
end

Jim Blandy's avatar
Jim Blandy committed
84
# Set up something to print out s-expressions.
85 86 87
# We save and restore print_output_debug_flag to prevent the w32 port
# from calling OutputDebugString, which causes GDB to display each
# character twice (yuk!).
Jim Blandy's avatar
Jim Blandy committed
88
define pr
89
  pp $
Jim Blandy's avatar
Jim Blandy committed
90 91 92 93 94 95
end
document pr
Print the emacs s-expression which is $.
Works only when an inferior emacs is executing.
end

Kim F. Storm's avatar
Kim F. Storm committed
96 97 98
# Print out s-expressions
define pp
  set $tmp = $arg0
99 100
  set $output_debug = print_output_debug_flag
  set print_output_debug_flag = 0
101
  call safe_debug_print ($tmp)
102
  set print_output_debug_flag = $output_debug
Kim F. Storm's avatar
Kim F. Storm committed
103 104 105 106 107 108
end
document pp
Print the argument as an emacs s-expression
Works only when an inferior emacs is executing.
end

109 110 111
# Print value of lisp variable
define pv
  set $tmp = "$arg0"
112 113
  set $output_debug = print_output_debug_flag
  set print_output_debug_flag = 0
114
  call safe_debug_print (find_symbol_value (intern ($tmp)))
115
  set print_output_debug_flag = $output_debug
116
end
117
document pv
118 119 120 121
Print the value of the lisp variable given as argument.
Works only when an inferior emacs is executing.
end

122 123 124 125 126 127
# Format the value and print it as a string. Works in
# an rr session and during live debugging. Calls into lisp.
define xfmt
  printf "%s\n", debug_format("%S", $arg0)
end

Kim F. Storm's avatar
Kim F. Storm committed
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
# Print out current buffer point and boundaries
define ppt
  set $b = current_buffer
  set $t = $b->text
  printf "BUF PT: %d", $b->pt
  if ($b->pt != $b->pt_byte)
    printf "[%d]", $b->pt_byte
  end
  printf " of 1..%d", $t->z
  if ($t->z != $t->z_byte)
    printf "[%d]", $t->z_byte
  end
  if ($b->begv != 1 || $b->zv != $t->z)
    printf " NARROW=%d..%d", $b->begv, $b->zv
    if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
      printf " [%d..%d]", $b->begv_byte, $b->zv_byte
    end
  end
  printf " GAP: %d", $t->gpt
  if ($t->gpt != $t->gpt_byte)
    printf "[%d]", $t->gpt_byte
  end
  printf " SZ=%d\n", $t->gap_size
end
document ppt
153 154
Print current buffer's point and boundaries.
Prints values of point, beg, end, narrow, and gap for current buffer.
Kim F. Storm's avatar
Kim F. Storm committed
155 156
end

157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
define pitmethod
  set $itmethod = $arg0
  # output $itmethod
  if ($itmethod == 0)
    printf "GET_FROM_BUFFER"
  end
  if ($itmethod == 1)
    printf "GET_FROM_DISPLAY_VECTOR"
  end
  if ($itmethod == 2)
    printf "GET_FROM_STRING"
  end
  if ($itmethod == 3)
    printf "GET_FROM_C_STRING"
  end
  if ($itmethod == 4)
    printf "GET_FROM_IMAGE"
  end
  if ($itmethod == 5)
    printf "GET_FROM_STRETCH"
  end
  if ($itmethod < 0 || $itmethod > 5)
    output $itmethod
  end
end
document pitmethod
Pretty print it->method given as first arg
end

186 187 188 189 190 191 192
# Print out iterator given as first arg
define pitx
  set $it = $arg0
  printf "cur=%d", $it->current.pos.charpos
  if ($it->current.pos.charpos != $it->current.pos.bytepos)
    printf "[%d]", $it->current.pos.bytepos
  end
193 194 195 196
  printf " pos=%d", $it->position.charpos
  if ($it->position.charpos != $it->position.bytepos)
    printf "[%d]", $it->position.bytepos
  end
197 198 199 200
  printf " start=%d", $it->start.pos.charpos
  if ($it->start.pos.charpos != $it->start.pos.bytepos)
    printf "[%d]", $it->start.pos.bytepos
  end
201 202 203 204 205 206 207 208 209 210
  printf " end=%d", $it->end_charpos
  printf " stop=%d", $it->stop_charpos
  printf " face=%d", $it->face_id
  if ($it->multibyte_p)
    printf " MB"
  end
  if ($it->header_line_p)
    printf " HL"
  end
  if ($it->n_overlay_strings > 0)
211
    printf " nov=%d", $it->n_overlay_strings
212 213 214 215
  end
  if ($it->sp != 0)
    printf " sp=%d", $it->sp
  end
Eli Zaretskii's avatar
Eli Zaretskii committed
216 217
  # IT_CHARACTER
  if ($it->what == 0)
218
    if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
219
      printf " ch='%c'", $it->c
220
    else
221
      printf " ch=[%d,%d]", $it->c, $it->len
222 223
    end
  else
224
    printf " "
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
    # output $it->what
    if ($it->what == 0)
      printf "IT_CHARACTER"
    end
    if ($it->what == 1)
      printf "IT_COMPOSITION"
    end
    if ($it->what == 2)
      printf "IT_IMAGE"
    end
    if ($it->what == 3)
      printf "IT_STRETCH"
    end
    if ($it->what == 4)
      printf "IT_EOB"
    end
    if ($it->what == 5)
      printf "IT_TRUNCATION"
    end
    if ($it->what == 6)
      printf "IT_CONTINUATION"
    end
    if ($it->what < 0 || $it->what > 6)
      output $it->what
    end
250
  end
Eli Zaretskii's avatar
Eli Zaretskii committed
251 252
  if ($it->method != 0)
    # !GET_FROM_BUFFER
253
    printf " next="
254
    pitmethod $it->method
Eli Zaretskii's avatar
Eli Zaretskii committed
255 256
    if ($it->method == 2)
      # GET_FROM_STRING
257 258
      printf "[%d]", $it->current.string_pos.charpos
    end
Eli Zaretskii's avatar
Eli Zaretskii committed
259 260
    if ($it->method == 4)
      # GET_FROM_IMAGE
261 262
      printf "[%d]", $it->image_id
    end
263
  end
264
  printf "\n"
265 266 267
  if ($it->bidi_p)
    printf "BIDI: base_stop=%d prev_stop=%d level=%d\n", $it->base_level_stop, $it->prev_stop, $it->bidi_it.resolved_level
  end
268 269 270
  if ($it->region_beg_charpos >= 0)
    printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
  end
271 272
  printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
  printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
273
  printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
Kim F. Storm's avatar
Kim F. Storm committed
274
  printf " w=%d", $it->pixel_width
275 276 277
  printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
  printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
  printf "\n"
Kim F. Storm's avatar
Kim F. Storm committed
278
  set $i = 0
279
  while ($i < $it->sp && $i < 4)
Kim F. Storm's avatar
Kim F. Storm committed
280 281
    set $e = $it->stack[$i]
    printf "stack[%d]: ", $i
282 283
    pitmethod $e.method
    printf "[%d]", $e.position.charpos
Kim F. Storm's avatar
Kim F. Storm committed
284 285 286
    printf "\n"
    set $i = $i + 1
  end
287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
end
document pitx
Pretty print a display iterator.
Take one arg, an iterator object or pointer.
end

define pit
  pitx it
end
document pit
Pretty print the display iterator it.
end

define prowx
  set $row = $arg0
  printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
  printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
  printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
305 306
  printf " vis=%d\n", $row->visible_height
  printf "used=(LMargin=%d,Text=%d,RMargin=%d) Hash=%d\n", $row->used[0], $row->used[1], $row->used[2], $row->hash
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
  printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
  if ($row->enabled_p)
    printf " ENA"
  end
  if ($row->displays_text_p)
    printf " DISP"
  end
  if ($row->mode_line_p)
    printf " MODEL"
  end
  if ($row->continued_p)
    printf " CONT"
  end
  if ($row-> truncated_on_left_p)
    printf " TRUNC:L"
  end
  if ($row-> truncated_on_right_p)
    printf " TRUNC:R"
  end
  if ($row->starts_in_middle_of_char_p)
    printf " STARTMID"
  end
  if ($row->ends_in_middle_of_char_p)
    printf " ENDMID"
  end
  if ($row->ends_in_newline_from_string_p)
    printf " ENDNLFS"
  end
  if ($row->ends_at_zv_p)
    printf " ENDZV"
  end
  if ($row->overlapped_p)
    printf " OLAPD"
  end
  if ($row->overlapping_p)
    printf " OLAPNG"
  end
  printf "\n"
end
document prowx
Pretty print information about glyph_row.
Takes one argument, a row object or pointer.
end

define prow
  prowx row
end
document prow
Pretty print information about glyph_row in row.
end


define pcursorx
  set $cp = $arg0
Eli Zaretskii's avatar
Eli Zaretskii committed
361
  printf "y=%d x=%d vpos=%d hpos=%d", $cp.y, $cp.x, $cp.vpos, $cp.hpos
362 363
end
document pcursorx
364
Pretty print a window cursor.
365 366 367 368 369 370 371 372
end

define pcursor
  printf "output: "
  pcursorx output_cursor
  printf "\n"
end
document pcursor
373
Pretty print the output_cursor.
374 375 376 377
end

define pwinx
  set $w = $arg0
Eli Zaretskii's avatar
Eli Zaretskii committed
378
  if ($w->mini != 0)
379 380
    printf "Mini "
  end
Eli Zaretskii's avatar
Eli Zaretskii committed
381 382
  printf "Window %d ", $w->sequence_number
  xgetptr $w->contents
383
  set $tem = (struct buffer *) $ptr
384
  xgetptr $tem->name_
385
  printf "%s", $ptr ? (char *) ((struct Lisp_String *) $ptr)->u.s.data : "DEAD"
386 387 388 389
  printf "\n"
  xgetptr $w->start
  set $tem = (struct Lisp_Marker *) $ptr
  printf "start=%d end:", $tem->charpos
Eli Zaretskii's avatar
Eli Zaretskii committed
390 391 392
  if ($w->window_end_valid != 0)
    printf "pos=%d", $w->window_end_pos
    printf " vpos=%d", $w->window_end_vpos
393 394 395 396
  else
    printf "invalid"
  end
  printf " vscroll=%d", $w->vscroll
Eli Zaretskii's avatar
Eli Zaretskii committed
397
  if ($w->force_start != 0)
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429
    printf " FORCE_START"
  end
  if ($w->must_be_updated_p)
    printf " MUST_UPD"
  end
  printf "\n"
  printf "cursor: "
  pcursorx $w->cursor
  printf "  phys: "
  pcursorx $w->phys_cursor
  if ($w->phys_cursor_on_p)
    printf " ON"
  else
    printf " OFF"
  end
  printf " blk="
  if ($w->last_cursor_off_p != $w->cursor_off_p)
    if ($w->last_cursor_off_p)
      printf "ON->"
    else
      printf "OFF->"
    end
  end
  if ($w->cursor_off_p)
    printf "ON"
  else
    printf "OFF"
  end
  printf "\n"
end
document pwinx
Pretty print a window structure.
430
Takes one argument, a pointer to a window structure.
431 432 433 434 435 436 437 438 439
end

define pwin
  pwinx w
end
document pwin
Pretty print window structure w.
end

440
define pbiditype
441 442 443
  if ($arg0 == 0)
    printf "UNDEF"
  end
444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461
  if ($arg0 == 1)
    printf "L"
  end
  if ($arg0 == 2)
    printf "R"
  end
  if ($arg0 == 3)
    printf "EN"
  end
  if ($arg0 == 4)
    printf "AN"
  end
  if ($arg0 == 5)
    printf "BN"
  end
  if ($arg0 == 6)
    printf "B"
  end
462
  if ($arg0 < 0 || $arg0 > 6)
463 464 465 466 467 468 469
    printf "%d??", $arg0
  end
end
document pbiditype
Print textual description of bidi type given as first argument.
end

470 471
define pgx
  set $g = $arg0
472
  # CHAR_GLYPH
473 474 475
  if ($g.type == 0)
    if ($g.u.ch >= ' ' && $g.u.ch < 127)
      printf "CHAR[%c]", $g.u.ch
476
    else
477
      printf "CHAR[0x%x]", $g.u.ch
478 479
    end
  end
480
  # COMPOSITE_GLYPH
481 482
  if ($g.type == 1)
    printf "COMP[%d (%d..%d)]", $g.u.cmp.id, $g.slice.cmp.from, $g.slice.cmp.to
483
  end
484
  # GLYPHLESS_GLYPH
485
  if ($g.type == 2)
486
    printf "G-LESS["
487
    if ($g.u.glyphless.method == 0)
488
      printf "THIN;0x%x]", $g.u.glyphless.ch
489
    end
490
    if ($g.u.glyphless.method == 1)
491
      printf "EMPTY;0x%x]", $g.u.glyphless.ch
492
    end
493
    if ($g.u.glyphless.method == 2)
494
      printf "ACRO;0x%x]", $g.u.glyphless.ch
495
    end
496
    if ($g.u.glyphless.method == 3)
497
      printf "HEX;0x%x]", $g.u.glyphless.ch
498 499 500
    end
  end
  # IMAGE_GLYPH
501 502
  if ($g.type == 3)
    printf "IMAGE[%d]", $g.u.img_id
503 504 505
    if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
      printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height
    end
506
  end
507
  # STRETCH_GLYPH
508 509
  if ($g.type == 4)
    printf "STRETCH[%d+%d]", $g.u.stretch.height, $g.u.stretch.ascent
510
  end
511
  xgettype ($g.object)
512
  if ($type == Lisp_String)
513
    xgetptr $g.object
514 515 516 517 518 519
    if ($ptr)
      printf " str=0x%x", ((struct Lisp_String *)$ptr)->u.s.data
    else
      printf " str=DEAD"
    end
    printf "[%d]", $g.charpos
520
  else
521
    printf " pos=%d", $g.charpos
522
  end
523
  # For characters, print their resolved level and bidi type
524
  if ($g.type == 0 || $g.type == 2)
525 526
    printf " blev=%d,btyp=", $g.resolved_level
    pbiditype $g.bidi_type
527
  end
528
  printf " w=%d a+d=%d+%d", $g.pixel_width, $g.ascent, $g.descent
529
  # If not DEFAULT_FACE_ID
530 531
  if ($g.face_id != 0)
    printf " face=%d", $g.face_id
532
  end
533 534
  if ($g.voffset)
    printf " vof=%d", $g.voffset
535
  end
536
  if ($g.multibyte_p)
537 538
    printf " MB"
  end
539
  if ($g.padding_p)
540 541
    printf " PAD"
  end
542
  if ($g.glyph_not_available_p)
543 544
    printf " N/A"
  end
545
  if ($g.overlaps_vertically_p)
546 547
    printf " OVL"
  end
548
  if ($g.avoid_cursor_p)
549 550
    printf " AVOID"
  end
551
  if ($g.left_box_line_p)
552 553
    printf " ["
  end
554
  if ($g.right_box_line_p)
555 556 557 558 559 560
    printf " ]"
  end
  printf "\n"
end
document pgx
Pretty print a glyph structure.
561
Takes one argument, a pointer to a glyph structure.
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577
end

define pg
  set $pgidx = 0
  pgx glyph
end
document pg
Pretty print glyph structure glyph.
end

define pgi
  set $pgidx = $arg0
  pgx (&glyph[$pgidx])
end
document pgi
Pretty print glyph structure glyph[I].
578
Takes one argument, an integer I.
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
end

define pgn
  set $pgidx = $pgidx + 1
  pgx (&glyph[$pgidx])
end
document pgn
Pretty print next glyph structure.
end

define pgrowx
  set $row = $arg0
  set $area = 0
  set $xofs = $row->x
  while ($area < 3)
    set $used = $row->used[$area]
    if ($used > 0)
      set $gl0 = $row->glyphs[$area]
      set $pgidx = 0
      printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
      while ($pgidx < $used)
	printf "%3d %4d: ", $pgidx, $xofs
	pgx $gl0[$pgidx]
	set $xofs = $xofs + $gl0[$pgidx]->pixel_width
	set $pgidx = $pgidx + 1
      end
    end
    set $area = $area + 1
  end
end
document pgrowx
Pretty print all glyphs in a row structure.
Takes one argument, a pointer to a row structure.
end

define pgrow
  pgrowx row
end
document pgrow
Pretty print all glyphs in row structure row.
end
620

621 622 623 624 625 626 627
define pgrowit
  pgrowx it->glyph_row
end
document pgrowit
Pretty print all glyphs in it->glyph_row.
end

628
define prowlims
629
  printf "edges=(%d,%d),enb=%d,r2l=%d,cont=%d,trunc=(%d,%d),at_zv=%d\n", $arg0->minpos.charpos, $arg0->maxpos.charpos, $arg0->enabled_p, $arg0->reversed_p, $arg0->continued_p, $arg0->truncated_on_left_p, $arg0->truncated_on_right_p, $arg0->ends_at_zv_p
630 631 632 633 634 635 636 637 638
end
document prowlims
Print important attributes of a glyph_row structure.
Takes one argument, a pointer to a glyph_row structure.
end

define pmtxrows
  set $mtx = $arg0
  set $gl = $mtx->rows
639 640
  set $glend = $mtx->rows + $mtx->nrows - 1
  set $i = 0
641
  while ($gl < $glend)
642
    printf "%d: ", $i
643 644
    prowlims $gl
    set $gl = $gl + 1
645
    set $i = $i + 1
646 647 648 649 650 651 652
  end
end
document pmtxrows
Print data about glyph rows in a glyph matrix.
Takes one argument, a pointer to a glyph_matrix structure.
end

Jim Blandy's avatar
Jim Blandy committed
653
define xtype
Kenichi Handa's avatar
Kenichi Handa committed
654 655 656
  xgettype $
  output $type
  echo \n
657 658
  if $type == Lisp_Vectorlike
    xvectype
Kenichi Handa's avatar
Kenichi Handa committed
659
  end
Jim Blandy's avatar
Jim Blandy committed
660
end
Jim Blandy's avatar
Jim Blandy committed
661
document xtype
Richard M. Stallman's avatar
Richard M. Stallman committed
662
Print the type of $, assuming it is an Emacs Lisp value.
663
If the first type printed is Lisp_Vectorlike,
Kenichi Handa's avatar
Kenichi Handa committed
664
a second line gives the more precise type.
665 666
end

667 668
define pvectype
  set $size = ((struct Lisp_Vector *) $arg0)->header.size
669
  if ($size & PSEUDOVECTOR_FLAG)
670
    output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
671
  else
672
    output PVEC_NORMAL_VECTOR
673
  end
Kenichi Handa's avatar
Kenichi Handa committed
674
  echo \n
675
end
676 677 678
document pvectype
Print the subtype of vectorlike object.
Takes one argument, a pointer to an object.
679 680
end

681
define xvectype
682
  xgetptr $
683 684 685 686 687 688 689 690 691
  pvectype $ptr
end
document xvectype
Print the subtype of vectorlike object.
This command assumes that $ is a Lisp_Object.
end

define pvecsize
  set $size = ((struct Lisp_Vector *) $arg0)->header.size
692 693 694 695 696 697 698 699 700
  if ($size & PSEUDOVECTOR_FLAG)
    output ($size & PSEUDOVECTOR_SIZE_MASK)
    echo \n
    output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS)
  else
    output ($size & ~ARRAY_MARK_FLAG)
  end
  echo \n
end
701 702 703 704 705 706 707 708 709
document pvecsize
Print the size of vectorlike object.
Takes one argument, a pointer to an object.
end

define xvecsize
  xgetptr $
  pvecsize $ptr
end
710
document xvecsize
711 712
Print the size of $
This command assumes that $ is a Lisp_Object.
713 714
end

Jim Blandy's avatar
Jim Blandy committed
715
define xint
Kenichi Handa's avatar
Kenichi Handa committed
716 717
  xgetint $
  print $int
Jim Blandy's avatar
Jim Blandy committed
718
end
Jim Blandy's avatar
Jim Blandy committed
719
document xint
720
Print $ as an Emacs Lisp integer.  This gets the sign right.
Jim Blandy's avatar
Jim Blandy committed
721
end
Jim Blandy's avatar
Jim Blandy committed
722 723

define xptr
Kenichi Handa's avatar
Kenichi Handa committed
724 725
  xgetptr $
  print (void *) $ptr
Jim Blandy's avatar
Jim Blandy committed
726
end
Jim Blandy's avatar
Jim Blandy committed
727
document xptr
728
Print the pointer portion of an Emacs Lisp value in $.
Jim Blandy's avatar
Jim Blandy committed
729
end
Jim Blandy's avatar
Jim Blandy committed
730 731

define xmarker
Kenichi Handa's avatar
Kenichi Handa committed
732 733
  xgetptr $
  print (struct Lisp_Marker *) $ptr
Jim Blandy's avatar
Jim Blandy committed
734
end
Jim Blandy's avatar
Jim Blandy committed
735
document xmarker
736 737
Print $ as a marker pointer.
This command assumes that $ is an Emacs Lisp marker value.
Jim Blandy's avatar
Jim Blandy committed
738
end
Jim Blandy's avatar
Jim Blandy committed
739

740
define xoverlay
Kenichi Handa's avatar
Kenichi Handa committed
741 742
  xgetptr $
  print (struct Lisp_Overlay *) $ptr
743 744
end
document xoverlay
745 746
Print $ as a overlay pointer.
This command assumes that $ is an Emacs Lisp overlay value.
747 748
end

Jim Blandy's avatar
Jim Blandy committed
749
define xsymbol
Kim F. Storm's avatar
Kim F. Storm committed
750
  set $sym = $
751
  xgetsym $sym
Kenichi Handa's avatar
Kenichi Handa committed
752
  print (struct Lisp_Symbol *) $ptr
Kim F. Storm's avatar
Kim F. Storm committed
753
  xprintsym $sym
Kenichi Handa's avatar
Kenichi Handa committed
754
  echo \n
Jim Blandy's avatar
Jim Blandy committed
755
end
Jim Blandy's avatar
Jim Blandy committed
756 757
document xsymbol
Print the name and address of the symbol $.
Richard M. Stallman's avatar
Richard M. Stallman committed
758
This command assumes that $ is an Emacs Lisp symbol value.
Jim Blandy's avatar
Jim Blandy committed
759
end
Jim Blandy's avatar
Jim Blandy committed
760 761

define xstring
Kenichi Handa's avatar
Kenichi Handa committed
762 763
  xgetptr $
  print (struct Lisp_String *) $ptr
Stefan Monnier's avatar
Stefan Monnier committed
764
  xprintstr $
Kenichi Handa's avatar
Kenichi Handa committed
765
  echo \n
Jim Blandy's avatar
Jim Blandy committed
766 767
end
document xstring
Jim Blandy's avatar
Jim Blandy committed
768
Print the contents and address of the string $.
Richard M. Stallman's avatar
Richard M. Stallman committed
769
This command assumes that $ is an Emacs Lisp string value.
Jim Blandy's avatar
Jim Blandy committed
770 771 772
end

define xvector
Kenichi Handa's avatar
Kenichi Handa committed
773 774
  xgetptr $
  print (struct Lisp_Vector *) $ptr
775
  output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
Jim Blandy's avatar
Jim Blandy committed
776
echo \n
Jim Blandy's avatar
Jim Blandy committed
777 778
end
document xvector
Jim Blandy's avatar
Jim Blandy committed
779
Print the contents and address of the vector $.
Richard M. Stallman's avatar
Richard M. Stallman committed
780
This command assumes that $ is an Emacs Lisp vector value.
Jim Blandy's avatar
Jim Blandy committed
781 782
end

783
define xprocess
Kenichi Handa's avatar
Kenichi Handa committed
784 785 786 787
  xgetptr $
  print (struct Lisp_Process *) $ptr
  output *$
  echo \n
788 789
end
document xprocess
790 791
Print the address of the struct Lisp_process to which $ points.
This command assumes that $ is a Lisp_Object.
792 793
end

Jim Blandy's avatar
Jim Blandy committed
794
define xframe
Kenichi Handa's avatar
Kenichi Handa committed
795 796
  xgetptr $
  print (struct frame *) $ptr
797
  xgetptr $->name
Kim F. Storm's avatar
Kim F. Storm committed
798 799 800
  set $ptr = (struct Lisp_String *) $ptr
  xprintstr $ptr
  echo \n
Jim Blandy's avatar
Jim Blandy committed
801
end
Jim Blandy's avatar
Jim Blandy committed
802
document xframe
803 804
Print $ as a frame pointer.
This command assumes $ is an Emacs Lisp frame value.
Jim Blandy's avatar
Jim Blandy committed
805
end
Jim Blandy's avatar
Jim Blandy committed
806

807
define xcompiled
Kenichi Handa's avatar
Kenichi Handa committed
808 809
  xgetptr $
  print (struct Lisp_Vector *) $ptr
810
  output ($->contents[0])@($->header.size & 0xff)
Tom Tromey's avatar
Tom Tromey committed
811
  echo \n
812 813
end
document xcompiled
814 815
Print $ as a compiled function pointer.
This command assumes that $ is an Emacs Lisp compiled value.
816 817 818
end

define xwindow
Kenichi Handa's avatar
Kenichi Handa committed
819 820
  xgetptr $
  print (struct window *) $ptr
821
  set $window = (struct window *) $ptr
Eli Zaretskii's avatar
Eli Zaretskii committed
822
  printf "%dx%d+%d+%d\n", $window->total_cols, $window->total_lines, $window->left_col, $window->top_line
823 824 825 826 827 828
end
document xwindow
Print $ as a window pointer, assuming it is an Emacs Lisp window value.
Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
end

829
define xwinconfig
Kenichi Handa's avatar
Kenichi Handa committed
830 831
  xgetptr $
  print (struct save_window_data *) $ptr
832
end
833
document xwinconfig
834 835
Print $ as a window configuration pointer.
This command assumes that $ is an Emacs Lisp window configuration value.
836 837
end

838
define xsubr
Kenichi Handa's avatar
Kenichi Handa committed
839 840 841 842
  xgetptr $
  print (struct Lisp_Subr *) $ptr
  output *$
  echo \n
843
end
844 845 846 847 848
document xsubr
Print the address of the subr which the Lisp_Object $ points to.
end

define xchartable
Kenichi Handa's avatar
Kenichi Handa committed
849 850 851 852
  xgetptr $
  print (struct Lisp_Char_Table *) $ptr
  printf "Purpose: "
  xprintsym $->purpose
853
  printf "  %d extra slots", ($->header.size & 0x1ff) - 68
Kenichi Handa's avatar
Kenichi Handa committed
854
  echo \n
855 856 857 858 859 860
end
document xchartable
Print the address of the char-table $, and its purpose.
This command assumes that $ is an Emacs Lisp char-table value.
end

861 862 863
define xsubchartable
  xgetptr $
  print (struct Lisp_Sub_Char_Table *) $ptr
864 865
  set $subchartab = (struct Lisp_Sub_Char_Table *) $ptr
  printf "Depth: %d, Min char: %d (0x%x)\n", $subchartab->depth, $subchartab->min_char, $subchartab->min_char
866 867 868 869 870 871
end
document xsubchartable
Print the address of the sub-char-table $, its depth and min-char.
This command assumes that $ is an Emacs Lisp sub-char-table value.
end

872
define xboolvector
Kenichi Handa's avatar
Kenichi Handa committed
873 874
  xgetptr $
  print (struct Lisp_Bool_Vector *) $ptr
875
  output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
Kenichi Handa's avatar
Kenichi Handa committed
876
  echo \n
877 878 879 880 881 882 883
end
document xboolvector
Print the contents and address of the bool-vector $.
This command assumes that $ is an Emacs Lisp bool-vector value.
end

define xbuffer
Kenichi Handa's avatar
Kenichi Handa committed
884 885
  xgetptr $
  print (struct buffer *) $ptr
886
  xgetptr $->name_
887
  output $ptr ? (char *) ((struct Lisp_String *) $ptr)->u.s.data : "DEAD"
Kenichi Handa's avatar
Kenichi Handa committed
888
  echo \n
889 890
end
document xbuffer
891 892
Set $ as a buffer pointer and the name of the buffer.
This command assumes $ is an Emacs Lisp buffer value.
893 894
end

Gerd Moellmann's avatar
Gerd Moellmann committed
895
define xhashtable
Kenichi Handa's avatar
Kenichi Handa committed
896 897
  xgetptr $
  print (struct Lisp_Hash_Table *) $ptr
Gerd Moellmann's avatar
Gerd Moellmann committed
898 899
end
document xhashtable
900 901
Set $ as a hash table pointer.
This command assumes that $ is an Emacs Lisp hash table value.
Gerd Moellmann's avatar
Gerd Moellmann committed
902 903
end

Jim Blandy's avatar
Jim Blandy committed
904
define xcons
Kenichi Handa's avatar
Kenichi Handa committed
905 906 907 908
  xgetptr $
  print (struct Lisp_Cons *) $ptr
  output/x *$
  echo \n
Jim Blandy's avatar
Jim Blandy committed
909
end
Jim Blandy's avatar
Jim Blandy committed
910
document xcons
911
Print the contents of $ as an Emacs Lisp cons.
Jim Blandy's avatar
Jim Blandy committed
912
end
Jim Blandy's avatar
Jim Blandy committed
913

914
define nextcons
915
  p $.u.cdr
Kenichi Handa's avatar
Kenichi Handa committed
916
  xcons
917 918 919
end
document nextcons
Print the contents of the next cell in a list.
920
This command assumes that the last thing you printed was a cons cell contents
921 922
(type struct Lisp_Cons) or a pointer to one.
end
Jim Blandy's avatar
Jim Blandy committed
923
define xcar
Kenichi Handa's avatar
Kenichi Handa committed
924 925
  xgetptr $
  xgettype $
926
  print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.s.car : 0)
Jim Blandy's avatar
Jim Blandy committed
927
end
Jim Blandy's avatar
Jim Blandy committed
928
document xcar
929
Assume that $ is an Emacs Lisp pair and print its car.
Jim Blandy's avatar
Jim Blandy committed
930
end
Jim Blandy's avatar
Jim Blandy committed
931 932

define xcdr
Kenichi Handa's avatar
Kenichi Handa committed
933 934
  xgetptr $
  xgettype $
935
  print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.s.u.cdr : 0)
Jim Blandy's avatar
Jim Blandy committed
936
end
Jim Blandy's avatar
Jim Blandy committed
937
document xcdr
938
Assume that $ is an Emacs Lisp pair and print its cdr.
Jim Blandy's avatar
Jim Blandy committed
939
end
Jim Blandy's avatar
Jim Blandy committed
940

Kim F. Storm's avatar
Kim F. Storm committed
941 942 943 944 945 946 947
define xlist
  xgetptr $
  set $cons = (struct Lisp_Cons *) $ptr
  xgetptr Qnil
  set $nil = $ptr
  set $i = 0
  while $cons != $nil && $i < 10
948
    p/x $cons->u.s.car
Kim F. Storm's avatar
Kim F. Storm committed
949
    xpr
950
    xgetptr $cons->u.s.u.cdr
Kim F. Storm's avatar
Kim F. Storm committed
951 952 953 954 955 956 957 958 959 960 961 962 963 964 965
    set $cons = (struct Lisp_Cons *) $ptr
    set $i = $i + 1
    printf "---\n"
  end
  if $cons == $nil
    printf "nil\n"
  else
    printf "...\n"
    p $ptr
  end
end
document xlist
Print $ assuming it is a list.
end

Jim Blandy's avatar
Jim Blandy committed
966
define xfloat
Kenichi Handa's avatar
Kenichi Handa committed
967
  xgetptr $
968
  print ((struct Lisp_Float *) $ptr)->u.data
Jim Blandy's avatar
Jim Blandy committed
969 970 971 972 973
end
document xfloat
Print $ assuming it is a lisp floating-point number.
end

974
define xscrollbar
Kenichi Handa's avatar
Kenichi Handa committed
975 976
  xgetptr $
  print (struct scrollbar *) $ptr
977 978 979
output *$
echo \n
end
980
document xscrollbar
981 982 983
Print $ as a scrollbar pointer.
end

Kim F. Storm's avatar
Kim F. Storm committed
984 985
define xpr
  xtype
986 987
  if $type == Lisp_Int0 || $type == Lisp_Int1
    xint
Kim F. Storm's avatar
Kim F. Storm committed
988 989 990 991 992 993 994 995 996 997 998 999 1000 1001
  end
  if $type == Lisp_Symbol
    xsymbol
  end
  if $type == Lisp_String
    xstring
  end
  if $type == Lisp_Cons
    xcons
  end
  if $type == Lisp_Float
    xfloat
  end
  if $type == Lisp_Vectorlike
1002
    set $size = ((struct Lisp_Vector *) $ptr)->header.size
1003
    if ($size & PSEUDOVECTOR_FLAG)
1004
      set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
Kim F. Storm's avatar
Kim F. Storm committed
1005 1006 1007
      if $vec == PVEC_NORMAL_VECTOR
	xvector
      end
1008 1009 1010 1011 1012 1013
      if $vec == PVEC_MARKER
        xmarker
      end
      if $vec == PVEC_OVERLAY
        xoverlay
      end
Kim F. Storm's avatar
Kim F. Storm committed
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052
      if $vec == PVEC_PROCESS
	xprocess
      end
      if $vec == PVEC_FRAME
	xframe
      end
      if $vec == PVEC_COMPILED
	xcompiled
      end
      if $vec == PVEC_WINDOW
	xwindow
      end
      if $vec == PVEC_WINDOW_CONFIGURATION
	xwinconfig
      end
      if $vec == PVEC_SUBR
	xsubr
      end
      if $vec == PVEC_CHAR_TABLE
	xchartable
      end
      if $vec == PVEC_BOOL_VECTOR
	xboolvector
      end
      if $vec == PVEC_BUFFER
	xbuffer
      end
      if $vec == PVEC_HASH_TABLE
	xhashtable
      end
    else
      xvector
    end
  end
end
document xpr
Print $ as a lisp object of any type.
end

Stefan Monnier's avatar
Stefan Monnier committed
1053
define xprintstr
1054 1055
  if (! $arg0)
    output "DEAD"
1056
  else
1057 1058 1059 1060 1061 1062 1063 1064
    set $data = (char *) $arg0->u.s.data
    set $strsize = ($arg0->u.s.size_byte < 0) ? ($arg0->u.s.size & ~ARRAY_MARK_FLAG) : $arg0->u.s.size_byte
    # GDB doesn't like zero repetition counts
    if $strsize == 0
      output ""
    else
      output ($arg0->u.s.size > 1000) ? 0 : ($data[0])@($strsize)
    end
1065
  end
Stefan Monnier's avatar
Stefan Monnier committed
1066 1067
end

Gerd Moellmann's avatar
Gerd Moellmann committed
1068
define xprintsym
1069
  xsymname $arg0
1070
  xgetptr $symname
Eli Zaretskii's avatar
Eli Zaretskii committed
1071 1072 1073 1074
  if $ptr != 0
    set $sym_name = (struct Lisp_String *) $ptr
    xprintstr $sym_name
  end
Gerd Moellmann's avatar
Gerd Moellmann committed
1075 1076 1077 1078 1079
end
document xprintsym
  Print argument as a symbol.
end

1080
define xcoding
Paul Eggert's avatar
Paul Eggert committed
1081 1082
  set $tmp = (struct Lisp_Hash_Table *) (Vcoding_system_hash_table & VALMASK)
  set $tmp = (struct Lisp_Vector *) ($tmp->key_and_value & VALMASK)
1083 1084 1085 1086 1087 1088 1089
  set $name = $tmp->contents[$arg0 * 2]
  print $name
  pr
  print $tmp->contents[$arg0 * 2 + 1]
  pr
end
document xcoding
Kenichi Handa's avatar
Kenichi Handa committed
1090
  Print the name and attributes of coding system that has ID (argument).
1091 1092 1093
end

define xcharset
Paul Eggert's avatar
Paul Eggert committed
1094 1095
  set $tmp = (struct Lisp_Hash_Table *) (Vcharset_hash_table & VALMASK)
  set $tmp = (struct Lisp_Vector *) ($tmp->key_and_value & VALMASK)
1096
  p $tmp->contents[charset_table[$arg0].hash_index * 2]
1097 1098 1099
  pr
end
document xcharset
Kenichi Handa's avatar
Kenichi Handa committed
1100
  Print the name of charset that has ID (argument).
1101 1102
end

Kenichi Handa's avatar
Kenichi Handa committed
1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125
define xfontset
  xgetptr $
  set $tbl = (struct Lisp_Char_Table *) $ptr
  print $tbl
  xgetint $tbl->extras[0]
  printf " ID:%d", $int
  xgettype $tbl->extras[1]
  xgetptr $tbl->extras[1]
  if $type == Lisp_String
    set $ptr = (struct Lisp_String *) $ptr
    printf " Name:"
    xprintstr $ptr
  else
    xgetptr $tbl->extras[2]
    set $ptr = (struct Lisp_Char_Table *) $ptr
    xgetptr $ptr->extras[1]
    set $ptr = (struct Lisp_String *) $ptr
    printf " Realized from:"
    xprintstr $ptr
  end
  echo \n
end

Kenichi Handa's avatar
Kenichi Handa committed
1126 1127
define xfont
  xgetptr $
1128
  set $size = (((struct Lisp_Vector *) $ptr)->header.size & 0x1FF)
Kenichi Handa's avatar
Kenichi Handa committed
1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142
  if $size == FONT_SPEC_MAX
    print (struct font_spec *) $ptr
  else
    if $size == FONT_ENTITY_MAX
      print (struct font_entity *) $ptr
    else
      print (struct font *) $ptr
    end
  end
end
document xfont
Print $ assuming it is a list font (font-spec, font-entity, or font-object).
end

Gerd Moellmann's avatar
Gerd Moellmann committed
1143
define xbacktrace
1144 1145 1146 1147
  set $bt = backtrace_top ()
  while backtrace_p ($bt)
    set $fun = backtrace_function ($bt)
    xgettype $fun
1148
    if $type == Lisp_Symbol
1149 1150
      xprintsym $fun
      printf " (0x%x)\n", backtrace_args ($bt)
1151
    else
1152
      xgetptr $fun
1153
      printf "0x%x ", $ptr
1154
      if $type == Lisp_Vectorlike
1155
	xgetptr $fun
1156
        set $size = ((struct Lisp_Vector *) $ptr)->header.size
1157
        if ($size & PSEUDOVECTOR_FLAG)
1158
	  output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
1159 1160 1161
	else
	  output $size & ~ARRAY_MARK_FLAG
	end
1162 1163 1164 1165 1166
      else
        printf "Lisp type %d", $type
      end
      echo \n
    end
1167
    set $bt = backtrace_next ($bt)
Gerd Moellmann's avatar
Gerd Moellmann committed
1168 1169 1170 1171
  end
end
document xbacktrace
  Print a backtrace of Lisp function calls from backtrace_list.
1172
  Set a breakpoint at Fsignal and call this to see from where
1173
  an error was signaled.
Gerd Moellmann's avatar
Gerd Moellmann committed
1174 1175
end

1176 1177
define xprintbytestr
  set $data = (char *) $arg0->data
1178
  set $bstrsize = ($arg0->size_byte < 0) ? ($arg0->size & ~ARRAY_MARK_FLAG) : $arg0->size_byte
1179
  printf "Bytecode: "
1180 1181 1182 1183 1184
  if $bstrsize > 0
    output/u ($arg0->size > 1000) ? 0 : ($data[0])@($bvsize)
  else
    printf ""
  end
1185 1186 1187 1188 1189 1190 1191 1192
end
document xprintbytestr
  Print a string of byte code.
end

define xwhichsymbols
  set $output_debug = print_output_debug_flag
  set print_output_debug_flag = 0
1193
  call safe_debug_print (which_symbols ($arg0, $arg1))
1194
  set print_output_debug_flag = $output_debug
Kim F. Storm's avatar
Kim F. Storm committed
1195
end
1196
document xwhichsymbols
1197
  Print symbols which references a given lisp object
Kim F. Storm's avatar
Kim F. Storm committed
1198
  either as its symbol value or symbol function.
1199 1200
  Call with two arguments: the lisp object and the
  maximum number of symbols referencing it to produce.
Kim F. Storm's avatar
Kim F. Storm committed
1201 1202
end

1203 1204
# Show Lisp backtrace after normal backtrace.
define hookpost-backtrace
1205 1206
  set $bt = backtrace_top ()
  if backtrace_p ($bt)
1207 1208 1209 1210 1211 1212
    echo \n
    echo Lisp Backtrace:\n
    xbacktrace
  end
end

Kim F. Storm's avatar
Kim F. Storm committed
1213 1214 1215 1216 1217 1218 1219 1220 1221 1222
# Flush display (X only)
define ff
  set x_flush (0)
end
document ff
Flush pending X window display updates to screen.
Works only when an inferior emacs is executing.
end


Jim Blandy's avatar
Jim Blandy committed
1223
set print pretty on
Jim Blandy's avatar
Jim Blandy committed
1224
set print sevenbit-strings
Jim Blandy's avatar
Jim Blandy committed
1225

Jim Blandy's avatar
Jim Blandy committed
1226
show environment DISPLAY
Richard M. Stallman's avatar
Richard M. Stallman committed
1227
show environment TERM
Jim Blandy's avatar
Jim Blandy committed
1228

1229
# When debugging, it is handy to be able to "return" from
1230 1231
# terminate_due_to_signal when an assertion failure is non-fatal.
break terminate_due_to_signal
1232

1233 1234 1235 1236 1237 1238
# x_error_quitter is defined only if defined_HAVE_X_WINDOWS.
# If we are running in synchronous mode, we want a chance to look
# around before Emacs exits.  Perhaps we should put the break
# somewhere else instead...
if defined_HAVE_X_WINDOWS
  break x_error_quitter
1239
end
1240 1241 1242 1243 1244 1245 1246 1247


# Put the Python code at the end of .gdbinit so that if GDB does not
# support Python, GDB will do all the above initializations before
# reporting an error.

python

Tom Tromey's avatar
Tom Tromey committed
1248 1249 1250 1251 1252 1253
# Python 3 compatibility.
try:
  long
except:
  long = int

1254 1255 1256 1257 1258 1259 1260 1261
# Omit pretty-printing in older (pre-7.3) GDBs that lack it.
if hasattr(gdb, 'printing'):

  class Emacs_Pretty_Printers (gdb.printing.RegexpCollectionPrettyPrinter):
    """A collection of pretty-printers.  This is like GDB's
       RegexpCollectionPrettyPrinter except when printing Lisp_Object."""
    def __call__ (self, val):
      """Look up the pretty-printer for the provided value."""
1262
      type = val.type.unqualified ()
1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281
      typename = type.tag or type.name
      basic_type = gdb.types.get_basic_type (type)
      basic_typename = basic_type.tag or basic_type.name
      for printer in self.subprinters:
        if (printer.enabled
            and ((printer.regexp == '^Lisp_Object$'
                  and typename == 'Lisp_Object')
                 or (basic_typename
                     and printer.compiled_re.search (basic_typename)))):
          return printer.gen_printer (val)
      return None

  class Lisp_Object_Printer:
    "A printer for Lisp_Object values."
    def __init__ (self, val):
      self.val = val

    def to_string (self):
      "Yield a string that can be fed back into GDB."
1282 1283 1284

      # This implementation should work regardless of C compiler, and
      # it should not attempt to run any code in the inferior.
Paul Eggert's avatar
Paul Eggert committed
1285 1286 1287 1288 1289

      # If the macros EMACS_INT_WIDTH and USE_LSB_TAG are not in the
      # symbol table, guess reasonable defaults.
      sym = gdb.lookup_symbol ("EMACS_INT_WIDTH")[0]
      if sym:
Tom Tromey's avatar
Tom Tromey committed
1290
        EMACS_INT_WIDTH = long (sym.value ())
Paul Eggert's avatar
Paul Eggert committed
1291 1292 1293 1294 1295
      else:
        sym = gdb.lookup_symbol ("EMACS_INT")[0]
        EMACS_INT_WIDTH = 8 * sym.type.sizeof
      sym = gdb.lookup_symbol ("USE_LSB_TAG")[0]
      if sym:
Tom Tromey's avatar
Tom Tromey committed
1296
        USE_LSB_TAG = long (sym.value ())
Paul Eggert's avatar
Paul Eggert committed
1297 1298 1299
      else:
        USE_LSB_TAG = 1

1300 1301 1302 1303 1304
      GCTYPEBITS = 3
      VALBITS = EMACS_INT_WIDTH - GCTYPEBITS
      Lisp_Int0 = 2
      Lisp_Int1 = 6 if USE_LSB_TAG else 3

1305 1306
      val = self.val
      basic_type = gdb.types.get_basic_type (val.type)
1307 1308

      # Unpack VAL from its containing structure, if necessary.
1309 1310 1311
      if (basic_type.code == gdb.TYPE_CODE_STRUCT
          and gdb.types.has_field (basic_type, "i")):
        val = val["i"]
1312

1313 1314 1315 1316
      # Convert VAL to a Python integer.  Convert by hand, as this is
      # simpler and works regardless of whether VAL is a pointer or
      # integer.  Also, val.cast (gdb.lookup.type ("EMACS_UINT"))
      # would have problems with GDB 7.12.1; see
Paul Eggert's avatar
Paul Eggert committed
1317
      # <https://patchwork.sourceware.org/patch/11557/>
Tom Tromey's avatar
Tom Tromey committed
1318
      ival = long (val)
1319

1320
      # For nil, yield "XIL(0)", which is easier to read than "XIL(0x0)".
1321
      if not ival:
1322 1323 1324 1325 1326 1327
        return "XIL(0)"

      # Extract the integer representation of the value and its Lisp type.
      itype = ival >> (0 if USE_LSB_TAG else VALBITS)
      itype = itype & ((1 << GCTYPEBITS) - 1)

1328
      # For a Lisp fixnum N, yield "make_fixnum(N)".
1329 1330 1331
      if itype == Lisp_Int0 or itype == Lisp_Int1:
        if USE_LSB_TAG:
          ival = ival >> (GCTYPEBITS - 1)
1332
        if (ival >> VALBITS) & 1:
1333 1334 1335
          ival = ival | (-1 << VALBITS)
        else:
          ival = ival & ((1 << VALBITS) - 1)
1336
        return "make_fixnum(%d)" % ival
1337 1338 1339 1340 1341 1342

      # For non-integers other than nil yield "XIL(N)", where N is a C integer.
      # This helps humans distinguish Lisp_Object values from ordinary
      # integers even when Lisp_Object is an integer.
      # Perhaps some day the pretty-printing could be fancier.
      # Prefer the unsigned representation to negative values, converting
1343
      # by hand as val.cast does not work in GDB 7.12.1 as noted above.
1344 1345 1346
      if ival < 0:
        ival = ival + (1 << EMACS_INT_WIDTH)
      return "XIL(0x%x)" % ival
1347 1348 1349 1350 1351 1352 1353 1354 1355

  def build_pretty_printer ():
    pp = Emacs_Pretty_Printers ("Emacs")
    pp.add_printer ('Lisp_Object', '^Lisp_Object$', Lisp_Object_Printer)
    return pp

  gdb.printing.register_pretty_printer (gdb.current_objfile (),
                                        build_pretty_printer (), True)
end
1356 1357 1358 1359 1360

# GDB mishandles indentation with leading tabs when feeding it to Python.
# Local Variables:
# indent-tabs-mode: nil
# End: