2 # Copyright (C) 1998 Free Software Foundation, Inc.
4 # This file is part of SXEmacs
6 # SXEmacs is free software: you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation, either version 3 of the License, or
9 # (at your option) any later version.
11 # SXEmacs is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program. If not, see <http://www.gnu.org/licenses/>.
19 # Author: Martin Buchholz
21 # You can use this file to debug SXEmacs using Sun WorkShop's dbx.
23 # Some functions defined here require a running process, but most
24 # don't. Considerable effort has been expended to this end.
26 # Since this file is called `.dbxrc', it will be read by dbx
27 # automatically when dbx is run in the build directory, which is where
28 # developers usually debug their SXEmacs.
30 # See also the comments in .gdbinit.
32 # See also the question of the SXEmacs FAQ, titled
33 # "How to Debug a SXEmacs problem with a debugger".
35 # gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit.
36 # But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc.
37 # So we simulate the gdb algorithm by doing it ourselves here.
38 if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
40 dbxenv language_mode ansic
47 Print the current Lisp stack trace.
48 Requires a running SXEmacs process.
52 call debug_backtrace()
56 Usage: ldp lisp_object
57 Print a Lisp Object value using the Lisp printer.
58 Requires a running SXEmacs process.
62 call debug_print ($1);
67 # A bug in dbx prevents string variables from having values beginning with `-'!!
68 function SXEmacsInit {
69 function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
70 ToInt dbg_USE_UNION_TYPE
72 ToInt Lisp_Type_Record
75 function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
82 for i in $*; do eval "echo $i=\$$i"; done
85 document decode_object << 'end'
86 Usage: decode_object lisp_object
87 Extract implementation information from a Lisp Object.
88 Defines variables $val, $type and $imp.
91 # Various dbx bugs cause ugliness in following code
92 function decode_object {
93 if test -z "$sxemacs_initted"; then SXEmacsInit; fi;
94 if test $dbg_USE_UNION_TYPE = 1; then
95 # Repeat after me... dbx sux, dbx sux, dbx sux...
96 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
98 *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
99 *) obj="$[(`alloc.c`unsigned long)($1)]";;
102 obj="$[(`alloc.c`unsigned long)($1)]";
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 if test $type = $Lisp_Type_Record; then
120 lheader="((struct lrecord_header *) $val)"
121 lrecord_type=$[(enum lrecord_type) $lheader->type]
122 imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
124 lheader="((struct lrecord_header *) -1)"
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 = null_pointer; then echo "null_pointer"
147 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
151 function lisp-shadows {
152 run -batch -vanilla -f list-load-path-shadows
155 function environment-to-run-temacs {
157 export EMACSBOOTSTRAPLOADPATH=@abs_top_srcdir@/lisp/
158 export EMACSBOOTSTRAPMODULEPATH=@abs_top_srcdir@/modules/
161 document run-temacs << 'end'
163 Run temacs interactively, like SXEmacs.
164 Use this with debugging tools (like purify) that cannot deal with dumping,
165 or when temacs builds successfully, but SXEmacs does not.
168 function run-temacs {
169 environment-to-run-temacs
170 run -nd -batch -l @abs_top_srcdir@/lisp/loadup.el run-temacs -q ${1+"$@"}
173 document check-sxemacs << 'end'
175 Run the test suite. Equivalent to 'make check'.
178 function check-sxemacs {
179 run -batch -l @abs_top_srcdir@/tests/automated/test-harness.el -f batch-test-emacs @abs_top_srcdir@/tests/automated
182 document check-temacs << 'end'
184 Run the test suite on temacs. Equivalent to 'make check-temacs'.
185 Use this with debugging tools (like purify) that cannot deal with dumping,
186 or when temacs builds successfully, but SXEmacs does not.
189 function check-temacs {
190 run-temacs -q -batch -l @abs_top_srcdir@/tests/automated/test-harness.el -f batch-test-emacs @abs_top_srcdir@/tests/automated
193 document update-elc << 'end'
195 Run the core lisp byte compilation part of the build procedure.
196 Use when debugging temacs, not SXEmacs!
197 Use this when temacs builds successfully, but SXEmacs does not.
200 function update-elc {
201 environment-to-run-temacs
202 run -nd -batch -l @abs_top_srcdir@/lisp/update-elc.el
205 document dmp << 'end'
207 Run the dumping part of the build procedure.
208 Use when debugging temacs, not SXEmacs!
209 Use this when temacs builds successfully, but SXEmacs does not.
213 environment-to-run-temacs
214 run -nd -batch -l @abs_top_srcdir@/lisp/loadup.el dump
217 function pstruct { # pstruct foo.c struct-name
218 module "$1" > /dev/null
219 type_ptr="((struct $2 *) $val)"
224 document pobj << 'end'
225 Usage: pobj lisp_object
226 Print the internal C representation of a Lisp Object.
231 if test $type = $Lisp_Type_Int; then
232 print -f"Integer: %d" $val
233 elif test $type = $Lisp_Type_Char; then
234 if test $[$val > 32 && $val < 128] = 1; then
235 print -f"Char: %c" $val
237 print -f"Char: %d" $val
239 elif test $lrecord_type = lrecord_type_string; then
240 pstruct alloc.c Lisp_String
241 elif test $lrecord_type = lrecord_type_cons; then
242 pstruct alloc.c Lisp_Cons
243 elif test $lrecord_type = lrecord_type_symbol; then
244 pstruct symbols.c Lisp_Symbol
245 echo "Symbol name: $[(char *)($type_ptr->name->data)]"
246 elif test $lrecord_type = lrecord_type_vector; then
247 pstruct alloc.c Lisp_Vector
248 echo "Vector of length $[$type_ptr->size]"
249 elif test $lrecord_type = lrecord_type_bit_vector; then
250 pstruct fns.c Lisp_Bit_Vector
251 elif test $lrecord_type = lrecord_type_buffer; then
252 pstruct buffer.c buffer
253 elif test $lrecord_type = lrecord_type_char_table; then
254 pstruct chartab.c Lisp_Char_Table
255 elif test $lrecord_type = lrecord_type_char_table_entry; then
256 pstruct chartab.c Lisp_Char_Table_Entry
257 elif test $lrecord_type = lrecord_type_charset; then
258 pstruct mule-charset.c Lisp_Charset
259 elif test $lrecord_type = lrecord_type_coding_system; then
260 pstruct file-coding.c Lisp_Coding_System
261 elif test $lrecord_type = lrecord_type_color_instance; then
262 pstruct objects.c Lisp_Color_Instance
263 elif test $lrecord_type = lrecord_type_command_builder; then
264 pstruct event-stream.c command_builder
265 elif test $lrecord_type = lrecord_type_compiled_function; then
266 pstruct bytecode.c Lisp_Compiled_Function
267 elif test $lrecord_type = lrecord_type_console; then
268 pstruct console.c console
269 elif test $lrecord_type = lrecord_type_database; then
270 pstruct database.c Lisp_Database
271 elif test $lrecord_type = lrecord_type_device; then
272 pstruct device.c device
273 elif test $lrecord_type = lrecord_type_event; then
274 pstruct events.c Lisp_Event
275 elif test $lrecord_type = lrecord_type_extent; then
276 pstruct extents.c extent
277 elif test $lrecord_type = lrecord_type_extent_auxiliary; then
278 pstruct extents.c extent_auxiliary
279 elif test $lrecord_type = lrecord_type_extent_info; then
280 pstruct extents.c extent_info
281 elif test $lrecord_type = lrecord_type_face; then
282 pstruct faces.c Lisp_Face
283 elif test $lrecord_type = lrecord_type_float; then
284 pstruct floatfns.c Lisp_Float
285 elif test $lrecord_type = lrecord_type_font_instance; then
286 pstruct objects.c Lisp_Font_Instance
287 elif test $lrecord_type = lrecord_type_frame; then
288 pstruct frame.c frame
289 elif test $lrecord_type = lrecord_type_glyph; then
290 pstruct glyph.c Lisp_Glyph
291 elif test $lrecord_type = lrecord_type_gui_item; then
292 pstruct gui.c Lisp_Gui_Item
293 elif test $lrecord_type = lrecord_type_hash_table; then
294 pstruct elhash.c Lisp_Hash_Table
295 elif test $lrecord_type = lrecord_type_image_instance; then
296 pstruct glyphs.c Lisp_Image_Instance
297 elif test $lrecord_type = lrecord_type_keymap; then
298 pstruct keymap.c Lisp_Keymap
299 elif test $lrecord_type = lrecord_type_lcrecord_list; then
300 pstruct alloc.c lcrecord_list
301 elif test $lrecord_type = lrecord_type_ldap; then
302 pstruct ldap.c Lisp_LDAP
303 elif test $lrecord_type = lrecord_type_lstream; then
304 pstruct lstream.c lstream
305 elif test $lrecord_type = lrecord_type_marker; then
306 pstruct marker.c Lisp_Marker
307 elif test $lrecord_type = lrecord_type_opaque; then
308 pstruct opaque.c Lisp_Opaque
309 elif test $lrecord_type = lrecord_type_opaque_ptr; then
310 pstruct opaque.c Lisp_Opaque_Ptr
311 elif test $lrecord_type = lrecord_type_popup_data; then
312 pstruct gui-x.c popup_data
313 elif test $lrecord_type = lrecord_type_process; then
314 pstruct process.c Lisp_Process
315 elif test $lrecord_type = lrecord_type_range_table; then
316 pstruct rangetab.c Lisp_Range_Table
317 elif test $lrecord_type = lrecord_type_specifier; then
318 pstruct specifier.c Lisp_Specifier
319 elif test $lrecord_type = lrecord_type_subr; then
320 pstruct eval.c Lisp_Subr
321 elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then
322 pstruct symbols.c symbol_value_buffer_local
323 elif test $lrecord_type = lrecord_type_symbol_value_forward; then
324 pstruct symbols.c symbol_value_forward
325 elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then
326 pstruct symbols.c symbol_value_lisp_magic
327 elif test $lrecord_type = lrecord_type_symbol_value_varalias; then
328 pstruct symbols.c symbol_value_varalias
329 elif test $lrecord_type = lrecord_type_timeout; then
330 pstruct event-stream.c Lisp_Timeout
331 elif test $lrecord_type = lrecord_type_toolbar_button; then
332 pstruct toolbar.c toolbar_button
333 elif test $lrecord_type = lrecord_type_weak_list; then
334 pstruct data.c weak_list
335 elif test $lrecord_type = lrecord_type_window; then
336 pstruct window.c window
337 elif test $lrecord_type = lrecord_type_window_configuration; then
338 pstruct window.c window_config
339 elif test "$type" = "null_pointer"; then
340 echo "Lisp Object is a null pointer!!"
342 echo "Unknown Lisp Object type"
347 dbxenv suppress_startup_message 4.0
348 # dbxenv mt_watchpoints on
351 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
355 function print_shell {
356 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
359 # -------------------------------------------------------------
360 # functions to test the debugging support itself.
361 # If you change this file, make sure the following still work...
362 # -------------------------------------------------------------
363 function test_xtype {
364 function doit { echo -n "$1: "; xtype "$1"; }
369 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
373 function test_various_objects {
374 doit Vemacs_major_version
380 doit Vsxemacs_codename