398
|
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 #
|
|
25 # Since this file is called `.gdbinit', it will be read by gdb
|
|
26 # automatically when gdb is run in the build directory, which is where
|
|
27 # developers usually debug their xemacs. You can also source this
|
|
28 # file from your ~/.gdbinit, if you like.
|
|
29 #
|
|
30 # Configure xemacs with --debug, and compile with -g.
|
|
31 #
|
|
32 # See also the question of the XEmacs FAQ, titled
|
|
33 # "How to Debug an XEmacs problem with a debugger".
|
|
34 #
|
|
35 # This can be used to debug XEmacs no matter how the following are
|
|
36 # specified:
|
|
37
|
|
38 # USE_UNION_TYPE
|
|
39
|
|
40 # (the above all have configure equivalents)
|
|
41
|
|
42 # Some functions defined here require a running process, but most
|
|
43 # don't. Considerable effort has been expended to this end.
|
|
44
|
|
45 # See the dbg_ C support code in src/alloc.c that allows the functions
|
|
46 # defined in this file to work correctly.
|
|
47
|
|
48 set print union off
|
|
49 set print pretty off
|
|
50
|
400
|
51 set $Lisp_Type_Int = -2
|
|
52
|
398
|
53 define decode_object
|
|
54 set $obj = (unsigned long) $arg0
|
|
55 if $obj & 1
|
|
56 # It's an int
|
|
57 set $val = $obj >> 1
|
400
|
58 set $type = $Lisp_Type_Int
|
398
|
59 else
|
|
60 set $type = $obj & dbg_typemask
|
|
61 if $type == Lisp_Type_Char
|
|
62 set $val = ($obj & dbg_valmask) >> dbg_gctypebits
|
|
63 else
|
|
64 # It's a record pointer
|
|
65 set $val = $obj
|
|
66 end
|
|
67 end
|
|
68
|
|
69 if $type == Lisp_Type_Record
|
400
|
70 set $lheader = ((struct lrecord_header *) $val)
|
|
71 set $lrecord_type = ($lheader->type)
|
458
|
72 set $imp = ((struct lrecord_implementation *) lrecord_implementations_table[(int) $lrecord_type])
|
398
|
73 else
|
400
|
74 set $lrecord_type = -1
|
|
75 set $lheader = -1
|
398
|
76 set $imp = -1
|
|
77 end
|
|
78 end
|
|
79
|
|
80 document decode_object
|
|
81 Usage: decode_object lisp_object
|
|
82 Extract implementation information from a Lisp Object.
|
|
83 Defines variables $val, $type and $imp.
|
|
84 end
|
|
85
|
|
86 define xint
|
|
87 decode_object $arg0
|
|
88 print ((long) $val)
|
|
89 end
|
|
90
|
|
91 define xtype
|
|
92 decode_object $arg0
|
400
|
93 if $type == $Lisp_Type_Int
|
398
|
94 echo int\n
|
|
95 else
|
|
96 if $type == Lisp_Type_Char
|
|
97 echo char\n
|
|
98 else
|
|
99 printf "record type: %s\n", $imp->name
|
|
100 end
|
|
101 end
|
|
102 end
|
|
103
|
|
104 document xtype
|
|
105 Usage: xtype lisp_object
|
|
106 Print the Lisp type of a lisp object.
|
|
107 end
|
|
108
|
|
109 define lisp-shadows
|
|
110 run -batch -vanilla -f list-load-path-shadows
|
|
111 end
|
|
112
|
|
113 document lisp-shadows
|
|
114 Usage: lisp-shadows
|
|
115 Run xemacs to check for lisp shadows
|
|
116 end
|
|
117
|
|
118 define environment-to-run-temacs
|
|
119 unset env EMACSLOADPATH
|
|
120 set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
|
|
121 set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
|
|
122 end
|
|
123
|
|
124 define run-temacs
|
|
125 environment-to-run-temacs
|
452
|
126 run -nd -batch -l ../lisp/loadup.el run-temacs -q
|
398
|
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 check-xemacs
|
|
137 run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
|
|
138 end
|
|
139
|
|
140 document check-xemacs
|
|
141 Usage: check-xemacs
|
|
142 Run the test suite. Equivalent to 'make check'.
|
|
143 end
|
|
144
|
|
145 define check-temacs
|
|
146 environment-to-run-temacs
|
452
|
147 run -nd -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
|
398
|
148 end
|
|
149
|
|
150 document check-temacs
|
|
151 Usage: check-temacs
|
|
152 Run the test suite on temacs. Equivalent to 'make check-temacs'.
|
|
153 Use this with debugging tools (like purify) that cannot deal with dumping,
|
|
154 or when temacs builds successfully, but xemacs does not.
|
|
155 end
|
|
156
|
|
157 define update-elc
|
|
158 environment-to-run-temacs
|
452
|
159 run -nd -batch -l ../lisp/update-elc.el
|
398
|
160 end
|
|
161
|
|
162 document update-elc
|
|
163 Usage: update-elc
|
|
164 Run the core lisp byte compilation part of the build procedure.
|
|
165 Use when debugging temacs, not xemacs!
|
|
166 Use this when temacs builds successfully, but xemacs does not.
|
|
167 end
|
|
168
|
454
|
169 define dmp
|
398
|
170 environment-to-run-temacs
|
452
|
171 run -nd -batch -l ../lisp/loadup.el dump
|
398
|
172 end
|
|
173
|
454
|
174 document dmp
|
|
175 Usage: dmp
|
398
|
176 Run the dumping part of the build procedure.
|
|
177 Use when debugging temacs, not xemacs!
|
|
178 Use this when temacs builds successfully, but xemacs does not.
|
|
179 end
|
|
180
|
|
181 define ldp
|
|
182 printf "%s", "Lisp => "
|
|
183 call debug_print($arg0)
|
|
184 end
|
|
185
|
|
186 document ldp
|
|
187 Usage: ldp lisp_object
|
|
188 Print a Lisp Object value using the Lisp printer.
|
|
189 Requires a running xemacs process.
|
|
190 end
|
|
191
|
|
192 define lbt
|
|
193 call debug_backtrace()
|
|
194 end
|
|
195
|
|
196 document lbt
|
|
197 Usage: lbt
|
|
198 Print the current Lisp stack trace.
|
|
199 Requires a running xemacs process.
|
|
200 end
|
|
201
|
|
202
|
|
203 define leval
|
|
204 ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
|
|
205 end
|
|
206
|
|
207 document leval
|
|
208 Usage: leval "SEXP"
|
|
209 Eval a lisp expression.
|
|
210 Requires a running xemacs process.
|
|
211
|
|
212 Example:
|
|
213 (gdb) leval "(+ 1 2)"
|
|
214 Lisp ==> 3
|
|
215 end
|
|
216
|
|
217
|
|
218 define wtype
|
|
219 print $arg0->core.widget_class->core_class.class_name
|
|
220 end
|
|
221
|
|
222 define xtname
|
|
223 print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
|
|
224 end
|
|
225
|
|
226 # GDB's command language makes you want to ...
|
|
227
|
400
|
228 define ptype
|
|
229 set $type_ptr = ($arg0 *) $val
|
|
230 print $type_ptr
|
|
231 print *$type_ptr
|
|
232 end
|
|
233
|
|
234 define pstructtype
|
|
235 set $type_ptr = (struct $arg0 *) $val
|
|
236 print $type_ptr
|
|
237 print *$type_ptr
|
398
|
238 end
|
|
239
|
|
240 define pobj
|
|
241 decode_object $arg0
|
400
|
242 if $type == $Lisp_Type_Int
|
398
|
243 printf "Integer: %d\n", $val
|
|
244 else
|
|
245 if $type == Lisp_Type_Char
|
|
246 if $val > 32 && $val < 128
|
|
247 printf "Char: %c\n", $val
|
|
248 else
|
|
249 printf "Char: %d\n", $val
|
|
250 end
|
|
251 else
|
400
|
252 if $lrecord_type == lrecord_type_string
|
|
253 ptype Lisp_String
|
398
|
254 else
|
400
|
255 if $lrecord_type == lrecord_type_cons
|
|
256 ptype Lisp_Cons
|
398
|
257 else
|
400
|
258 if $lrecord_type == lrecord_type_symbol
|
|
259 ptype Lisp_Symbol
|
|
260 printf "Symbol name: %s\n", $type_ptr->name->data
|
398
|
261 else
|
400
|
262 if $lrecord_type == lrecord_type_vector
|
|
263 ptype Lisp_Vector
|
|
264 printf "Vector of length %d\n", $type_ptr->size
|
|
265 #print *($type_ptr->data) @ $type_ptr->size
|
398
|
266 else
|
400
|
267 if $lrecord_type == lrecord_type_bit_vector
|
|
268 ptype Lisp_Bit_Vector
|
398
|
269 else
|
400
|
270 if $lrecord_type == lrecord_type_buffer
|
|
271 pstructtype buffer
|
398
|
272 else
|
400
|
273 if $lrecord_type == lrecord_type_char_table
|
|
274 ptype Lisp_Char_Table
|
398
|
275 else
|
400
|
276 if $lrecord_type == lrecord_type_char_table_entry
|
|
277 ptype Lisp_Char_Table_Entry
|
398
|
278 else
|
400
|
279 if $lrecord_type == lrecord_type_charset
|
|
280 ptype Lisp_Charset
|
|
281 else
|
|
282 if $lrecord_type == lrecord_type_coding_system
|
|
283 ptype Lisp_Coding_System
|
398
|
284 else
|
400
|
285 if $lrecord_type == lrecord_type_color_instance
|
|
286 ptype Lisp_Color_Instance
|
398
|
287 else
|
400
|
288 if $lrecord_type == lrecord_type_command_builder
|
|
289 ptype command_builder
|
398
|
290 else
|
400
|
291 if $lrecord_type == lrecord_type_compiled_function
|
|
292 ptype Lisp_Compiled_Function
|
398
|
293 else
|
400
|
294 if $lrecord_type == lrecord_type_console
|
|
295 pstructtype console
|
398
|
296 else
|
400
|
297 if $lrecord_type == lrecord_type_database
|
|
298 ptype Lisp_Database
|
398
|
299 else
|
400
|
300 if $lrecord_type == lrecord_type_device
|
|
301 pstructtype device
|
398
|
302 else
|
400
|
303 if $lrecord_type == lrecord_type_event
|
|
304 ptype Lisp_Event
|
398
|
305 else
|
400
|
306 if $lrecord_type == lrecord_type_extent
|
|
307 pstructtype extent
|
398
|
308 else
|
400
|
309 if $lrecord_type == lrecord_type_extent_auxiliary
|
|
310 pstructtype extent_auxiliary
|
398
|
311 else
|
400
|
312 if $lrecord_type == lrecord_type_extent_info
|
|
313 pstructtype extent_info
|
398
|
314 else
|
400
|
315 if $lrecord_type == lrecord_type_face
|
|
316 ptype Lisp_Face
|
398
|
317 else
|
400
|
318 if $lrecord_type == lrecord_type_float
|
|
319 ptype Lisp_Float
|
|
320 else
|
|
321 if $lrecord_type == lrecord_type_font_instance
|
|
322 ptype Lisp_Font_Instance
|
398
|
323 else
|
400
|
324 if $lrecord_type == lrecord_type_frame
|
|
325 pstructtype frame
|
398
|
326 else
|
400
|
327 if $lrecord_type == lrecord_type_glyph
|
|
328 ptype Lisp_Glyph
|
398
|
329 else
|
400
|
330 if $lrecord_type == lrecord_type_gui_item
|
|
331 ptype Lisp_Gui_Item
|
398
|
332 else
|
400
|
333 if $lrecord_type == lrecord_type_hash_table
|
|
334 ptype Lisp_Hash_Table
|
398
|
335 else
|
400
|
336 if $lrecord_type == lrecord_type_image_instance
|
|
337 ptype Lisp_Image_Instance
|
398
|
338 else
|
400
|
339 if $lrecord_type == lrecord_type_keymap
|
|
340 ptype Lisp_Keymap
|
398
|
341 else
|
400
|
342 if $lrecord_type == lrecord_type_lcrecord_list
|
|
343 pstructtype lcrecord_list
|
398
|
344 else
|
400
|
345 if $lrecord_type == lrecord_type_ldap
|
|
346 ptype Lisp_LDAP
|
398
|
347 else
|
400
|
348 if $lrecord_type == lrecord_type_lstream
|
|
349 pstructtype lstream
|
398
|
350 else
|
400
|
351 if $lrecord_type == lrecord_type_marker
|
|
352 ptype Lisp_Marker
|
398
|
353 else
|
400
|
354 if $lrecord_type == lrecord_type_opaque
|
|
355 ptype Lisp_Opaque
|
398
|
356 else
|
400
|
357 if $lrecord_type == lrecord_type_opaque_ptr
|
|
358 ptype Lisp_Opaque_Ptr
|
|
359 else
|
|
360 if $lrecord_type == lrecord_type_popup_data
|
|
361 ptype popup_data
|
398
|
362 else
|
400
|
363 if $lrecord_type == lrecord_type_process
|
|
364 ptype Lisp_Process
|
398
|
365 else
|
400
|
366 if $lrecord_type == lrecord_type_range_table
|
|
367 ptype Lisp_Range_Table
|
398
|
368 else
|
400
|
369 if $lrecord_type == lrecord_type_specifier
|
|
370 ptype Lisp_Specifier
|
398
|
371 else
|
400
|
372 if $lrecord_type == lrecord_type_subr
|
|
373 ptype Lisp_Subr
|
398
|
374 else
|
400
|
375 if $lrecord_type == lrecord_type_symbol_value_buffer_local
|
|
376 pstructtype symbol_value_buffer_local
|
398
|
377 else
|
400
|
378 if $lrecord_type == lrecord_type_symbol_value_forward
|
|
379 pstructtype symbol_value_forward
|
398
|
380 else
|
400
|
381 if $lrecord_type == lrecord_type_symbol_value_lisp_magic
|
|
382 pstructtype symbol_value_lisp_magic
|
398
|
383 else
|
400
|
384 if $lrecord_type == lrecord_type_symbol_value_varalias
|
|
385 pstructtype symbol_value_varalias
|
398
|
386 else
|
400
|
387 if $lrecord_type == lrecord_type_timeout
|
|
388 ptype Lisp_Timeout
|
398
|
389 else
|
400
|
390 if $lrecord_type == lrecord_type_toolbar_button
|
|
391 pstructtype toolbar_button
|
398
|
392 else
|
400
|
393 if $lrecord_type == lrecord_type_tooltalk_message
|
|
394 ptype Lisp_Tooltalk_Message
|
398
|
395 else
|
400
|
396 if $lrecord_type == lrecord_type_tooltalk_pattern
|
|
397 ptype Lisp_Tooltalk_Pattern
|
398
|
398 else
|
400
|
399 if $lrecord_type == lrecord_type_weak_list
|
|
400 pstructtype weak_list
|
398
|
401 else
|
400
|
402 if $lrecord_type == lrecord_type_window
|
|
403 pstructtype window
|
398
|
404 else
|
400
|
405 if $lrecord_type == lrecord_type_window_configuration
|
|
406 pstructtype window_config
|
398
|
407 else
|
|
408 echo Unknown Lisp Object type\n
|
|
409 print $arg0
|
|
410 # Barf, gag, retch
|
|
411 end
|
|
412 end
|
|
413 end
|
|
414 end
|
|
415 end
|
|
416 end
|
|
417 end
|
|
418 end
|
|
419 end
|
|
420 end
|
|
421 end
|
|
422 end
|
|
423 end
|
|
424 end
|
|
425 end
|
400
|
426 end
|
|
427 end
|
398
|
428 # Repeat after me... gdb sux, gdb sux, gdb sux...
|
|
429 end
|
|
430 end
|
|
431 end
|
|
432 end
|
|
433 end
|
|
434 end
|
|
435 end
|
|
436 end
|
|
437 end
|
|
438 end
|
|
439 end
|
|
440 end
|
|
441 end
|
|
442 end
|
|
443 end
|
|
444 end
|
|
445 end
|
|
446 end
|
|
447 # Are we having fun yet??
|
|
448 end
|
|
449 end
|
|
450 end
|
|
451 end
|
|
452 end
|
|
453 end
|
|
454 end
|
|
455 end
|
|
456 end
|
|
457 end
|
|
458 end
|
|
459 end
|
|
460 end
|
|
461 end
|
|
462 end
|
|
463 end
|
|
464 end
|
400
|
465 end
|
398
|
466 end
|
|
467
|
|
468 document pobj
|
|
469 Usage: pobj lisp_object
|
|
470 Print the internal C representation of a Lisp Object.
|
|
471 end
|
|
472
|
|
473 # -------------------------------------------------------------
|
|
474 # functions to test the debugging support itself.
|
|
475 # If you change this file, make sure the following still work...
|
|
476 # -------------------------------------------------------------
|
|
477 define test_xtype
|
|
478 printf "Vemacs_major_version: "
|
|
479 xtype Vemacs_major_version
|
|
480 printf "Vhelp_char: "
|
|
481 xtype Vhelp_char
|
|
482 printf "Qnil: "
|
|
483 xtype Qnil
|
|
484 printf "Qunbound: "
|
|
485 xtype Qunbound
|
|
486 printf "Vobarray: "
|
|
487 xtype Vobarray
|
|
488 printf "Vall_weak_lists: "
|
|
489 xtype Vall_weak_lists
|
|
490 printf "Vxemacs_codename: "
|
|
491 xtype Vxemacs_codename
|
|
492 end
|
|
493
|
|
494 define test_pobj
|
|
495 printf "Vemacs_major_version: "
|
|
496 pobj Vemacs_major_version
|
|
497 printf "Vhelp_char: "
|
|
498 pobj Vhelp_char
|
|
499 printf "Qnil: "
|
|
500 pobj Qnil
|
|
501 printf "Qunbound: "
|
|
502 pobj Qunbound
|
|
503 printf "Vobarray: "
|
|
504 pobj Vobarray
|
|
505 printf "Vall_weak_lists: "
|
|
506 pobj Vall_weak_lists
|
|
507 printf "Vxemacs_codename: "
|
|
508 pobj Vxemacs_codename
|
|
509 end
|
|
510
|