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 # test -r ./dbxrc && . ./dbxrc
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 test -z "$xemacs_initted" && XEmacsInit
81 test "$obj" = "(nil)" && obj="0x0"
82 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
83 if test $[(int)($obj & 1)] = 1; then
85 val=$[(long)(((unsigned long long)$obj) >> 1)]
86 type=$dbg_Lisp_Type_Int
88 type=$[(int)(((void*)$obj) & $dbg_typemask)]
89 if test $type = $dbg_Lisp_Type_Char; then
90 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
92 # It's a record pointer
97 # not dbg_USE_MINIMAL_TAGBITS
98 val=$[(void*)($obj & $dbg_valmask)]
99 test "$val" = "(nil)" && val="0x0"
100 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
103 if test $type = $dbg_Lisp_Type_Record; then
104 typeset lheader="((struct lrecord_header *) $val)"
105 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
106 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
108 imp=$[(void*)($lheader->implementation)]
113 #printvar obj val type imp
123 if test $type = $dbg_Lisp_Type_Int; then echo "int"
124 elif test $type = $dbg_Lisp_Type_Char; then echo "char"
125 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
126 elif test $type = $dbg_Lisp_Type_String; then echo "string"
127 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
128 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
130 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
134 document run-temacs << 'end'
136 Run temacs interactively, like xemacs.
137 Use this with debugging tools (like purify) that cannot deal with dumping,
138 or when temacs builds successfully, but xemacs does not.
141 function run-temacs {
143 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
144 run -batch -l ../lisp/loadup.el run-temacs -q
147 document update-elc << 'end'
149 Run the core lisp byte compilation part of the build procedure.
150 Use when debugging temacs, not xemacs!
151 Use this when temacs builds successfully, but xemacs does not.
154 function update-elc {
156 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
157 run -batch -l ../lisp/update-elc.el
161 function dump-temacs {
163 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
164 run -batch -l ../lisp/loadup.el dump
167 document dump-temacs << 'end'
169 Run the dumping part of the build procedure.
170 Use when debugging temacs, not xemacs!
171 Use this when temacs builds successfully, but xemacs does not.
175 xstruct="((struct $1 *) $val)"
180 function lrecord_type_p {
181 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
184 document pobj << 'end'
185 Usage: pobj lisp_object
186 Print the internal C structure of a underlying Lisp Object.
191 if test $type = $dbg_Lisp_Type_Int; then
192 print -f"Integer: %d" $val
193 elif test $type = $dbg_Lisp_Type_Char; then
195 print -f"Char: %c" $val
197 print -f"Char: %d" $val
199 elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
201 elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then
203 elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
205 echo "Symbol name: $[(char *)($xstruct->name->_data)]"
206 elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
208 echo "Vector of length $[$xstruct->size]"
209 elif lrecord_type_p bit_vector; then
210 pstruct Lisp_Bit_Vector
211 elif lrecord_type_p buffer; then
213 elif lrecord_type_p char_table; then
214 pstruct Lisp_Char_Table
215 elif lrecord_type_p char_table_entry; then
216 pstruct Lisp_Char_Table_Entry
217 elif lrecord_type_p charset; then
219 elif lrecord_type_p coding_system; then
220 pstruct Lisp_Coding_System
221 elif lrecord_type_p color_instance; then
222 pstruct Lisp_Color_Instance
223 elif lrecord_type_p command_builder; then
224 pstruct command_builder
225 elif lrecord_type_p compiled_function; then
226 pstruct Lisp_Compiled_Function
227 elif lrecord_type_p console; then
229 elif lrecord_type_p database; then
231 elif lrecord_type_p device; then
233 elif lrecord_type_p event; then
235 elif lrecord_type_p extent; then
237 elif lrecord_type_p extent_auxiliary; then
238 pstruct extent_auxiliary
239 elif lrecord_type_p extent_info; then
241 elif lrecord_type_p face; then
243 elif lrecord_type_p float; then
245 elif lrecord_type_p font_instance; then
246 pstruct Lisp_Font_Instance
247 elif lrecord_type_p frame; then
249 elif lrecord_type_p glyph; then
251 elif lrecord_type_p hashtable; then
253 elif lrecord_type_p image_instance; then
254 pstruct Lisp_Image_Instance
255 elif lrecord_type_p keymap; then
257 elif lrecord_type_p lcrecord_list; then
258 pstruct lcrecord_list
259 elif lrecord_type_p lstream; then
261 elif lrecord_type_p marker; then
263 elif lrecord_type_p opaque; then
265 elif lrecord_type_p opaque_list; then
266 pstruct Lisp_Opaque_List
267 elif lrecord_type_p popup_data; then
269 elif lrecord_type_p process; then
271 elif lrecord_type_p range_table; then
272 pstruct Lisp_Range_Table
273 elif lrecord_type_p specifier; then
274 pstruct Lisp_Specifier
275 elif lrecord_type_p subr; then
277 elif lrecord_type_p symbol_value_buffer_local; then
278 pstruct symbol_value_buffer_local
279 elif lrecord_type_p symbol_value_forward; then
280 pstruct symbol_value_forward
281 elif lrecord_type_p symbol_value_lisp_magic; then
282 pstruct symbol_value_lisp_magic
283 elif lrecord_type_p symbol_value_varalias; then
284 pstruct symbol_value_varalias
285 elif lrecord_type_p toolbar_button; then
286 pstruct toolbar_button
287 elif lrecord_type_p tooltalk_message; then
288 pstruct Lisp_Tooltalk_Message
289 elif lrecord_type_p tooltalk_pattern; then
290 pstruct Lisp_Tooltalk_Pattern
291 elif lrecord_type_p weak_list; then
293 elif lrecord_type_p window; then
295 elif lrecord_type_p window_configuration; then
296 pstruct window_config
298 echo "Unknown Lisp Object type"
304 print *(`process.c`struct Lisp_Process*)$1 ;
305 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
306 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
309 dbxenv suppress_startup_message 4.0
312 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
316 function print_shell {
317 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)