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
|
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001
# 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
# Set up a mask to use.
# This should be EMACS_INT, but in some cases that is a macro.
# long ought to work in all cases right now.
set $valmask = ((long)1 << gdb_valbits) - 1
set $nonvalbits = gdb_emacs_intbits - gdb_valbits
# 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
define xtype
output (enum Lisp_Type) (($.i >> gdb_valbits) & 0x7)
echo \n
output ((($.i >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) : (($.i >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0)
echo \n
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,
the second line gives the more precise type.
Otherwise the second line doesn't mean anything.
end
define xvectype
set $size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size
output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)
echo \n
end
document xvectype
Print the vector subtype of $, assuming it is a vector or pseudovector.
end
define xmisctype
output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type)
echo \n
end
document xmisctype
Print the specific type of $, assuming it is some misc type.
end
define xint
print (($.i & $valmask) << $nonvalbits) >> $nonvalbits
end
document xint
Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
end
define xptr
print (void *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xptr
Print the pointer portion of $, assuming it is an Emacs Lisp value.
end
define xmarker
print (struct Lisp_Marker *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xmarker
Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
end
define xoverlay
print (struct Lisp_Overlay *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xoverlay
Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
end
define xmiscfree
print (struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xmiscfree
Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
end
define xintfwd
print (struct Lisp_Intfwd *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xintfwd
Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xboolfwd
print (struct Lisp_Boolfwd *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xboolfwd
Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xobjfwd
print (struct Lisp_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xobjfwd
Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xbufobjfwd
print (struct Lisp_Buffer_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xbufobjfwd
Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xkbobjfwd
print (struct Lisp_Kboard_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xkbobjfwd
Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
end
define xbuflocal
print (struct Lisp_Buffer_Local_Value *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xbuflocal
Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
end
define xsymbol
print (struct Lisp_Symbol *) (($.i & $valmask) | gdb_data_seg_bits)
xprintsymptr $
end
document xsymbol
Print the name and address of the symbol $.
This command assumes that $ is an Emacs Lisp symbol value.
end
define xstring
print (struct Lisp_String *) (($.i & $valmask) | gdb_data_seg_bits)
output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte)
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
print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
output ($->size > 50) ? 0 : ($->contents[0])@($->size)
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
print (struct Lisp_Process *) (($.i & $valmask) | gdb_data_seg_bits)
output *$
echo \n
end
document xprocess
Print the address of the struct Lisp_process which the Lisp_Object $ points to.
end
define xframe
print (struct frame *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xframe
Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
end
define xcompiled
print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
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
print (struct window *) (($.i & $valmask) | gdb_data_seg_bits)
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
print (struct save_window_data *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xwinconfig
Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
end
define xsubr
print (struct Lisp_Subr *) (($.i & $valmask) | gdb_data_seg_bits)
output *$
echo \n
end
document xsubr
Print the address of the subr which the Lisp_Object $ points to.
end
define xchartable
print (struct Lisp_Char_Table *) (($.i & $valmask) | gdb_data_seg_bits)
printf "Purpose: "
output (char*)&((struct Lisp_Symbol *) (($->purpose.i & $valmask) | gdb_data_seg_bits))->name->data
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
print (struct Lisp_Bool_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
output ($->size > 256) ? 0 : ($->data[0])@(($->size + 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
print (struct buffer *) (($.i & $valmask) | gdb_data_seg_bits)
output ((struct Lisp_String *) (($->name.i & $valmask) | gdb_data_seg_bits))->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
print (struct Lisp_Hash_Table *) (($.i & $valmask) | gdb_data_seg_bits)
end
document xhashtable
Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
end
define xcons
print (struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits)
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
print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->car : 0)
end
document xcar
Print the car of $, assuming it is an Emacs Lisp pair.
end
define xcdr
print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->cdr : 0)
end
document xcdr
Print the cdr of $, assuming it is an Emacs Lisp pair.
end
define xfloat
print ((struct Lisp_Float *) (($.i & $valmask) | gdb_data_seg_bits))->data
end
document xfloat
Print $ assuming it is a lisp floating-point number.
end
define xscrollbar
print (struct scrollbar *) (($.i & $valmask) | gdb_data_seg_bits)
output *$
echo \n
end
document xscrollbar
Print $ as a scrollbar pointer.
end
define xprintsym
set $sym = ((struct Lisp_Symbol *) (($arg0.i & $valmask) | gdb_data_seg_bits))
xprintsymptr $sym
end
document xprintsym
Print argument as a symbol.
end
define xprintsymptr
set $sym = $arg0
set $sym_name = ((struct Lisp_String *)(($sym->xname.i & $valmask) | gdb_data_seg_bits))
output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte)
echo \n
end
define xbacktrace
set $bt = backtrace_list
while $bt
set $type = (enum Lisp_Type) (((*$bt->function).i >> gdb_valbits) & 0x7)
if $type == Lisp_Symbol
xprintsym (*$bt->function)
else
printf "0x%x ", (*$bt->function).i
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) (((*$bt->function).i & $valmask) | gdb_data_seg_bits))->size
output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)
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 $valmask = ((long)1 << gdb_valbits) - 1
set $nonvalbits = gdb_emacs_intbits - gdb_valbits
end
document xreload
When starting Emacs a second time in the same gdb session under
FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost
their values. (The same happens on current (2000) versions of GNU/Linux
with gdb 5.0.)
This function reloads them.
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
|