update.
[chise/xemacs-chise.git-] / src / .gdbinit
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
51 set $Lisp_Type_Int = -2
52
53 define decode_object
54   set $obj = (unsigned long) $arg0
55   if $obj & 1
56   # It's an int
57     set $val = $obj >> 1
58     set $type = $Lisp_Type_Int
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
70     set $lheader = ((struct lrecord_header *) $val)
71     set $lrecord_type = ($lheader->type)
72     set $imp = ((struct lrecord_implementation *) lrecord_implementations_table[(int) $lrecord_type])
73   else
74     set $lrecord_type = -1
75     set $lheader = -1
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
93   if $type == $Lisp_Type_Int
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
126   run -nd -batch -l ../lisp/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 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
147   run -nd -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
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
159   run -nd -batch -l ../lisp/update-elc.el
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
169 define dmp
170   environment-to-run-temacs
171   run -nd -batch -l ../lisp/loadup.el dump
172 end
173
174 document dmp
175 Usage: dmp
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
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
238 end
239
240 define pobj
241   decode_object $arg0
242   if $type == $Lisp_Type_Int
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
252   if $lrecord_type == lrecord_type_string
253     ptype Lisp_String
254   else
255   if $lrecord_type == lrecord_type_cons
256     ptype Lisp_Cons
257   else
258   if $lrecord_type == lrecord_type_symbol
259     ptype Lisp_Symbol
260     printf "Symbol name: %s\n", $type_ptr->name->data
261   else
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
266   else
267   if $lrecord_type == lrecord_type_bit_vector
268     ptype Lisp_Bit_Vector
269   else
270   if $lrecord_type == lrecord_type_buffer
271     pstructtype buffer
272   else
273   if $lrecord_type == lrecord_type_char_table
274     ptype Lisp_Char_Table
275   else
276   if $lrecord_type == lrecord_type_char_table_entry
277     ptype Lisp_Char_Table_Entry
278   else
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
284   else
285   if $lrecord_type == lrecord_type_color_instance
286     ptype Lisp_Color_Instance
287   else
288   if $lrecord_type == lrecord_type_command_builder
289     ptype command_builder
290   else
291   if $lrecord_type == lrecord_type_compiled_function
292     ptype Lisp_Compiled_Function
293   else
294   if $lrecord_type == lrecord_type_console
295     pstructtype console
296   else
297   if $lrecord_type == lrecord_type_database
298     ptype Lisp_Database
299   else
300   if $lrecord_type == lrecord_type_device
301     pstructtype device
302   else
303   if $lrecord_type == lrecord_type_event
304     ptype Lisp_Event
305   else
306   if $lrecord_type == lrecord_type_extent
307     pstructtype extent
308   else
309   if $lrecord_type == lrecord_type_extent_auxiliary
310     pstructtype extent_auxiliary
311   else
312   if $lrecord_type == lrecord_type_extent_info
313     pstructtype extent_info
314   else
315   if $lrecord_type == lrecord_type_face
316     ptype Lisp_Face
317   else
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
323   else
324   if $lrecord_type == lrecord_type_frame
325     pstructtype frame
326   else
327   if $lrecord_type == lrecord_type_glyph
328     ptype Lisp_Glyph
329   else
330   if $lrecord_type == lrecord_type_gui_item
331     ptype Lisp_Gui_Item
332   else
333   if $lrecord_type == lrecord_type_hash_table
334     ptype Lisp_Hash_Table
335   else
336   if $lrecord_type == lrecord_type_image_instance
337     ptype Lisp_Image_Instance
338   else
339   if $lrecord_type == lrecord_type_keymap
340     ptype Lisp_Keymap
341   else
342   if $lrecord_type == lrecord_type_lcrecord_list
343     pstructtype lcrecord_list
344   else
345   if $lrecord_type == lrecord_type_ldap
346     ptype Lisp_LDAP
347   else
348   if $lrecord_type == lrecord_type_lstream
349     pstructtype lstream
350   else
351   if $lrecord_type == lrecord_type_marker
352     ptype Lisp_Marker
353   else
354   if $lrecord_type == lrecord_type_opaque
355     ptype Lisp_Opaque
356   else
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
362   else
363   if $lrecord_type == lrecord_type_process
364     ptype Lisp_Process
365   else
366   if $lrecord_type == lrecord_type_range_table
367     ptype Lisp_Range_Table
368   else
369   if $lrecord_type == lrecord_type_specifier
370     ptype Lisp_Specifier
371   else
372   if $lrecord_type == lrecord_type_subr
373     ptype Lisp_Subr
374   else
375   if $lrecord_type == lrecord_type_symbol_value_buffer_local
376     pstructtype symbol_value_buffer_local
377   else
378   if $lrecord_type == lrecord_type_symbol_value_forward
379     pstructtype symbol_value_forward
380   else
381   if $lrecord_type == lrecord_type_symbol_value_lisp_magic
382     pstructtype symbol_value_lisp_magic
383   else
384   if $lrecord_type == lrecord_type_symbol_value_varalias
385     pstructtype symbol_value_varalias
386   else
387   if $lrecord_type == lrecord_type_timeout
388     ptype Lisp_Timeout
389   else
390   if $lrecord_type == lrecord_type_toolbar_button
391     pstructtype toolbar_button
392   else
393   if $lrecord_type == lrecord_type_tooltalk_message
394     ptype Lisp_Tooltalk_Message
395   else
396   if $lrecord_type == lrecord_type_tooltalk_pattern
397     ptype Lisp_Tooltalk_Pattern
398   else
399   if $lrecord_type == lrecord_type_weak_list
400     pstructtype weak_list
401   else
402   if $lrecord_type == lrecord_type_window
403     pstructtype window
404   else
405   if $lrecord_type == lrecord_type_window_configuration
406     pstructtype window_config
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
426   end
427   end
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
465   end
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