2 # Copyright (C) 1998 Free Software Foundation, Inc.
4 # This file is part of XEmacs.
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
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
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.
21 # Author: Martin Buchholz
23 # You can use this file to debug XEmacs using Sun WorkShop's dbx.
24 # Add the contents of this file to $HOME/.dbxrc or
25 # Source the contents of this file with something like:
26 # if test -r ./dbxrc; then . ./dbxrc; fi
28 # Some functions defined here require a running process, but most
29 # don't. Considerable effort has been expended to this end.
31 # See also the comments in gdbinit.
33 # See also the question of the XEmacs FAQ, titled
34 # "How to Debug an XEmacs problem with a debugger".
41 Print the current Lisp stack trace.
42 Requires a running xemacs process.
46 call debug_backtrace()
50 Usage: ldp lisp_object
51 Print a Lisp Object value using the Lisp printer.
52 Requires a running xemacs process.
56 call debug_print ($1);
59 # A bug in dbx prevents string variables from having values beginning with `-'!!
61 eval $(echo $(whatis -t `alloc.c`dbg_constants) | \
62 perl -e 'print "@{[map {s/=(-\d+)/sprintf(q[=0x%x],$1)/oge; /\w+=[0-9a-fx]+/og} <>]}\n"')
64 #printvar dbg_valbits dbg_valmask
68 for i in $*; do eval "echo $i=\$$i"; done
71 document decode_object << 'end'
72 Usage: decode_object lisp_object
73 Extract implementation information from a Lisp Object.
74 Defines variables $val, $type and $imp.
77 # Various dbx bugs cause ugliness in following code
78 function decode_object {
79 if test -z "$xemacs_initted"; then XEmacsInit; fi;
80 if test $dbg_USE_UNION_TYPE = 1; then
81 # Repeat after me... dbx sux, dbx sux, dbx sux...
82 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
84 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
85 *) obj="$[(unsigned long)($1)]";;
88 obj="$[(unsigned long)($1)]";
90 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
91 if test $[(int)($obj & 1)] = 1; then
93 val=$[(long)(((unsigned long long)$obj) >> 1)]
94 type=$dbg_Lisp_Type_Int
96 type=$[(int)(((void*)$obj) & $dbg_typemask)]
97 if test $type = $dbg_Lisp_Type_Char; then
98 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
100 # It's a record pointer
102 if test "$val" = "(nil)"; then type=null_pointer; fi
106 # not dbg_USE_MINIMAL_TAGBITS
107 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
108 if test "$[$type == Lisp_Type_Int]" = 1; then
109 val=$[(int)($obj & $dbg_valmask)]
110 elif test "$[$type == Lisp_Type_Char]" = 1; then
111 val=$[(int)($obj & $dbg_valmask)]
113 val=$[(void*)($obj & $dbg_valmask)]
114 if test "$val" = "(nil)"; then type=null_pointer; fi
116 #val=$[(void*)($obj & $dbg_valmask)]
117 #printvar val type obj
120 if test $type = $dbg_Lisp_Type_Record; then
121 typeset lheader="((struct lrecord_header *) $val)"
122 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
123 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
125 imp=$[(void*)($lheader->implementation)]
130 #printvar obj val type imp
140 if test $type = $dbg_Lisp_Type_Int; then echo "int"
141 elif test $type = $dbg_Lisp_Type_Char; then echo "char"
142 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
143 elif test $type = $dbg_Lisp_Type_String; then echo "string"
144 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
145 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
146 elif test $type = null_pointer; then echo "$type"
148 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
152 document run-temacs << 'end'
154 Run temacs interactively, like xemacs.
155 Use this with debugging tools (like purify) that cannot deal with dumping,
156 or when temacs builds successfully, but xemacs does not.
159 function run-temacs {
161 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
162 run -batch -l ../lisp/loadup.el run-temacs -q
165 document update-elc << 'end'
167 Run the core lisp byte compilation part of the build procedure.
168 Use when debugging temacs, not xemacs!
169 Use this when temacs builds successfully, but xemacs does not.
172 function update-elc {
174 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
175 run -batch -l ../lisp/update-elc.el
179 function dump-temacs {
181 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
182 run -batch -l ../lisp/loadup.el dump
185 document dump-temacs << 'end'
187 Run the dumping part of the build procedure.
188 Use when debugging temacs, not xemacs!
189 Use this when temacs builds successfully, but xemacs does not.
193 xstruct="((struct $1 *) $val)"
198 function lrecord_type_p {
199 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
202 document pobj << 'end'
203 Usage: pobj lisp_object
204 Print the internal C structure of a underlying Lisp Object.
209 if test $type = $dbg_Lisp_Type_Int; then
210 print -f"Integer: %d" $val
211 elif test $type = $dbg_Lisp_Type_Char; then
213 print -f"Char: %c" $val
215 print -f"Char: %d" $val
217 elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
219 elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then
221 elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
223 echo "Symbol name: $[(char *)($xstruct->name->_data)]"
224 elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
226 echo "Vector of length $[$xstruct->size]"
227 elif lrecord_type_p bit_vector; then
228 pstruct Lisp_Bit_Vector
229 elif lrecord_type_p buffer; then
231 elif lrecord_type_p char_table; then
232 pstruct Lisp_Char_Table
233 elif lrecord_type_p char_table_entry; then
234 pstruct Lisp_Char_Table_Entry
235 elif lrecord_type_p charset; then
237 elif lrecord_type_p coding_system; then
238 pstruct Lisp_Coding_System
239 elif lrecord_type_p color_instance; then
240 pstruct Lisp_Color_Instance
241 elif lrecord_type_p command_builder; then
242 pstruct command_builder
243 elif lrecord_type_p compiled_function; then
244 pstruct Lisp_Compiled_Function
245 elif lrecord_type_p console; then
247 elif lrecord_type_p database; then
248 pstruct Lisp_Database
249 elif lrecord_type_p device; then
251 elif lrecord_type_p event; then
253 elif lrecord_type_p extent; then
255 elif lrecord_type_p extent_auxiliary; then
256 pstruct extent_auxiliary
257 elif lrecord_type_p extent_info; then
259 elif lrecord_type_p face; then
261 elif lrecord_type_p float; then
263 elif lrecord_type_p font_instance; then
264 pstruct Lisp_Font_Instance
265 elif lrecord_type_p frame; then
267 elif lrecord_type_p glyph; then
269 elif lrecord_type_p hash_table; then
270 pstruct Lisp_Hash_Table
271 elif lrecord_type_p image_instance; then
272 pstruct Lisp_Image_Instance
273 elif lrecord_type_p keymap; then
275 elif lrecord_type_p lcrecord_list; then
276 pstruct lcrecord_list
277 elif lrecord_type_p lstream; then
279 elif lrecord_type_p marker; then
281 elif lrecord_type_p opaque; then
283 elif lrecord_type_p opaque_list; then
284 pstruct Lisp_Opaque_List
285 elif lrecord_type_p popup_data; then
287 elif lrecord_type_p process; then
289 elif lrecord_type_p range_table; then
290 pstruct Lisp_Range_Table
291 elif lrecord_type_p specifier; then
292 pstruct Lisp_Specifier
293 elif lrecord_type_p subr; then
295 elif lrecord_type_p symbol_value_buffer_local; then
296 pstruct symbol_value_buffer_local
297 elif lrecord_type_p symbol_value_forward; then
298 pstruct symbol_value_forward
299 elif lrecord_type_p symbol_value_lisp_magic; then
300 pstruct symbol_value_lisp_magic
301 elif lrecord_type_p symbol_value_varalias; then
302 pstruct symbol_value_varalias
303 elif lrecord_type_p toolbar_button; then
304 pstruct toolbar_button
305 elif lrecord_type_p tooltalk_message; then
306 pstruct Lisp_Tooltalk_Message
307 elif lrecord_type_p tooltalk_pattern; then
308 pstruct Lisp_Tooltalk_Pattern
309 elif lrecord_type_p weak_list; then
311 elif lrecord_type_p window; then
313 elif lrecord_type_p window_configuration; then
314 pstruct window_config
315 elif test "$type" = "null_pointer"; then
316 echo "Lisp Object is a null pointer!!"
318 echo "Unknown Lisp Object type"
324 print *(`process.c`struct Lisp_Process*)$1 ;
325 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
326 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
329 dbxenv suppress_startup_message 4.0
330 dbxenv mt_watchpoints on
333 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
337 function print_shell {
338 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)