Commit | Line | Data |
---|---|---|
41a6d712 SM |
1 | # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001 |
2 | # 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., 59 Temple Place - Suite 330, | |
19 | # Boston, MA 02111-1307, 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 | # Don't pass SIGALRM to Emacs. This makes problems when | |
35 | # debugging. | |
36 | handle SIGALRM ignore | |
37 | ||
38 | # Set up a mask to use. | |
39 | # This should be EMACS_INT, but in some cases that is a macro. | |
40 | # long ought to work in all cases right now. | |
41 | set $valmask = ((long)1 << gdb_valbits) - 1 | |
42 | set $nonvalbits = gdb_emacs_intbits - gdb_valbits | |
43 | ||
44 | # Set up something to print out s-expressions. | |
45 | define pr | |
46 | set debug_print ($) | |
47 | end | |
48 | document pr | |
49 | Print the emacs s-expression which is $. | |
50 | Works only when an inferior emacs is executing. | |
51 | end | |
52 | ||
53 | define xtype | |
54 | output (enum Lisp_Type) (($.i >> gdb_valbits) & 0x7) | |
55 | echo \n | |
56 | 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) | |
57 | echo \n | |
58 | end | |
59 | document xtype | |
60 | Print the type of $, assuming it is an Emacs Lisp value. | |
61 | If the first type printed is Lisp_Vector or Lisp_Misc, | |
62 | the second line gives the more precise type. | |
63 | Otherwise the second line doesn't mean anything. | |
64 | end | |
65 | ||
66 | define xvectype | |
67 | set $size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size | |
68 | output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) | |
69 | echo \n | |
70 | end | |
71 | document xvectype | |
72 | Print the vector subtype of $, assuming it is a vector or pseudovector. | |
73 | end | |
74 | ||
75 | define xmisctype | |
76 | output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) | |
77 | echo \n | |
78 | end | |
79 | document xmisctype | |
80 | Print the specific type of $, assuming it is some misc type. | |
81 | end | |
82 | ||
83 | define xint | |
84 | print (($.i & $valmask) << $nonvalbits) >> $nonvalbits | |
85 | end | |
86 | document xint | |
87 | Print $, assuming it is an Emacs Lisp integer. This gets the sign right. | |
88 | end | |
89 | ||
90 | define xptr | |
91 | print (void *) (($.i & $valmask) | gdb_data_seg_bits) | |
92 | end | |
93 | document xptr | |
94 | Print the pointer portion of $, assuming it is an Emacs Lisp value. | |
95 | end | |
96 | ||
97 | define xmarker | |
98 | print (struct Lisp_Marker *) (($.i & $valmask) | gdb_data_seg_bits) | |
99 | end | |
100 | document xmarker | |
101 | Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. | |
102 | end | |
103 | ||
104 | define xoverlay | |
105 | print (struct Lisp_Overlay *) (($.i & $valmask) | gdb_data_seg_bits) | |
106 | end | |
107 | document xoverlay | |
108 | Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. | |
109 | end | |
110 | ||
111 | define xmiscfree | |
112 | print (struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits) | |
113 | end | |
114 | document xmiscfree | |
115 | Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. | |
116 | end | |
117 | ||
118 | define xintfwd | |
119 | print (struct Lisp_Intfwd *) (($.i & $valmask) | gdb_data_seg_bits) | |
120 | end | |
121 | document xintfwd | |
122 | Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. | |
123 | end | |
124 | ||
125 | define xboolfwd | |
126 | print (struct Lisp_Boolfwd *) (($.i & $valmask) | gdb_data_seg_bits) | |
127 | end | |
128 | document xboolfwd | |
129 | Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. | |
130 | end | |
131 | ||
132 | define xobjfwd | |
133 | print (struct Lisp_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) | |
134 | end | |
135 | document xobjfwd | |
136 | Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. | |
137 | end | |
138 | ||
139 | define xbufobjfwd | |
140 | print (struct Lisp_Buffer_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) | |
141 | end | |
142 | document xbufobjfwd | |
143 | Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. | |
144 | end | |
145 | ||
146 | define xkbobjfwd | |
147 | print (struct Lisp_Kboard_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) | |
148 | end | |
149 | document xkbobjfwd | |
150 | Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. | |
151 | end | |
152 | ||
153 | define xbuflocal | |
154 | print (struct Lisp_Buffer_Local_Value *) (($.i & $valmask) | gdb_data_seg_bits) | |
155 | end | |
156 | document xbuflocal | |
157 | Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. | |
158 | end | |
159 | ||
160 | define xsymbol | |
161 | print (struct Lisp_Symbol *) (($.i & $valmask) | gdb_data_seg_bits) | |
162 | xprintsymptr $ | |
163 | end | |
164 | document xsymbol | |
165 | Print the name and address of the symbol $. | |
166 | This command assumes that $ is an Emacs Lisp symbol value. | |
167 | end | |
168 | ||
169 | define xstring | |
170 | print (struct Lisp_String *) (($.i & $valmask) | gdb_data_seg_bits) | |
171 | output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) | |
172 | echo \n | |
173 | end | |
174 | document xstring | |
175 | Print the contents and address of the string $. | |
176 | This command assumes that $ is an Emacs Lisp string value. | |
177 | end | |
178 | ||
179 | define xvector | |
180 | print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) | |
181 | output ($->size > 50) ? 0 : ($->contents[0])@($->size) | |
182 | echo \n | |
183 | end | |
184 | document xvector | |
185 | Print the contents and address of the vector $. | |
186 | This command assumes that $ is an Emacs Lisp vector value. | |
187 | end | |
188 | ||
189 | define xprocess | |
190 | print (struct Lisp_Process *) (($.i & $valmask) | gdb_data_seg_bits) | |
191 | output *$ | |
192 | echo \n | |
193 | end | |
194 | document xprocess | |
195 | Print the address of the struct Lisp_process which the Lisp_Object $ points to. | |
196 | end | |
197 | ||
198 | define xframe | |
199 | print (struct frame *) (($.i & $valmask) | gdb_data_seg_bits) | |
200 | end | |
201 | document xframe | |
202 | Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. | |
203 | end | |
204 | ||
205 | define xcompiled | |
206 | print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) | |
207 | output ($->contents[0])@($->size & 0xff) | |
208 | end | |
209 | document xcompiled | |
210 | Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. | |
211 | end | |
212 | ||
213 | define xwindow | |
214 | print (struct window *) (($.i & $valmask) | gdb_data_seg_bits) | |
215 | printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top | |
216 | end | |
217 | document xwindow | |
218 | Print $ as a window pointer, assuming it is an Emacs Lisp window value. | |
219 | Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". | |
220 | end | |
221 | ||
222 | define xwinconfig | |
223 | print (struct save_window_data *) (($.i & $valmask) | gdb_data_seg_bits) | |
224 | end | |
225 | document xwinconfig | |
226 | Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. | |
227 | end | |
228 | ||
229 | define xsubr | |
230 | print (struct Lisp_Subr *) (($.i & $valmask) | gdb_data_seg_bits) | |
231 | output *$ | |
232 | echo \n | |
233 | end | |
234 | document xsubr | |
235 | Print the address of the subr which the Lisp_Object $ points to. | |
236 | end | |
237 | ||
238 | define xchartable | |
239 | print (struct Lisp_Char_Table *) (($.i & $valmask) | gdb_data_seg_bits) | |
240 | printf "Purpose: " | |
241 | output (char*)&((struct Lisp_Symbol *) (($->purpose.i & $valmask) | gdb_data_seg_bits))->name->data | |
242 | printf " %d extra slots", ($->size & 0x1ff) - 388 | |
243 | echo \n | |
244 | end | |
245 | document xchartable | |
246 | Print the address of the char-table $, and its purpose. | |
247 | This command assumes that $ is an Emacs Lisp char-table value. | |
248 | end | |
249 | ||
250 | define xboolvector | |
251 | print (struct Lisp_Bool_Vector *) (($.i & $valmask) | gdb_data_seg_bits) | |
252 | output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) | |
253 | echo \n | |
254 | end | |
255 | document xboolvector | |
256 | Print the contents and address of the bool-vector $. | |
257 | This command assumes that $ is an Emacs Lisp bool-vector value. | |
258 | end | |
259 | ||
260 | define xbuffer | |
261 | print (struct buffer *) (($.i & $valmask) | gdb_data_seg_bits) | |
262 | output ((struct Lisp_String *) (($->name.i & $valmask) | gdb_data_seg_bits))->data | |
263 | echo \n | |
264 | end | |
265 | document xbuffer | |
266 | Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. | |
267 | Print the name of the buffer. | |
268 | end | |
269 | ||
270 | define xhashtable | |
271 | print (struct Lisp_Hash_Table *) (($.i & $valmask) | gdb_data_seg_bits) | |
272 | end | |
273 | document xhashtable | |
274 | Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. | |
275 | end | |
276 | ||
277 | define xcons | |
278 | print (struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits) | |
279 | output/x *$ | |
280 | echo \n | |
281 | end | |
282 | document xcons | |
283 | Print the contents of $, assuming it is an Emacs Lisp cons. | |
284 | end | |
285 | ||
286 | define nextcons | |
287 | p $.cdr | |
288 | xcons | |
289 | end | |
290 | document nextcons | |
291 | Print the contents of the next cell in a list. | |
292 | This assumes that the last thing you printed was a cons cell contents | |
293 | (type struct Lisp_Cons) or a pointer to one. | |
294 | end | |
295 | ||
296 | define xcar | |
297 | print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->car : 0) | |
298 | end | |
299 | document xcar | |
300 | Print the car of $, assuming it is an Emacs Lisp pair. | |
301 | end | |
302 | ||
303 | define xcdr | |
304 | print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->cdr : 0) | |
305 | end | |
306 | document xcdr | |
307 | Print the cdr of $, assuming it is an Emacs Lisp pair. | |
308 | end | |
309 | ||
310 | define xfloat | |
311 | print ((struct Lisp_Float *) (($.i & $valmask) | gdb_data_seg_bits))->data | |
312 | end | |
313 | document xfloat | |
314 | Print $ assuming it is a lisp floating-point number. | |
315 | end | |
316 | ||
317 | define xscrollbar | |
318 | print (struct scrollbar *) (($.i & $valmask) | gdb_data_seg_bits) | |
319 | output *$ | |
320 | echo \n | |
321 | end | |
322 | document xscrollbar | |
323 | Print $ as a scrollbar pointer. | |
324 | end | |
325 | ||
326 | define xprintsym | |
327 | set $sym = ((struct Lisp_Symbol *) (($arg0.i & $valmask) | gdb_data_seg_bits)) | |
328 | xprintsymptr $sym | |
329 | end | |
330 | document xprintsym | |
331 | Print argument as a symbol. | |
332 | end | |
333 | define xprintsymptr | |
334 | set $sym = $arg0 | |
335 | set $sym_name = ((struct Lisp_String *)(($sym->xname.i & $valmask) | gdb_data_seg_bits)) | |
336 | output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) | |
337 | echo \n | |
338 | end | |
339 | ||
340 | define xbacktrace | |
341 | set $bt = backtrace_list | |
342 | while $bt | |
343 | set $type = (enum Lisp_Type) (((*$bt->function).i >> gdb_valbits) & 0x7) | |
344 | if $type == Lisp_Symbol | |
345 | xprintsym (*$bt->function) | |
346 | else | |
347 | printf "0x%x ", (*$bt->function).i | |
348 | if $type == Lisp_Vectorlike | |
349 | set $size = ((struct Lisp_Vector *) (((*$bt->function).i & $valmask) | gdb_data_seg_bits))->size | |
350 | output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) | |
351 | else | |
352 | printf "Lisp type %d", $type | |
353 | end | |
354 | echo \n | |
355 | end | |
356 | set $bt = $bt->next | |
357 | end | |
358 | end | |
359 | document xbacktrace | |
360 | Print a backtrace of Lisp function calls from backtrace_list. | |
361 | Set a breakpoint at Fsignal and call this to see from where | |
362 | an error was signaled. | |
363 | end | |
364 | ||
365 | define xreload | |
366 | set $valmask = ((long)1 << gdb_valbits) - 1 | |
367 | set $nonvalbits = gdb_emacs_intbits - gdb_valbits | |
368 | end | |
369 | document xreload | |
370 | When starting Emacs a second time in the same gdb session under | |
371 | FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost | |
372 | their values. (The same happens on current (2000) versions of GNU/Linux | |
373 | with gdb 5.0.) | |
374 | This function reloads them. | |
375 | end | |
376 | ||
377 | define hook-run | |
378 | xreload | |
379 | end | |
380 | ||
381 | # Call xreload if a new Emacs executable is loaded. | |
382 | define hookpost-run | |
383 | xreload | |
384 | end | |
385 | ||
386 | set print pretty on | |
387 | set print sevenbit-strings | |
388 | ||
389 | # show environment DISPLAY | |
390 | # show environment TERM | |
391 | # set args -geometry 80x40+0+0 | |
392 | ||
393 | # Don't let abort actually run, as it will make | |
394 | # stdio stop working and therefore the `pr' command above as well. | |
395 | # break abort | |
396 | ||
397 | # If we are running in synchronous mode, we want a chance to look around | |
398 | # before Emacs exits. Perhaps we should put the break somewhere else | |
399 | # instead... | |
400 | # break x_error_quitter | |
ab5796a9 MB |
401 | |
402 | # arch-tag: 08f4d20d-0254-4374-a80c-179d5a517915 |