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_MINIMAL_TAGBITS
63 ToInt dbg_USE_UNION_TYPE
64 ToInt dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
68 ToInt Lisp_Type_String
69 ToInt Lisp_Type_Vector
70 ToInt Lisp_Type_Symbol
71 ToInt Lisp_Type_Record
74 function ToLong { eval "$1=\$[(unsigned long) $1]"; }
81 for i in $*; do eval "echo $i=\$$i"; done
84 document decode_object << 'end'
85 Usage: decode_object lisp_object
86 Extract implementation information from a Lisp Object.
87 Defines variables $val, $type and $imp.
90 # Various dbx bugs cause ugliness in following code
91 function decode_object {
92 if test -z "$xemacs_initted"; then XEmacsInit; fi;
93 if test $dbg_USE_UNION_TYPE = 1; then
94 # Repeat after me... dbx sux, dbx sux, dbx sux...
95 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
97 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
98 *) obj="$[(unsigned long)($1)]";;
101 obj="$[(unsigned long)($1)]";
103 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
104 if test $[(int)($obj & 1)] = 1; then
106 val=$[(long)(((unsigned long long)$obj) >> 1)]
109 type=$[(int)(((void*)$obj) & $dbg_typemask)]
110 if test $type = $Lisp_Type_Char; then
111 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
113 # It's a record pointer
115 if test "$val" = "(nil)"; then type=null_pointer; fi
119 # not dbg_USE_MINIMAL_TAGBITS
120 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
121 if test "$type" = $Lisp_Type_Int; then
122 val=$[(int)($obj & $dbg_valmask)]
123 elif test "$type" = $Lisp_Type_Char; then
124 val=$[(int)($obj & $dbg_valmask)]
126 val=$[(void*)($obj & $dbg_valmask)]
127 if test "$val" = "(nil)"; then type=null_pointer; fi
129 #val=$[(void*)($obj & $dbg_valmask)]
130 #printvar val type obj
133 if test $type = $Lisp_Type_Record; then
134 typeset lheader="((struct lrecord_header *) $val)"
135 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
136 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
138 imp=$[(void*)($lheader->implementation)]
143 # printvar obj val type imp
153 if test $type = $Lisp_Type_Int; then echo "int"
154 elif test $type = $Lisp_Type_Char; then echo "char"
155 elif test $type = $Lisp_Type_Symbol; then echo "symbol"
156 elif test $type = $Lisp_Type_String; then echo "string"
157 elif test $type = $Lisp_Type_Vector; then echo "vector"
158 elif test $type = $Lisp_Type_Cons; then echo "cons"
159 elif test $type = null_pointer; then echo "null_pointer"
161 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
165 function lisp-shadows {
166 run -batch -vanilla -f list-load-path-shadows
169 function environment-to-run-temacs {
171 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
172 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
175 document run-temacs << 'end'
177 Run temacs interactively, like xemacs.
178 Use this with debugging tools (like purify) that cannot deal with dumping,
179 or when temacs builds successfully, but xemacs does not.
182 function run-temacs {
183 environment-to-run-temacs
184 run -batch -l ../lisp/loadup.el run-temacs -q
187 document update-elc << 'end'
189 Run the core lisp byte compilation part of the build procedure.
190 Use when debugging temacs, not xemacs!
191 Use this when temacs builds successfully, but xemacs does not.
194 function update-elc {
195 environment-to-run-temacs
196 run -batch -l ../lisp/update-elc.el
200 function dump-temacs {
201 environment-to-run-temacs
202 run -batch -l ../lisp/loadup.el dump
205 document dump-temacs << 'end'
207 Run the dumping part of the build procedure.
208 Use when debugging temacs, not xemacs!
209 Use this when temacs builds successfully, but xemacs does not.
213 xstruct="((struct $1 *) $val)"
218 function lrecord_type_p {
219 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
222 document pobj << 'end'
223 Usage: pobj lisp_object
224 Print the internal C structure of a underlying Lisp Object.
229 if test $type = $Lisp_Type_Int; then
230 print -f"Integer: %d" $val
231 elif test $type = $Lisp_Type_Char; then
232 if test $[$val > 32 && $val < 128] = 1; then
233 print -f"Char: %c" $val
235 print -f"Char: %d" $val
237 elif test $type = $Lisp_Type_String || lrecord_type_p string; then
239 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
241 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
243 echo "Symbol name: $[(char *)($xstruct->name->data)]"
244 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
246 echo "Vector of length $[$xstruct->size]"
247 elif lrecord_type_p bit_vector; then
248 pstruct Lisp_Bit_Vector
249 elif lrecord_type_p buffer; then
251 elif lrecord_type_p char_table; then
252 pstruct Lisp_Char_Table
253 elif lrecord_type_p char_table_entry; then
254 pstruct Lisp_Char_Table_Entry
255 elif lrecord_type_p charset; then
257 elif lrecord_type_p coding_system; then
258 pstruct Lisp_Coding_System
259 elif lrecord_type_p color_instance; then
260 pstruct Lisp_Color_Instance
261 elif lrecord_type_p command_builder; then
262 pstruct command_builder
263 elif lrecord_type_p compiled_function; then
264 pstruct Lisp_Compiled_Function
265 elif lrecord_type_p console; then
267 elif lrecord_type_p database; then
268 pstruct Lisp_Database
269 elif lrecord_type_p device; then
271 elif lrecord_type_p event; then
273 elif lrecord_type_p extent; then
275 elif lrecord_type_p extent_auxiliary; then
276 pstruct extent_auxiliary
277 elif lrecord_type_p extent_info; then
279 elif lrecord_type_p face; then
281 elif lrecord_type_p float; then
283 elif lrecord_type_p font_instance; then
284 pstruct Lisp_Font_Instance
285 elif lrecord_type_p frame; then
287 elif lrecord_type_p glyph; then
289 elif lrecord_type_p hash_table; then
290 pstruct Lisp_Hash_Table
291 elif lrecord_type_p image_instance; then
292 pstruct Lisp_Image_Instance
293 elif lrecord_type_p keymap; then
295 elif lrecord_type_p lcrecord_list; then
296 pstruct lcrecord_list
297 elif lrecord_type_p lstream; then
299 elif lrecord_type_p marker; then
301 elif lrecord_type_p opaque; then
303 elif lrecord_type_p opaque_list; then
304 pstruct Lisp_Opaque_List
305 elif lrecord_type_p popup_data; then
307 elif lrecord_type_p process; then
309 elif lrecord_type_p range_table; then
310 pstruct Lisp_Range_Table
311 elif lrecord_type_p specifier; then
312 pstruct Lisp_Specifier
313 elif lrecord_type_p subr; then
315 elif lrecord_type_p symbol_value_buffer_local; then
316 pstruct symbol_value_buffer_local
317 elif lrecord_type_p symbol_value_forward; then
318 pstruct symbol_value_forward
319 elif lrecord_type_p symbol_value_lisp_magic; then
320 pstruct symbol_value_lisp_magic
321 elif lrecord_type_p symbol_value_varalias; then
322 pstruct symbol_value_varalias
323 elif lrecord_type_p toolbar_button; then
324 pstruct toolbar_button
325 elif lrecord_type_p tooltalk_message; then
326 pstruct Lisp_Tooltalk_Message
327 elif lrecord_type_p tooltalk_pattern; then
328 pstruct Lisp_Tooltalk_Pattern
329 elif lrecord_type_p weak_list; then
331 elif lrecord_type_p window; then
333 elif lrecord_type_p window_configuration; then
334 pstruct window_config
335 elif test "$type" = "null_pointer"; then
336 echo "Lisp Object is a null pointer!!"
338 echo "Unknown Lisp Object type"
344 print *(`process.c`struct Lisp_Process*)$1 ;
345 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
346 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
349 dbxenv suppress_startup_message 4.0
350 dbxenv mt_watchpoints on
353 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
357 function print_shell {
358 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
361 # -------------------------------------------------------------
362 # functions to test the debugging support itself.
363 # If you change this file, make sure the following still work...
364 # -------------------------------------------------------------
365 function test_xtype {
366 function doit { echo -n "$1: "; xtype "$1"; }
371 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
375 function test_various_objects {
376 doit Vemacs_major_version
382 doit Vxemacs_codename