1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
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
153
154
155
156
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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
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
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
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
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
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
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
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
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
| | # Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004
# Free Software Foundation, Inc.
#
# 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
# the Free Software Foundation; either version 2, or (at your option)
# 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
# along with GNU Emacs; see the file COPYING. If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
# Force loading of symbols, enough to give us gdb_valbits etc.
set main
# Find lwlib source files too.
dir ../lwlib
#dir /gd/gnu/lesstif-0.89.9/lib/Xm
# 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
# Don't pass SIGALRM to Emacs. This makes problems when
# debugging.
handle SIGALRM ignore
# $valmask and $tagmask are mask values set up by the xreload macro below.
# Use $bugfix so that the value isn't a constant.
# Using a constant runs into GDB bugs sometimes.
define xgetptr
set $bugfix = $arg0
set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
end
define xgetint
set $bugfix = $arg0
set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
end
define xgettype
set $bugfix = $arg0
set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
end
# Set up something to print out s-expressions.
define pr
set debug_print ($)
end
document pr
Print the emacs s-expression which is $.
Works only when an inferior emacs is executing.
end
# Print out s-expressions
define pp
set $tmp = $arg0
set debug_print ($tmp)
end
document pp
Print the argument as an emacs s-expression
Works only when an inferior emacs is executing.
end
# 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
Print point, beg, end, narrow, and gap for current buffer.
end
# 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
printf " start=%d", $it->start.pos.charpos
if ($it->start.pos.charpos != $it->start.pos.bytepos)
printf "[%d]", $it->start.pos.bytepos
end
printf " stop=%d ", $it->stop_charpos
output $it->what
if ($it->what == IT_CHARACTER)
if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
printf "['%c']", $it->c
else
printf "[%d,%d]", $it->c, $it->len
end
end
printf " next="
output $it->method
printf "\n"
printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
printf " x=%d lvx=%d", $it->current_x, $it->last_visible_x
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"
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
printf " vis=%d", $row->visible_height
printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
printf "\n"
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
printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
end
document pcursorx
Pretty print a window cursor
end
define pcursor
printf "output: "
pcursorx output_cursor
printf "\n"
end
document pcursor
Pretty print the output_cursor
end
define pwinx
set $w = $arg0
xgetint $w->sequence_number
if ($w->mini_p != Qnil)
printf "Mini "
end
printf "Window %d ", $int
xgetptr $w->buffer
set $tem = (struct buffer *) $ptr
xgetptr $tem->name
printf "%s", ((struct Lisp_String *) $ptr)->data
printf "\n"
xgetptr $w->start
set $tem = (struct Lisp_Marker *) $ptr
printf "start=%d end:", $tem->charpos
if ($w->window_end_valid != Qnil)
xgetint $w->window_end_pos
printf "pos=%d", $int
xgetint $w->window_end_vpos
printf " vpos=%d", $int
else
printf "invalid"
end
printf " vscroll=%d", $w->vscroll
if ($w->force_start != Qnil)
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.
Takes one argument, a pointer to a window structure
end
define pwin
pwinx w
end
document pwin
Pretty print window structure w.
end
define xtype
xgettype $
output $type
echo \n
if $type == Lisp_Misc
xmisctype
else
if $type == Lisp_Vectorlike
xvectype
end
end
end
document xtype
Print the type of $, assuming it is an Emacs Lisp value.
If the first type printed is Lisp_Vector or Lisp_Misc,
a second line gives the more precise type.
end
define xvectype
xgetptr $
set $size = ((struct Lisp_Vector *) $ptr)->size
output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
echo \n
end
document xvectype
Print the size or vector subtype of $, assuming it is a vector or pseudovector.
end
define xmisctype
xgetptr $
output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
echo \n
end
document xmisctype
Print the specific type of $, assuming it is some misc type.
end
define xint
xgetint $
print $int
end
document xint
Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
end
define xptr
xgetptr $
print (void *) $ptr
end
document xptr
Print the pointer portion of $, assuming it is an Emacs Lisp value.
end
define xmarker
xgetptr $
print (struct Lisp_Marker *) $ptr
end
document xmarker
Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
end
define xoverlay
xgetptr $
print (struct Lisp_Overlay *) $ptr
end
document xoverlay
Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
end
define xmiscfree
xgetptr $
print (struct Lisp_Free *) $ptr
end
document xmiscfree
Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
end
define xintfwd
xgetptr $
print (struct Lisp_Intfwd *) $ptr
end
document xintfwd
Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xboolfwd
xgetptr $
print (struct Lisp_Boolfwd *) $ptr
end
document xboolfwd
Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xobjfwd
xgetptr $
print (struct Lisp_Objfwd *) $ptr
end
document xobjfwd
Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xbufobjfwd
xgetptr $
print (struct Lisp_Buffer_Objfwd *) $ptr
end
document xbufobjfwd
Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xkbobjfwd
xgetptr $
print (struct Lisp_Kboard_Objfwd *) $ptr
end
document xkbobjfwd
Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xbuflocal
xgetptr $
print (struct Lisp_Buffer_Local_Value *) $ptr
end
document xbuflocal
Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
end
define xsymbol
set $sym = $
xgetptr $sym
print (struct Lisp_Symbol *) $ptr
xprintsym $sym
echo \n
end
document xsymbol
Print the name and address of the symbol $.
This command assumes that $ is an Emacs Lisp symbol value.
end
define xstring
xgetptr $
print (struct Lisp_String *) $ptr
xprintstr $
echo \n
end
document xstring
Print the contents and address of the string $.
This command assumes that $ is an Emacs Lisp string value.
end
define xvector
xgetptr $
print (struct Lisp_Vector *) $ptr
output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
echo \n
end
document xvector
Print the contents and address of the vector $.
This command assumes that $ is an Emacs Lisp vector value.
end
define xprocess
xgetptr $
print (struct Lisp_Process *) $ptr
output *$
echo \n
end
document xprocess
Print the address of the struct Lisp_process which the Lisp_Object $ points to.
end
define xframe
xgetptr $
print (struct frame *) $ptr
end
document xframe
Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
end
define xcompiled
xgetptr $
print (struct Lisp_Vector *) $ptr
output ($->contents[0])@($->size & 0xff)
end
document xcompiled
Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
end
define xwindow
xgetptr $
print (struct window *) $ptr
printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
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
define xwinconfig
xgetptr $
print (struct save_window_data *) $ptr
end
document xwinconfig
Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
end
define xsubr
xgetptr $
print (struct Lisp_Subr *) $ptr
output *$
echo \n
end
document xsubr
Print the address of the subr which the Lisp_Object $ points to.
end
define xchartable
xgetptr $
print (struct Lisp_Char_Table *) $ptr
printf "Purpose: "
xprintsym $->purpose
printf " %d extra slots", ($->size & 0x1ff) - 388
echo \n
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
define xboolvector
xgetptr $
print (struct Lisp_Bool_Vector *) $ptr
output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
echo \n
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
xgetptr $
print (struct buffer *) $ptr
xgetptr $->name
output ((struct Lisp_String *) $ptr)->data
echo \n
end
document xbuffer
Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
Print the name of the buffer.
end
define xhashtable
xgetptr $
print (struct Lisp_Hash_Table *) $ptr
end
document xhashtable
Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
end
define xcons
xgetptr $
print (struct Lisp_Cons *) $ptr
output/x *$
echo \n
end
document xcons
Print the contents of $, assuming it is an Emacs Lisp cons.
end
define nextcons
p $.cdr
xcons
end
document nextcons
Print the contents of the next cell in a list.
This assumes that the last thing you printed was a cons cell contents
(type struct Lisp_Cons) or a pointer to one.
end
define xcar
xgetptr $
xgettype $
print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
end
document xcar
Print the car of $, assuming it is an Emacs Lisp pair.
end
define xcdr
xgetptr $
xgettype $
print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0)
end
document xcdr
Print the cdr of $, assuming it is an Emacs Lisp pair.
end
define xfloat
xgetptr $
print ((struct Lisp_Float *) $ptr)->data
end
document xfloat
Print $ assuming it is a lisp floating-point number.
end
define xscrollbar
xgetptr $
print (struct scrollbar *) $ptr
output *$
echo \n
end
document xscrollbar
Print $ as a scrollbar pointer.
end
define xprintstr
set $data = $arg0->data
output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
end
define xprintsym
xgetptr $arg0
set $sym = (struct Lisp_Symbol *) $ptr
xgetptr $sym->xname
set $sym_name = (struct Lisp_String *) $ptr
xprintstr $sym_name
end
document xprintsym
Print argument as a symbol.
end
define xbacktrace
set $bt = backtrace_list
while $bt
xgettype (*$bt->function)
if $type == Lisp_Symbol
xprintsym (*$bt->function)
echo \n
else
printf "0x%x ", *$bt->function
if $type == Lisp_Vectorlike
xgetptr (*$bt->function)
set $size = ((struct Lisp_Vector *) $ptr)->size
output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
else
printf "Lisp type %d", $type
end
echo \n
end
set $bt = $bt->next
end
end
document xbacktrace
Print a backtrace of Lisp function calls from backtrace_list.
Set a breakpoint at Fsignal and call this to see from where
an error was signaled.
end
define xreload
set $tagmask = (((long)1 << gdb_gctypebits) - 1)
set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
end
document xreload
When starting Emacs a second time in the same gdb session under
FreeBSD 2.2.5, gdb 4.13, $valmask have lost
their values. (The same happens on current (2000) versions of GNU/Linux
with gdb 5.0.)
This function reloads them.
end
xreload
# 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
define hook-run
xreload
end
# Call xreload if a new Emacs executable is loaded.
define hookpost-run
xreload
end
set print pretty on
set print sevenbit-strings
show environment DISPLAY
show environment TERM
set args -geometry 80x40+0+0
# Don't let abort actually run, as it will make
# stdio stop working and therefore the `pr' command above as well.
break abort
# 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...
break x_error_quitter
# arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe
|