comparison src/gdbinit @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents
children 95016f13131a
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
1 # -*- ksh -*-
2 # Copyright (C) 1998 Free Software Foundation, Inc.
3
4 # This file is part of XEmacs.
5
6 # XEmacs is free software; you can redistribute it and/or modify it
7 # under the terms of the GNU General Public License as published by the
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.
27 #
28 # See also the question of the XEmacs FAQ, titled
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
36 # (the above all have configure equivalents)
37
38 # Some functions defined here require a running process, but most
39 # don't. Considerable effort has been expended to this end.
40
41 # See the dbg_ C support code in src/alloc.c that allows the functions
42 # defined in this file to work correctly.
43
44 set print union off
45 set print pretty off
46
47 define decode_object
48 set $obj = (unsigned long) $arg0
49 if $obj & 1
50 # It's an int
51 set $val = $obj >> 1
52 set $type = Lisp_Type_Int
53 else
54 set $type = $obj & dbg_typemask
55 if $type == Lisp_Type_Char
56 set $val = ($obj & dbg_valmask) >> dbg_gctypebits
57 else
58 # It's a record pointer
59 set $val = $obj
60 end
61 end
62
63 if $type == Lisp_Type_Record
64 set $lheader = (struct lrecord_header *) $val
65 set $imp = lrecord_implementations_table[$lheader->type]
66 else
67 set $imp = -1
68 end
69 end
70
71 document decode_object
72 Usage: decode_object lisp_object
73 Extract implementation information from a Lisp Object.
74 Defines variables $val, $type and $imp.
75 end
76
77 define xint
78 decode_object $arg0
79 print ((long) $val)
80 end
81
82 define xtype
83 decode_object $arg0
84 if $type == Lisp_Type_Int
85 echo int\n
86 else
87 if $type == Lisp_Type_Char
88 echo char\n
89 else
90 if $type == Lisp_Type_Symbol
91 echo symbol\n
92 else
93 if $type == Lisp_Type_String
94 echo string\n
95 else
96 if $type == Lisp_Type_Vector
97 echo vector\n
98 else
99 if $type == Lisp_Type_Cons
100 echo cons\n
101 else
102 printf "record type: %s\n", $imp->name
103 # barf
104 end
105 end
106 end
107 end
108 end
109 end
110 end
111
112 define lisp-shadows
113 run -batch -vanilla -f list-load-path-shadows
114 end
115
116 document lisp-shadows
117 Usage: lisp-shadows
118 Run xemacs to check for lisp shadows
119 end
120
121 define environment-to-run-temacs
122 unset env EMACSLOADPATH
123 set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
124 set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
125 end
126
127 define run-temacs
128 environment-to-run-temacs
129 run -batch -l ../lisp/loadup.el run-temacs -q
130 end
131
132 document run-temacs
133 Usage: run-temacs
134 Run temacs interactively, like xemacs.
135 Use this with debugging tools (like purify) that cannot deal with dumping,
136 or when temacs builds successfully, but xemacs does not.
137 end
138
139 define update-elc
140 environment-to-run-temacs
141 run -batch -l ../lisp/update-elc.el
142 end
143
144 document update-elc
145 Usage: update-elc
146 Run the core lisp byte compilation part of the build procedure.
147 Use when debugging temacs, not xemacs!
148 Use this when temacs builds successfully, but xemacs does not.
149 end
150
151 define dump-temacs
152 environment-to-run-temacs
153 run -batch -l ../lisp/loadup.el dump
154 end
155
156 document dump-temacs
157 Usage: dump-temacs
158 Run the dumping part of the build procedure.
159 Use when debugging temacs, not xemacs!
160 Use this when temacs builds successfully, but xemacs does not.
161 end
162
163 # if you use Purify, do this:
164 # export PURIFYOPTIONS='-pointer-mask=0x0fffffff'
165
166 define ldp
167 printf "%s", "Lisp => "
168 call debug_print($arg0)
169 end
170
171 document ldp
172 Usage: ldp lisp_object
173 Print a Lisp Object value using the Lisp printer.
174 Requires a running xemacs process.
175 end
176
177 define lbt
178 call debug_backtrace()
179 end
180
181 document lbt
182 Usage: lbt
183 Print the current Lisp stack trace.
184 Requires a running xemacs process.
185 end
186
187
188 define leval
189 ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
190 end
191
192 document leval
193 Usage: leval "SEXP"
194 Eval a lisp expression.
195 Requires a running xemacs process.
196
197 Example:
198 (gdb) leval "(+ 1 2)"
199 Lisp ==> 3
200 end
201
202
203 define wtype
204 print $arg0->core.widget_class->core_class.class_name
205 end
206
207 define xtname
208 print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
209 end
210
211 # GDB's command language makes you want to ...
212
213 define pstruct
214 set $xstruct = (struct $arg0 *) $val
215 print $xstruct
216 print *$xstruct
217 end
218
219 define pobj
220 decode_object $arg0
221 if $type == Lisp_Type_Int
222 printf "Integer: %d\n", $val
223 else
224 if $type == Lisp_Type_Char
225 if $val > 32 && $val < 128
226 printf "Char: %c\n", $val
227 else
228 printf "Char: %d\n", $val
229 end
230 else
231 if $type == Lisp_Type_String || $imp == lrecord_string
232 pstruct Lisp_String
233 else
234 if $type == Lisp_Type_Cons || $imp == lrecord_cons
235 pstruct Lisp_Cons
236 else
237 if $type == Lisp_Type_Symbol || $imp == lrecord_symbol
238 pstruct Lisp_Symbol
239 printf "Symbol name: %s\n", $xstruct->name->data
240 else
241 if $type == Lisp_Type_Vector || $imp == lrecord_vector
242 pstruct Lisp_Vector
243 printf "Vector of length %d\n", $xstruct->size
244 #print *($xstruct->data) @ $xstruct->size
245 else
246 if $imp == lrecord_bit_vector
247 pstruct Lisp_Bit_Vector
248 else
249 if $imp == lrecord_buffer
250 pstruct buffer
251 else
252 if $imp == lrecord_char_table
253 pstruct Lisp_Char_Table
254 else
255 if $imp == lrecord_char_table_entry
256 pstruct Lisp_Char_Table_Entry
257 else
258 if $imp == lrecord_charset
259 pstruct Lisp_Charset
260 else
261 if $imp == lrecord_coding_system
262 pstruct Lisp_Coding_System
263 else
264 if $imp == lrecord_color_instance
265 pstruct Lisp_Color_Instance
266 else
267 if $imp == lrecord_command_builder
268 pstruct command_builder
269 else
270 if $imp == lrecord_compiled_function
271 pstruct Lisp_Compiled_Function
272 else
273 if $imp == lrecord_console
274 pstruct console
275 else
276 if $imp == lrecord_database
277 pstruct Lisp_Database
278 else
279 if $imp == lrecord_device
280 pstruct device
281 else
282 if $imp == lrecord_event
283 pstruct Lisp_Event
284 else
285 if $imp == lrecord_extent
286 pstruct extent
287 else
288 if $imp == lrecord_extent_auxiliary
289 pstruct extent_auxiliary
290 else
291 if $imp == lrecord_extent_info
292 pstruct extent_info
293 else
294 if $imp == lrecord_face
295 pstruct Lisp_Face
296 else
297 if $imp == lrecord_float
298 pstruct Lisp_Float
299 else
300 if $imp == lrecord_font_instance
301 pstruct Lisp_Font_Instance
302 else
303 if $imp == lrecord_frame
304 pstruct frame
305 else
306 if $imp == lrecord_glyph
307 pstruct Lisp_Glyph
308 else
309 if $imp == lrecord_hash_table
310 pstruct Lisp_Hash_Table
311 else
312 if $imp == lrecord_image_instance
313 pstruct Lisp_Image_Instance
314 else
315 if $imp == lrecord_keymap
316 pstruct Lisp_Keymap
317 else
318 if $imp == lrecord_lcrecord_list
319 pstruct lcrecord_list
320 else
321 if $imp == lrecord_lstream
322 pstruct lstream
323 else
324 if $imp == lrecord_marker
325 pstruct Lisp_Marker
326 else
327 if $imp == lrecord_opaque
328 pstruct Lisp_Opaque
329 else
330 if $imp == lrecord_opaque_list
331 pstruct Lisp_Opaque_List
332 else
333 if $imp == lrecord_popup_data
334 pstruct popup_data
335 else
336 if $imp == lrecord_process
337 pstruct Lisp_Process
338 else
339 if $imp == lrecord_range_table
340 pstruct Lisp_Range_Table
341 else
342 if $imp == lrecord_specifier
343 pstruct Lisp_Specifier
344 else
345 if $imp == lrecord_subr
346 pstruct Lisp_Subr
347 else
348 if $imp == lrecord_symbol_value_buffer_local
349 pstruct symbol_value_buffer_local
350 else
351 if $imp == lrecord_symbol_value_forward
352 pstruct symbol_value_forward
353 else
354 if $imp == lrecord_symbol_value_lisp_magic
355 pstruct symbol_value_lisp_magic
356 else
357 if $imp == lrecord_symbol_value_varalias
358 pstruct symbol_value_varalias
359 else
360 if $imp == lrecord_toolbar_button
361 pstruct toolbar_button
362 else
363 if $imp == lrecord_tooltalk_message
364 pstruct Lisp_Tooltalk_Message
365 else
366 if $imp == lrecord_tooltalk_pattern
367 pstruct Lisp_Tooltalk_Pattern
368 else
369 if $imp == lrecord_weak_list
370 pstruct weak_list
371 else
372 if $imp == lrecord_window
373 pstruct window
374 else
375 if $imp == lrecord_window_configuration
376 pstruct window_config
377 else
378 echo Unknown Lisp Object type\n
379 print $arg0
380 # Barf, gag, retch
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 # Repeat after me... gdb sux, gdb sux, gdb sux...
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 # Are we having fun yet??
416 end
417 end
418 end
419 end
420 end
421 end
422 end
423 end
424 end
425 end
426 end
427 end
428 end
429 end
430 end
431 end
432 end
433 end
434
435 document pobj
436 Usage: pobj lisp_object
437 Print the internal C structure of a underlying Lisp Object.
438 end
439
440 # -------------------------------------------------------------
441 # functions to test the debugging support itself.
442 # If you change this file, make sure the following still work...
443 # -------------------------------------------------------------
444 define test_xtype
445 printf "Vemacs_major_version: "
446 xtype Vemacs_major_version
447 printf "Vhelp_char: "
448 xtype Vhelp_char
449 printf "Qnil: "
450 xtype Qnil
451 printf "Qunbound: "
452 xtype Qunbound
453 printf "Vobarray: "
454 xtype Vobarray
455 printf "Vall_weak_lists: "
456 xtype Vall_weak_lists
457 printf "Vxemacs_codename: "
458 xtype Vxemacs_codename
459 end
460
461 define test_pobj
462 printf "Vemacs_major_version: "
463 pobj Vemacs_major_version
464 printf "Vhelp_char: "
465 pobj Vhelp_char
466 printf "Qnil: "
467 pobj Qnil
468 printf "Qunbound: "
469 pobj Qunbound
470 printf "Vobarray: "
471 pobj Vobarray
472 printf "Vall_weak_lists: "
473 pobj Vall_weak_lists
474 printf "Vxemacs_codename: "
475 pobj Vxemacs_codename
476 end
477