comparison src/gdbinit @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 376386a54a3c
children 558f606b08ae
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
1 # Some useful commands for debugging emacs with gdb 4.14.* or better. 1 # -*- ksh -*-
2 # Install this as your .gdbinit file in your home directory. 2 # Copyright (C) 1998 Free Software Foundation, Inc.
3 # If you have an older version of gdb 4.x, consider using the 3
4 # file "gdbinit.pre-4.14" in the XEmacs src directory. 4 # This file is part of XEmacs.
5 # If you're one of the few who has an XEmacs compiled with 5
6 # --use-union-type, you'll need to use the file "gdbinit.union". 6 # XEmacs is free software; you can redistribute it and/or modify it
7 # Currently that file is of the pre-4.14 variety, but it should 7 # under the terms of the GNU General Public License as published by the
8 # be easy to update it to 4.14+, along the same lines as this file. 8 # Free Software Foundation; either version 2, or (at your option) any
9 # later version.
10
11 # XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 # for more details.
15
16 # You should have received a copy of the GNU General Public License
17 # along with XEmacs; see the file COPYING. If not, write to
18 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 # Boston, MA 02111-1307, USA.
20
21 # Author: Martin Buchholz
22
23 # Some useful commands for debugging emacs with gdb 4.16 or better.
24 # Install this as your .gdbinit file in your home directory,
25 # or source this file from your .gdbinit
26 # Configure xemacs with --debug, and compile with -g.
9 # 27 #
10 # See also question 2.1.15 of the XEmacs FAQ, titled 28 # See also the question of the XEmacs FAQ, titled
11 # "How to Debug an XEmacs problem with a debugger". 29 # "How to Debug an XEmacs problem with a debugger".
30 #
31 # This can be used to debug XEmacs no matter how the following are
32 # specified:
33
34 # USE_UNION_TYPE
35 # USE_MINIMAL_TAGBITS
36 # USE_INDEXED_LRECORD_IMPLEMENTATION
37 # LRECORD_(SYMBOL|STRING|VECTOR)
38
39 # (the above all have configure equivalents)
40
41 # Some functions defined here require a running process, but most
42 # don't. Considerable effort has been expended to this end.
43
44 # See the dbg_ C support code in src/alloc.c that allows the functions
45 # defined in this file to work correctly.
12 46
13 set print union off 47 set print union off
14 set print pretty off 48 set print pretty off
15 49
16 define temacs 50 define decode_object
17 run -batch -l loadup.el run-temacs -q 51 set $obj = (unsigned long) $arg0
18 end 52 if dbg_USE_MINIMAL_TAGBITS
19 53 if $obj & 1
20 echo \n>>> Use the `temacs' command to run temacs\n\n 54 # It's an int
55 set $val = $obj >> 1
56 set $type = dbg_Lisp_Type_Int
57 else
58 set $type = $obj & dbg_typemask
59 if $type == dbg_Lisp_Type_Char
60 set $val = ($obj & dbg_valmask) >> dbg_gctypebits
61 else
62 # It's a record pointer
63 set $val = $obj
64 end
65 end
66 else
67 # not dbg_USE_MINIMAL_TAGBITS
68 set $val = $obj & dbg_valmask
69 set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1)
70 end
71
72 if $type == dbg_Lisp_Type_Record
73 set $lheader = (struct lrecord_header *) $val
74 if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
75 set $imp = lrecord_implementations_table[$lheader->type]
76 else
77 set $imp = $lheader->implementation
78 end
79 else
80 set $imp = -1
81 end
82 end
83
84 document decode_object
85 Usage: decode_object lisp_object
86 Extract implementation information from a Lisp Object.
87 Defines variables $val, $type and $imp.
88 end
89
90 define xint
91 decode_object $arg0
92 print ((long) $val)
93 end
94
95 define xtype
96 decode_object $arg0
97 if $type == dbg_Lisp_Type_Int
98 echo int\n
99 else
100 if $type == dbg_Lisp_Type_Char
101 echo char\n
102 else
103 if $type == dbg_Lisp_Type_Symbol
104 echo symbol\n
105 else
106 if $type == dbg_Lisp_Type_String
107 echo string\n
108 else
109 if $type == dbg_Lisp_Type_Vector
110 echo vector\n
111 else
112 if $type == dbg_Lisp_Type_Cons
113 echo cons\n
114 else
115 printf "record type: %s\n", $imp->name
116 # barf
117 end
118 end
119 end
120 end
121 end
122 end
123 end
124
125 define run-temacs
126 run -batch -l loadup.el run-temacs -q
127 end
128
129 document run-temacs
130 Usage: run-temacs
131 Run temacs interactively, like xemacs.
132 Use this with debugging tools (like purify) that cannot deal with dumping,
133 or when temacs builds successfully, but xemacs does not.
134 end
135
136 define update-elc
137 set env EMACSLOADPATH=../lisp/
138 set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
139 run -batch -l update-elc.el
140 end
141
142 document update-elc
143 Usage: update-elc
144 Run the elc compilation part of the build procedure.
145 Use when debugging temacs, not xemacs!
146 Use this when temacs builds successfully, but xemacs does not.
147 end
148
149 define dump-temacs
150 set env EMACSLOADPATH=../lisp/:..
151 run -batch -l loadup.el dump
152 end
153
154 document dump-temacs
155 Usage: dump-temacs
156 Run the dumping part of the build procedure.
157 Use when debugging temacs, not xemacs!
158 Use this when temacs builds successfully, but xemacs does not.
159 end
21 160
22 # if you use Purify, do this: 161 # if you use Purify, do this:
23 # set env PURIFYOPTIONS -pointer-mask=0x0fffffff 162 # export PURIFYOPTIONS='-pointer-mask=0x0fffffff'
24 163
25 ################ Print using the Lisp printer 164 define ldp
26 165 printf "%s", "Lisp => "
27 define p1 166 call debug_print($arg0)
28 call debug_print ($arg0) 167 end
29 printf "\n" 168
169 document ldp
170 Usage: ldp lisp_object
171 Print a Lisp Object value using the Lisp printer.
172 Requires a running xemacs process.
30 end 173 end
31 174
32 define lbt 175 define lbt
33 # "&" to compensate for GDB struct-passing bug 176 call debug_backtrace()
34 # but I've removed the &'s because it doesn't work with my GDB, 177 end
35 # and not having them works fine. 178
36 call Fbacktrace (Qexternal_debugging_output, Qt) 179 document lbt
37 end 180 Usage: lbt
38 181 Print the current Lisp stack trace.
39 ################ Print using GDB built-ins 182 Requires a running xemacs process.
40
41 define xint
42 print ((int)($arg0 << 4))>>4
43 end
44
45 define xbitvec
46 print (struct Lisp_Bit_Vector *) ($arg0 & 0xFFFFFFF)
47 end
48
49 define xbuffer
50 print (struct buffer *) ($arg0 & 0xFFFFFFF)
51 end
52
53 define xbytecode
54 print (struct Lisp_Bytecode *) ($arg0 & 0xFFFFFFF)
55 end
56
57 define xcharset
58 print (struct Lisp_Charset *) ($arg0 & 0xFFFFFFF)
59 end
60
61 define xchartab
62 print (struct Lisp_Char_Table *) ($arg0 & 0xFFFFFFF)
63 end
64
65 define xchartabentry
66 print (struct Lisp_Char_Table_Entry *) ($arg0 & 0xFFFFFFF)
67 end
68
69 define xcodesys
70 print (struct Lisp_Coding_System *) ($arg0 & 0xFFFFFFF)
71 end
72
73 define xcolorinst
74 print (struct Lisp_Color_Instance *) ($arg0 & 0xFFFFFFF)
75 end
76
77 define xcons
78 print (struct Lisp_Cons *) ($arg0 & 0xFFFFFFF)
79 end
80
81 define xdevice
82 print (struct device *) ($arg0 & 0xFFFFFFF)
83 end
84
85 define xevent
86 print (struct Lisp_Event *) ($arg0 & 0xFFFFFFF)
87 end
88
89 define xextent
90 print (struct extent *) ($arg0 & 0xFFFFFFF)
91 end
92
93 define xextentaux
94 print (struct extent_auxiliary *) ($arg0 & 0xFFFFFFF)
95 end
96
97 define xextentinfo
98 print (struct extent_info *) ($arg0 & 0xFFFFFFF)
99 end
100
101 define xfloat
102 print (struct Lisp_Float *) ($arg0 & 0xFFFFFFF)
103 output (double) $arg0->data.d
104 echo \n
105 end
106
107 define xfontinst
108 print (struct Lisp_Font_Instance *) ($arg0 & 0xFFFFFFF)
109 end
110
111 define xframe
112 print (struct frame *) ($arg0 & 0xFFFFFFF)
113 end
114
115 define xglyph
116 print (struct Lisp_Glyph *) ($arg0 & 0xFFFFFFF)
117 end
118
119 define xhashtable
120 print (struct hashtable_struct *) ($arg0 & 0xFFFFFFF)
121 end
122
123 define ximageinst
124 print (struct Lisp_Image_Instance *) ($arg0 & 0xFFFFFFF)
125 end
126
127 define xkeymap
128 print (struct keymap *) ($arg0 & 0xFFFFFFF)
129 end
130
131 define xlstream
132 print (struct lstream *) ($arg0 & 0xFFFFFFF)
133 end
134
135 define xmarker
136 print (struct Lisp_Marker *) ($arg0 & 0xFFFFFFF)
137 end
138
139 define xmenubardata
140 print (struct menubar_data *) ($arg0 & 0xFFFFFFF)
141 end
142
143 define xopaque
144 print (struct Lisp_Opaque *) ($arg0 & 0xFFFFFFF)
145 end
146
147 define xprocess
148 print (struct Lisp_Process *) ($arg0 & 0xFFFFFFF)
149 end
150
151 define xrangetab
152 print (struct Lisp_Range_Table *) ($arg0 & 0xFFFFFFF)
153 end
154
155 define xspec
156 print (struct Lisp_Specifier *) ($arg0 & 0xFFFFFFF)
157 end
158
159 define xstring
160 print (struct Lisp_String *) ($arg0 & 0xFFFFFFF)
161 output (char *) $arg0->_data
162 echo \n
163 end
164
165 define xsubr
166 print (struct Lisp_Subr *) ($arg0 & 0xFFFFFFF)
167 end
168
169 define xsubwindow
170 print (struct Lisp_Subwindow *) ($arg0 & 0xFFFFFFF)
171 end
172
173 define xsymbol
174 set $tem = (struct Lisp_Symbol *) ($arg0 & 0xFFFFFFF)
175 output $tem->name->_data
176 printf "\n"
177 print $tem
178 end
179
180 define xtoolbarbutton
181 print (struct toolbar_button *) ($arg0 & 0xFFFFFFF)
182 end
183
184 define xtoolbardata
185 print (struct toolbar_data *) ($arg0 & 0xFFFFFFF)
186 end
187
188 define xtooltalkmess
189 print (struct Lisp_Tooltalk_Message *) ($arg0 & 0xFFFFFFF)
190 end
191
192 define xtooltalkpatt
193 print (struct Lisp_Tooltalk_Pattern *) ($arg0 & 0xFFFFFFF)
194 end
195
196 define xvector
197 print (struct Lisp_Vector *) ($arg0 & 0xFFFFFFF)
198 end
199
200 define xwindow
201 print (struct window *) ($arg0 & 0xFFFFFFF)
202 end
203
204 define xwindowconfig
205 print (struct window_config *) ($arg0 & 0xFFFFFFF)
206 end
207
208 define xrecord
209 print ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))
210 output (((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation->name)
211 echo \n
212 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_symbol
213 xsymbol $arg0
214 else
215 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_extent
216 xextent $arg0
217 else
218 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_marker
219 xmarker $arg0
220 else
221 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_event
222 xevent $arg0
223 else
224 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_buffer
225 xbuffer $arg0
226 else
227 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_window
228 xwindow $arg0
229 else
230 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_frame
231 xframe $arg0
232 else
233 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_device
234 xdevice $arg0
235 else
236 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_console
237 xconsole $arg0
238 else
239 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_process
240 xprocess $arg0
241 else
242 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_subr
243 xsubr $arg0
244 else
245 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_compiled_function
246 xbytecode $arg0
247 else
248 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_window_configuration
249 xwindowconfig $arg0
250 else
251 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_float
252 xfloat $arg0
253 else
254 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_opaque
255 xopaque $arg0
256 else
257 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_glyph
258 xglyph $arg0
259 else
260 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_keymap
261 xkeymap $arg0
262 else
263 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_lstream
264 xlstream $arg0
265 else
266 if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_bit_vector
267 xbitvec $arg0
268 end
269 end
270 end
271 end
272 end
273 end
274 end
275 end
276 end
277 end
278 end
279 end
280 end
281 end
282 end
283 end
284 end
285 end
286 end
287 end
288
289 define frob
290 if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Int
291 xint $arg0
292 else
293 if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_String
294 xstring $arg0
295 else
296 if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Cons
297 xcons $arg0
298 else
299 if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Vector
300 xvector $arg0
301 else
302 if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Record
303 xrecord $arg0
304 else
305 printf "Unknown type?\n"
306 end
307 end
308 end
309 end
310 end
311 end
312
313 ################ Miscellaneous
314
315 define xtype
316 # this is really xgctype, as we mask off the mark bit
317 output (enum Lisp_Type) (($arg0 >> 28) & 7)
318 echo \n
319 end
320
321 define xmarkbit
322 print ($arg0 >> 31)
323 end
324
325 define nilp
326 print $arg0 == Qnil
327 end
328
329 define xcar
330 frob ((struct Lisp_Cons *) ($arg0 & 0xFFFFFFF))->car
331 end
332
333 define xcdr
334 frob ((struct Lisp_Cons *) ($arg0 & 0xFFFFFFF))->cdr
335 end
336
337 set $vector_length_mask = ~(1<<31)
338
339 define string-length
340 print ((struct Lisp_String *) ($arg0 & 0xFFFFFFF))->_size & $vector_length_mask
341 end
342
343 define string-contents
344 print (char *) ((struct Lisp_String *) ($ & 0xFFFFFFF))->_data
345 end
346
347 define vector-length
348 print ((struct Lisp_Vector *) ($ & 0xFFFFFFF))->size & $vector_length_mask
349 end
350
351 define vector-contents
352 set $tem = (struct Lisp_Vector *) ($ & 0xFFFFFFF)
353 print *($tem->contents) @ ($tem->size & $vector_length_mask)
354 set $ = $tem->contents
355 end
356
357 define symbol-name
358 set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->name
359 # output *($tem->_data) @ ($tem->_size & $vector_length_mask)
360 output ($tem->_data)
361 echo \n
362 set $type = Lisp_String
363 echo \n
364 end
365
366 define symbol-value
367 set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->value
368 end
369
370 define symbol-function
371 set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->function
372 end
373
374 define symbol-plist
375 set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->plist
376 end 183 end
377 184
378 define wtype 185 define wtype
379 p $->core.widget_class->core_class.class_name 186 print $arg0->core.widget_class->core_class.class_name
380 end 187 end
381 188
382 define xtname 189 define xtname
383 print XrmQuarkToString(((Object)($))->object.xrm_name) 190 print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
384 end 191 end
385 192
386 # 193 # GDB's command language makes you want to ...
387 # GDB, with the losing command-line parser that it has, 194
388 # cannot handle nested blocks. 195 define pstruct
389 # 196 set $xstruct = (struct $arg0 *) $val
390 define breaks 197 print $xstruct
391 198 print *$xstruct
392 br Fsignal 199 end
393 # command 200
394 # bt 3 201 define pobj
395 # p sig 202 decode_object $arg0
396 # xsymbol 203 if $type == dbg_Lisp_Type_Int
397 # end 204 printf "Integer: %d\n", $val
398 205 else
399 br Fkill_emacs 206 if $type == dbg_Lisp_Type_Char
400 # command 207 if $val < 128
401 # bt 3 208 printf "Char: %c\n", $val
402 # end 209 else
403 210 printf "Char: %d\n", $val
404 br assertion_failed 211 end
405 # command 212 else
406 # bt 3 213 if $type == dbg_Lisp_Type_String || $imp == lrecord_string
407 # end 214 pstruct Lisp_String
408 215 else
409 end 216 if $type == dbg_Lisp_Type_Cons || $imp == lrecord_cons
217 pstruct Lisp_Cons
218 else
219 if $type == dbg_Lisp_Type_Symbol || $imp == lrecord_symbol
220 pstruct Lisp_Symbol
221 printf "Symbol name: %s\n", $xstruct->name->_data
222 else
223 if $type == dbg_Lisp_Type_Vector || $imp == lrecord_vector
224 pstruct Lisp_Vector
225 printf "Vector of length %d\n", $xstruct->size
226 #print *($xstruct->_data) @ $xstruct->size
227 else
228 if $imp == lrecord_bit_vector
229 pstruct Lisp_Bit_Vector
230 else
231 if $imp == lrecord_buffer
232 pstruct buffer
233 else
234 if $imp == lrecord_char_table
235 pstruct Lisp_Char_Table
236 else
237 if $imp == lrecord_char_table_entry
238 pstruct Lisp_Char_Table_Entry
239 else
240 if $imp == lrecord_charset
241 pstruct Lisp_Charset
242 else
243 if $imp == lrecord_coding_system
244 pstruct Lisp_Coding_System
245 else
246 if $imp == lrecord_color_instance
247 pstruct Lisp_Color_Instance
248 else
249 if $imp == lrecord_command_builder
250 pstruct command_builder
251 else
252 if $imp == lrecord_compiled_function
253 pstruct Lisp_Compiled_Function
254 else
255 if $imp == lrecord_console
256 pstruct console
257 else
258 if $imp == lrecord_database
259 pstruct database
260 else
261 if $imp == lrecord_device
262 pstruct device
263 else
264 if $imp == lrecord_event
265 pstruct Lisp_Event
266 else
267 if $imp == lrecord_extent
268 pstruct extent
269 else
270 if $imp == lrecord_extent_auxiliary
271 pstruct extent_auxiliary
272 else
273 if $imp == lrecord_extent_info
274 pstruct extent_info
275 else
276 if $imp == lrecord_face
277 pstruct Lisp_Face
278 else
279 if $imp == lrecord_float
280 pstruct Lisp_Float
281 else
282 if $imp == lrecord_font_instance
283 pstruct Lisp_Font_Instance
284 else
285 if $imp == lrecord_frame
286 pstruct frame
287 else
288 if $imp == lrecord_glyph
289 pstruct Lisp_Glyph
290 else
291 if $imp == lrecord_hashtable
292 pstruct hashtable
293 else
294 if $imp == lrecord_image_instance
295 pstruct Lisp_Image_Instance
296 else
297 if $imp == lrecord_keymap
298 pstruct keymap
299 else
300 if $imp == lrecord_lcrecord_list
301 pstruct lcrecord_list
302 else
303 if $imp == lrecord_lstream
304 pstruct lstream
305 else
306 if $imp == lrecord_marker
307 pstruct Lisp_Marker
308 else
309 if $imp == lrecord_opaque
310 pstruct Lisp_Opaque
311 else
312 if $imp == lrecord_opaque_list
313 pstruct Lisp_Opaque_List
314 else
315 if $imp == lrecord_popup_data
316 pstruct popup_data
317 else
318 if $imp == lrecord_process
319 pstruct Lisp_Process
320 else
321 if $imp == lrecord_range_table
322 pstruct Lisp_Range_Table
323 else
324 if $imp == lrecord_specifier
325 pstruct Lisp_Specifier
326 else
327 if $imp == lrecord_subr
328 pstruct Lisp_Subr
329 else
330 if $imp == lrecord_symbol_value_buffer_local
331 pstruct symbol_value_buffer_local
332 else
333 if $imp == lrecord_symbol_value_forward
334 pstruct symbol_value_forward
335 else
336 if $imp == lrecord_symbol_value_lisp_magic
337 pstruct symbol_value_lisp_magic
338 else
339 if $imp == lrecord_symbol_value_varalias
340 pstruct symbol_value_varalias
341 else
342 if $imp == lrecord_toolbar_button
343 pstruct toolbar_button
344 else
345 if $imp == lrecord_toolbar_data
346 pstruct toolbar_data
347 else
348 if $imp == lrecord_tooltalk_message
349 pstruct Lisp_Tooltalk_Message
350 else
351 if $imp == lrecord_tooltalk_pattern
352 pstruct Lisp_Tooltalk_Pattern
353 else
354 if $imp == lrecord_weak_list
355 pstruct weak_list
356 else
357 if $imp == lrecord_window
358 pstruct window
359 else
360 if $imp == lrecord_window_configuration
361 pstruct window_config
362 else
363 echo Unknown Lisp Object type\n
364 print $arg0
365 # Barf, gag, retch
366 end
367 end
368 end
369 end
370 end
371 end
372 end
373 end
374 end
375 end
376 end
377 end
378 end
379 end
380 end
381 end
382 end
383 end
384 end
385 end
386 end
387 end
388 end
389 end
390 end
391 end
392 end
393 end
394 end
395 end
396 end
397 end
398 end
399 end
400 end
401 end
402 end
403 end
404 end
405 end
406 end
407 end
408 end
409 end
410 end
411 end
412 end
413 end
414 end
415 end
416 end
417 end
418
419 document pobj
420 Usage: pobj lisp_object
421 Print the internal C structure of a underlying Lisp Object.
422 end