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.
25 # Some functions defined here require a running process, but most
26 # don't. Considerable effort has been expended to this end.
28 # Since this file is called `.dbxrc', it will be read by dbx
29 # automatically when dbx is run in the build directory, which is where
30 # developers usually debug their xemacs.
32 # See also the comments in .gdbinit.
34 # See also the question of the XEmacs FAQ, titled
35 # "How to Debug an XEmacs problem with a debugger".
37 # gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit.
38 # But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc.
39 # So we simulate the gdb algorithm by doing it ourselves here.
40 if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
47 Print the current Lisp stack trace.
48 Requires a running xemacs process.
52 call debug_backtrace()
56 Usage: ldp lisp_object
57 Print a Lisp Object value using the Lisp printer.
58 Requires a running xemacs process.
62 call debug_print ($1);
65 # A bug in dbx prevents string variables from having values beginning with `-'!!
67 function ToInt { eval "$1=\$[(int) $1]"; }
68 ToInt dbg_USE_UNION_TYPE
72 ToInt Lisp_Type_String
73 ToInt Lisp_Type_Vector
74 ToInt Lisp_Type_Symbol
75 ToInt Lisp_Type_Record
78 function ToLong { eval "$1=\$[(unsigned long) $1]"; }
85 for i in $*; do eval "echo $i=\$$i"; done
88 document decode_object << 'end'
89 Usage: decode_object lisp_object
90 Extract implementation information from a Lisp Object.
91 Defines variables $val, $type and $imp.
94 # Various dbx bugs cause ugliness in following code
95 function decode_object {
96 if test -z "$xemacs_initted"; then XEmacsInit; fi;
97 if test $dbg_USE_UNION_TYPE = 1; then
98 # Repeat after me... dbx sux, dbx sux, dbx sux...
99 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
101 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
102 *) obj="$[(unsigned long)($1)]";;
105 obj="$[(unsigned long)($1)]";
107 if test $[(int)($obj & 1)] = 1; then
109 val=$[(long)(((unsigned long long)$obj) >> 1)]
112 type=$[(int)(((void*)$obj) & $dbg_typemask)]
113 if test $type = $Lisp_Type_Char; then
114 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
116 # It's a record pointer
118 if test "$val" = "(nil)"; then type=null_pointer; fi
122 if test $type = $Lisp_Type_Record; then
123 typeset lheader="((struct lrecord_header *) $val)"
124 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
128 # printvar obj val type imp
136 document xtype << 'end'
137 Usage: xtype lisp_object
138 Print the Lisp type of a lisp object.
143 if test $type = $Lisp_Type_Int; then echo "int"
144 elif test $type = $Lisp_Type_Char; then echo "char"
145 elif test $type = $Lisp_Type_Symbol; then echo "symbol"
146 elif test $type = $Lisp_Type_String; then echo "string"
147 elif test $type = $Lisp_Type_Vector; then echo "vector"
148 elif test $type = $Lisp_Type_Cons; then echo "cons"
149 elif test $type = null_pointer; then echo "null_pointer"
151 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
155 function lisp-shadows {
156 run -batch -vanilla -f list-load-path-shadows
159 function environment-to-run-temacs {
161 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
162 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
165 document run-temacs << 'end'
167 Run temacs interactively, like xemacs.
168 Use this with debugging tools (like purify) that cannot deal with dumping,
169 or when temacs builds successfully, but xemacs does not.
172 function run-temacs {
173 environment-to-run-temacs
174 run -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"}
177 document check-xemacs << 'end'
179 Run the test suite. Equivalent to 'make check'.
182 function check-xemacs {
183 run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
186 document check-temacs << 'end'
188 Run the test suite on temacs. Equivalent to 'make check-temacs'.
189 Use this with debugging tools (like purify) that cannot deal with dumping,
190 or when temacs builds successfully, but xemacs does not.
193 function check-temacs {
194 run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
197 document update-elc << 'end'
199 Run the core lisp byte compilation part of the build procedure.
200 Use when debugging temacs, not xemacs!
201 Use this when temacs builds successfully, but xemacs does not.
204 function update-elc {
205 environment-to-run-temacs
206 run -batch -l ../lisp/update-elc.el
209 document dump-temacs << 'end'
211 Run the dumping part of the build procedure.
212 Use when debugging temacs, not xemacs!
213 Use this when temacs builds successfully, but xemacs does not.
216 function dump-temacs {
217 environment-to-run-temacs
218 run -batch -l ../lisp/loadup.el dump
222 xstruct="((struct $1 *) $val)"
227 function lrecord_type_p {
228 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
231 document pobj << 'end'
232 Usage: pobj lisp_object
233 Print the internal C representation of a Lisp Object.
238 if test $type = $Lisp_Type_Int; then
239 print -f"Integer: %d" $val
240 elif test $type = $Lisp_Type_Char; then
241 if test $[$val > 32 && $val < 128] = 1; then
242 print -f"Char: %c" $val
244 print -f"Char: %d" $val
246 elif test $type = $Lisp_Type_String || lrecord_type_p string; then
248 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
250 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
252 echo "Symbol name: $[(char *)($xstruct->name->data)]"
253 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
255 echo "Vector of length $[$xstruct->size]"
256 elif lrecord_type_p bit_vector; then
257 pstruct Lisp_Bit_Vector
258 elif lrecord_type_p buffer; then
260 elif lrecord_type_p char_table; then
261 pstruct Lisp_Char_Table
262 elif lrecord_type_p char_table_entry; then
263 pstruct Lisp_Char_Table_Entry
264 elif lrecord_type_p charset; then
266 elif lrecord_type_p coding_system; then
267 pstruct Lisp_Coding_System
268 elif lrecord_type_p color_instance; then
269 pstruct Lisp_Color_Instance
270 elif lrecord_type_p command_builder; then
271 pstruct command_builder
272 elif lrecord_type_p compiled_function; then
273 pstruct Lisp_Compiled_Function
274 elif lrecord_type_p console; then
276 elif lrecord_type_p database; then
277 pstruct Lisp_Database
278 elif lrecord_type_p device; then
280 elif lrecord_type_p event; then
282 elif lrecord_type_p extent; then
284 elif lrecord_type_p extent_auxiliary; then
285 pstruct extent_auxiliary
286 elif lrecord_type_p extent_info; then
288 elif lrecord_type_p face; then
290 elif lrecord_type_p float; then
292 elif lrecord_type_p font_instance; then
293 pstruct Lisp_Font_Instance
294 elif lrecord_type_p frame; then
296 elif lrecord_type_p glyph; then
298 elif lrecord_type_p hash_table; then
299 pstruct Lisp_Hash_Table
300 elif lrecord_type_p image_instance; then
301 pstruct Lisp_Image_Instance
302 elif lrecord_type_p keymap; then
304 elif lrecord_type_p lcrecord_list; then
305 pstruct lcrecord_list
306 elif lrecord_type_p lstream; then
308 elif lrecord_type_p marker; then
310 elif lrecord_type_p opaque; then
312 elif lrecord_type_p opaque_ptr; then
313 pstruct Lisp_Opaque_Ptr
314 elif lrecord_type_p popup_data; then
316 elif lrecord_type_p process; then
318 elif lrecord_type_p range_table; then
319 pstruct Lisp_Range_Table
320 elif lrecord_type_p specifier; then
321 pstruct Lisp_Specifier
322 elif lrecord_type_p subr; then
324 elif lrecord_type_p symbol_value_buffer_local; then
325 pstruct symbol_value_buffer_local
326 elif lrecord_type_p symbol_value_forward; then
327 pstruct symbol_value_forward
328 elif lrecord_type_p symbol_value_lisp_magic; then
329 pstruct symbol_value_lisp_magic
330 elif lrecord_type_p symbol_value_varalias; then
331 pstruct symbol_value_varalias
332 elif lrecord_type_p toolbar_button; then
333 pstruct toolbar_button
334 elif lrecord_type_p tooltalk_message; then
335 pstruct Lisp_Tooltalk_Message
336 elif lrecord_type_p tooltalk_pattern; then
337 pstruct Lisp_Tooltalk_Pattern
338 elif lrecord_type_p weak_list; then
340 elif lrecord_type_p window; then
342 elif lrecord_type_p window_configuration; then
343 pstruct window_config
344 elif test "$type" = "null_pointer"; then
345 echo "Lisp Object is a null pointer!!"
347 echo "Unknown Lisp Object type"
353 print *(`process.c`struct Lisp_Process*)$1 ;
354 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
355 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
358 dbxenv suppress_startup_message 4.0
359 dbxenv mt_watchpoints on
362 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
366 function print_shell {
367 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
370 # -------------------------------------------------------------
371 # functions to test the debugging support itself.
372 # If you change this file, make sure the following still work...
373 # -------------------------------------------------------------
374 function test_xtype {
375 function doit { echo -n "$1: "; xtype "$1"; }
380 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
384 function test_various_objects {
385 doit Vemacs_major_version
391 doit Vxemacs_codename