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 function ToInt { eval "$1=\$[(int) $1]"; }
62 ToInt dbg_USE_UNION_TYPE
66 ToInt Lisp_Type_String
67 ToInt Lisp_Type_Vector
68 ToInt Lisp_Type_Symbol
69 ToInt Lisp_Type_Record
72 function ToLong { eval "$1=\$[(unsigned long) $1]"; }
79 for i in $*; do eval "echo $i=\$$i"; done
82 document decode_object << 'end'
83 Usage: decode_object lisp_object
84 Extract implementation information from a Lisp Object.
85 Defines variables $val, $type and $imp.
88 # Various dbx bugs cause ugliness in following code
89 function decode_object {
90 if test -z "$xemacs_initted"; then XEmacsInit; fi;
91 if test $dbg_USE_UNION_TYPE = 1; then
92 # Repeat after me... dbx sux, dbx sux, dbx sux...
93 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
95 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
96 *) obj="$[(unsigned long)($1)]";;
99 obj="$[(unsigned long)($1)]";
101 if test $[(int)($obj & 1)] = 1; then
103 val=$[(long)(((unsigned long long)$obj) >> 1)]
106 type=$[(int)(((void*)$obj) & $dbg_typemask)]
107 if test $type = $Lisp_Type_Char; then
108 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
110 # It's a record pointer
112 if test "$val" = "(nil)"; then type=null_pointer; fi
116 if test $type = $Lisp_Type_Record; then
117 typeset lheader="((struct lrecord_header *) $val)"
118 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
122 # printvar obj val type imp
132 if test $type = $Lisp_Type_Int; then echo "int"
133 elif test $type = $Lisp_Type_Char; then echo "char"
134 elif test $type = $Lisp_Type_Symbol; then echo "symbol"
135 elif test $type = $Lisp_Type_String; then echo "string"
136 elif test $type = $Lisp_Type_Vector; then echo "vector"
137 elif test $type = $Lisp_Type_Cons; then echo "cons"
138 elif test $type = null_pointer; then echo "null_pointer"
140 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
144 function lisp-shadows {
145 run -batch -vanilla -f list-load-path-shadows
148 function environment-to-run-temacs {
150 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
151 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
154 document run-temacs << 'end'
156 Run temacs interactively, like xemacs.
157 Use this with debugging tools (like purify) that cannot deal with dumping,
158 or when temacs builds successfully, but xemacs does not.
161 function run-temacs {
162 environment-to-run-temacs
163 run -batch -l ../lisp/loadup.el run-temacs -q
166 document update-elc << 'end'
168 Run the core lisp byte compilation part of the build procedure.
169 Use when debugging temacs, not xemacs!
170 Use this when temacs builds successfully, but xemacs does not.
173 function update-elc {
174 environment-to-run-temacs
175 run -batch -l ../lisp/update-elc.el
179 function dump-temacs {
180 environment-to-run-temacs
181 run -batch -l ../lisp/loadup.el dump
184 document dump-temacs << 'end'
186 Run the dumping part of the build procedure.
187 Use when debugging temacs, not xemacs!
188 Use this when temacs builds successfully, but xemacs does not.
192 xstruct="((struct $1 *) $val)"
197 function lrecord_type_p {
198 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
201 document pobj << 'end'
202 Usage: pobj lisp_object
203 Print the internal C structure of a underlying Lisp Object.
208 if test $type = $Lisp_Type_Int; then
209 print -f"Integer: %d" $val
210 elif test $type = $Lisp_Type_Char; then
211 if test $[$val > 32 && $val < 128] = 1; then
212 print -f"Char: %c" $val
214 print -f"Char: %d" $val
216 elif test $type = $Lisp_Type_String || lrecord_type_p string; then
218 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
220 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
222 echo "Symbol name: $[(char *)($xstruct->name->data)]"
223 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
225 echo "Vector of length $[$xstruct->size]"
226 elif lrecord_type_p bit_vector; then
227 pstruct Lisp_Bit_Vector
228 elif lrecord_type_p buffer; then
230 elif lrecord_type_p char_table; then
231 pstruct Lisp_Char_Table
232 elif lrecord_type_p char_table_entry; then
233 pstruct Lisp_Char_Table_Entry
234 elif lrecord_type_p charset; then
236 elif lrecord_type_p coding_system; then
237 pstruct Lisp_Coding_System
238 elif lrecord_type_p color_instance; then
239 pstruct Lisp_Color_Instance
240 elif lrecord_type_p command_builder; then
241 pstruct command_builder
242 elif lrecord_type_p compiled_function; then
243 pstruct Lisp_Compiled_Function
244 elif lrecord_type_p console; then
246 elif lrecord_type_p database; then
247 pstruct Lisp_Database
248 elif lrecord_type_p device; then
250 elif lrecord_type_p event; then
252 elif lrecord_type_p extent; then
254 elif lrecord_type_p extent_auxiliary; then
255 pstruct extent_auxiliary
256 elif lrecord_type_p extent_info; then
258 elif lrecord_type_p face; then
260 elif lrecord_type_p float; then
262 elif lrecord_type_p font_instance; then
263 pstruct Lisp_Font_Instance
264 elif lrecord_type_p frame; then
266 elif lrecord_type_p glyph; then
268 elif lrecord_type_p hash_table; then
269 pstruct Lisp_Hash_Table
270 elif lrecord_type_p image_instance; then
271 pstruct Lisp_Image_Instance
272 elif lrecord_type_p keymap; then
274 elif lrecord_type_p lcrecord_list; then
275 pstruct lcrecord_list
276 elif lrecord_type_p lstream; then
278 elif lrecord_type_p marker; then
280 elif lrecord_type_p opaque; then
282 elif lrecord_type_p opaque_list; then
283 pstruct Lisp_Opaque_List
284 elif lrecord_type_p popup_data; then
286 elif lrecord_type_p process; then
288 elif lrecord_type_p range_table; then
289 pstruct Lisp_Range_Table
290 elif lrecord_type_p specifier; then
291 pstruct Lisp_Specifier
292 elif lrecord_type_p subr; then
294 elif lrecord_type_p symbol_value_buffer_local; then
295 pstruct symbol_value_buffer_local
296 elif lrecord_type_p symbol_value_forward; then
297 pstruct symbol_value_forward
298 elif lrecord_type_p symbol_value_lisp_magic; then
299 pstruct symbol_value_lisp_magic
300 elif lrecord_type_p symbol_value_varalias; then
301 pstruct symbol_value_varalias
302 elif lrecord_type_p toolbar_button; then
303 pstruct toolbar_button
304 elif lrecord_type_p tooltalk_message; then
305 pstruct Lisp_Tooltalk_Message
306 elif lrecord_type_p tooltalk_pattern; then
307 pstruct Lisp_Tooltalk_Pattern
308 elif lrecord_type_p weak_list; then
310 elif lrecord_type_p window; then
312 elif lrecord_type_p window_configuration; then
313 pstruct window_config
314 elif test "$type" = "null_pointer"; then
315 echo "Lisp Object is a null pointer!!"
317 echo "Unknown Lisp Object type"
323 print *(`process.c`struct Lisp_Process*)$1 ;
324 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
325 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
328 dbxenv suppress_startup_message 4.0
329 dbxenv mt_watchpoints on
332 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
336 function print_shell {
337 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
340 # -------------------------------------------------------------
341 # functions to test the debugging support itself.
342 # If you change this file, make sure the following still work...
343 # -------------------------------------------------------------
344 function test_xtype {
345 function doit { echo -n "$1: "; xtype "$1"; }
350 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
354 function test_various_objects {
355 doit Vemacs_major_version
361 doit Vxemacs_codename