|
3418
|
1 ## dbx init file for XEmacs -*- ksh -*-
|
|
|
2 ## This is the source file for src/.dbxrc. Edit it, and rerun configure.
|
|
|
3 ## (Running config.status is not enough.)
|
|
|
4 ## The generated file depends on src/config.h (currently only in one place).
|
|
|
5
|
|
|
6 ## Copyright (C) 1998 Free Software Foundation, Inc.
|
|
|
7
|
|
|
8 ## This file is part of XEmacs.
|
|
|
9
|
|
|
10 ## XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ## under the terms of the GNU General Public License as published by the
|
|
|
12 ## Free Software Foundation; either version 2, or (at your option) any
|
|
|
13 ## later version.
|
|
|
14
|
|
|
15 ## XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
16 ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
17 ## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
18 ## for more details.
|
|
|
19
|
|
|
20 ## You should have received a copy of the GNU General Public License
|
|
|
21 ## along with XEmacs; see the file COPYING. If not, write to
|
|
|
22 ## the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
23 ## Boston, MA 02110-1301 USA
|
|
|
24
|
|
|
25 ## Author: Martin Buchholz
|
|
|
26
|
|
|
27 ## Other contributors you could ask for help: Ivan Golubev, Jerry James,
|
|
|
28 ## Stephen Turnbull.
|
|
|
29
|
|
|
30 ## You can use this file to debug XEmacs using Sun WorkShop's dbx.
|
|
|
31
|
|
|
32 ## Some functions defined here require a running process, but most
|
|
|
33 ## don't. Considerable effort has been expended to this end.
|
|
|
34
|
|
|
35 ## Since this file is called `.dbxrc', it will be read by dbx
|
|
|
36 ## automatically when dbx is run in the build directory, which is where
|
|
|
37 ## developers usually debug their xemacs.
|
|
|
38
|
|
|
39 ## See also the comments in .gdbinit.
|
|
|
40
|
|
|
41 ## See also the question of the XEmacs FAQ, titled
|
|
|
42 ## "How to Debug an XEmacs problem with a debugger".
|
|
|
43
|
|
|
44 ## gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit.
|
|
|
45 ## But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc.
|
|
|
46 ## So we simulate the gdb algorithm by doing it ourselves here.
|
|
|
47
|
|
|
48 #define NOT_C_CODE
|
|
|
49 #include "config.h"
|
|
|
50
|
|
|
51 if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
|
|
|
52
|
|
|
53 dbxenv language_mode ansic
|
|
|
54
|
|
|
55 ignore POLL
|
|
|
56 ignore IO
|
|
|
57
|
|
|
58 #ifdef VDB_POSIX
|
|
|
59 ignore SIGSEGV
|
|
|
60 ignore SIGBUS
|
|
|
61 #endif
|
|
|
62
|
|
|
63 document lbt << 'end'
|
|
|
64 Usage: lbt
|
|
|
65 Print the current Lisp stack trace.
|
|
|
66 Requires a running xemacs process.
|
|
|
67 end
|
|
|
68
|
|
|
69 function lbt {
|
|
|
70 call debug_backtrace()
|
|
|
71 }
|
|
|
72
|
|
|
73 document ldp << 'end'
|
|
|
74 Usage: ldp lisp_object
|
|
|
75 Print a Lisp Object value using the Lisp printer.
|
|
|
76 Requires a running xemacs process.
|
|
|
77 end
|
|
|
78
|
|
|
79 function ldp {
|
|
|
80 call debug_print ($1);
|
|
|
81 }
|
|
|
82
|
|
|
83 Lisp_Type_Int=-2
|
|
|
84
|
|
|
85 ## A bug in dbx prevents string variables from having values beginning with `-'!!
|
|
|
86 function XEmacsInit {
|
|
|
87 function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
|
|
|
88 ToInt dbg_USE_UNION_TYPE
|
|
|
89 ToInt Lisp_Type_Char
|
|
|
90 ToInt Lisp_Type_Record
|
|
|
91 ToInt dbg_valbits
|
|
|
92 ToInt dbg_gctypebits
|
|
|
93 function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
|
|
|
94 ToLong dbg_valmask
|
|
|
95 ToLong dbg_typemask
|
|
|
96 xemacs_initted=yes
|
|
|
97 }
|
|
|
98
|
|
|
99 function printvar {
|
|
|
100 for i in $*; do eval "echo $i=\$$i"; done
|
|
|
101 }
|
|
|
102
|
|
|
103 document decode_object << 'end'
|
|
|
104 Usage: decode_object lisp_object
|
|
|
105 Extract implementation information from a Lisp Object.
|
|
|
106 Defines variables $val, $type and $imp.
|
|
|
107 end
|
|
|
108
|
|
|
109 ## Various dbx bugs cause ugliness in following code
|
|
|
110 function decode_object {
|
|
|
111 if test -z "$xemacs_initted"; then XEmacsInit; fi;
|
|
|
112 if test $dbg_USE_UNION_TYPE = 1; then
|
|
|
113 ## Repeat after me... dbx sux, dbx sux, dbx sux...
|
|
|
114 ## Allow both `pobj Qnil' and `pobj 0x82746834' to work
|
|
|
115 case $(whatis $1) in
|
|
|
116 *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
|
|
|
117 *) obj="$[(`alloc.c`unsigned long)($1)]";;
|
|
|
118 esac
|
|
|
119 else
|
|
|
120 obj="$[(`alloc.c`unsigned long)($1)]";
|
|
|
121 fi
|
|
|
122 if test $[(int)($obj & 1)] = 1; then
|
|
|
123 ## It's an int
|
|
|
124 val=$[(long)(((unsigned long long)$obj) >> 1)]
|
|
|
125 type=$Lisp_Type_Int
|
|
|
126 else
|
|
|
127 type=$[(int)(((void*)$obj) & $dbg_typemask)]
|
|
|
128 if test $type = $Lisp_Type_Char; then
|
|
|
129 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
|
|
|
130 else
|
|
|
131 ## It's a record pointer
|
|
|
132 val=$[(void*)$obj]
|
|
|
133 if test "$val" = "(nil)"; then type=null_pointer; fi
|
|
|
134 fi
|
|
|
135 fi
|
|
|
136
|
|
|
137 if test $type = $Lisp_Type_Record; then
|
|
|
138 lheader="((struct lrecord_header *) $val)"
|
|
|
139 lrecord_type=$[(enum lrecord_type) $lheader->type]
|
|
|
140 imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
|
|
|
141 else
|
|
|
142 lheader="((struct lrecord_header *) -1)"
|
|
|
143 lrecord_type=-1
|
|
|
144 imp="0xdeadbeef"
|
|
|
145 fi
|
|
|
146 ## printvar obj val type imp
|
|
|
147 }
|
|
|
148
|
|
|
149 function xint {
|
|
|
150 decode_object "$*"
|
|
|
151 print (long) ($val)
|
|
|
152 }
|
|
|
153
|
|
|
154 document xtype << 'end'
|
|
|
155 Usage: xtype lisp_object
|
|
|
156 Print the Lisp type of a lisp object.
|
|
|
157 end
|
|
|
158
|
|
|
159 function xtype {
|
|
|
160 decode_object "$*"
|
|
|
161 if test $type = $Lisp_Type_Int; then echo "int"
|
|
|
162 elif test $type = $Lisp_Type_Char; then echo "char"
|
|
|
163 elif test $type = null_pointer; then echo "null_pointer"
|
|
|
164 else
|
|
|
165 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
|
|
|
166 fi
|
|
|
167 }
|
|
|
168
|
|
|
169 function lisp-shadows {
|
|
|
170 run -batch -vanilla -f list-load-path-shadows
|
|
|
171 }
|
|
|
172
|
|
|
173 function environment-to-run-temacs {
|
|
|
174 unset EMACSLOADPATH
|
|
|
175 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
|
|
|
176 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
|
|
|
177 }
|
|
|
178
|
|
|
179 document run-temacs << 'end'
|
|
|
180 Usage: run-temacs
|
|
|
181 Run temacs interactively, like xemacs.
|
|
|
182 Use this with debugging tools (like purify) that cannot deal with dumping,
|
|
|
183 or when temacs builds successfully, but xemacs does not.
|
|
|
184 end
|
|
|
185
|
|
|
186 function run-temacs {
|
|
|
187 environment-to-run-temacs
|
|
|
188 run -nd -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"}
|
|
|
189 }
|
|
|
190
|
|
|
191 document check-xemacs << 'end'
|
|
|
192 Usage: check-xemacs
|
|
|
193 Run the test suite. Equivalent to 'make check'.
|
|
|
194 end
|
|
|
195
|
|
|
196 function check-xemacs {
|
|
|
197 run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
|
|
|
198 }
|
|
|
199
|
|
|
200 document check-temacs << 'end'
|
|
|
201 Usage: check-temacs
|
|
|
202 Run the test suite on temacs. Equivalent to 'make check-temacs'.
|
|
|
203 Use this with debugging tools (like purify) that cannot deal with dumping,
|
|
|
204 or when temacs builds successfully, but xemacs does not.
|
|
|
205 end
|
|
|
206
|
|
|
207 function check-temacs {
|
|
|
208 run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
|
|
|
209 }
|
|
|
210
|
|
|
211 document update-elc << 'end'
|
|
|
212 Usage: update-elc
|
|
|
213 Run the core lisp byte compilation part of the build procedure.
|
|
|
214 Use when debugging temacs, not xemacs!
|
|
|
215 Use this when temacs builds successfully, but xemacs does not.
|
|
|
216 end
|
|
|
217
|
|
|
218 function update-elc {
|
|
|
219 environment-to-run-temacs
|
|
|
220 run -nd -batch -l ../lisp/update-elc.el
|
|
|
221 }
|
|
|
222
|
|
|
223 document dmp << 'end'
|
|
|
224 Usage: dmp
|
|
|
225 Run the dumping part of the build procedure.
|
|
|
226 Use when debugging temacs, not xemacs!
|
|
|
227 Use this when temacs builds successfully, but xemacs does not.
|
|
|
228 end
|
|
|
229
|
|
|
230 function dmp {
|
|
|
231 environment-to-run-temacs
|
|
|
232 run -nd -batch -l ../lisp/loadup.el dump
|
|
|
233 }
|
|
|
234
|
|
|
235 function pstruct { ## pstruct foo.c struct-name
|
|
|
236 module "$1" > /dev/null
|
|
|
237 type_ptr="((struct $2 *) $val)"
|
|
|
238 print $type_ptr
|
|
|
239 print *$type_ptr
|
|
|
240 }
|
|
|
241
|
|
|
242 document pobj << 'end'
|
|
|
243 Usage: pobj lisp_object
|
|
|
244 Print the internal C representation of a Lisp Object.
|
|
|
245 end
|
|
|
246
|
|
|
247 function pobj {
|
|
|
248 decode_object $1
|
|
|
249 if test $type = $Lisp_Type_Int; then
|
|
|
250 print -f"Integer: %d" $val
|
|
|
251 elif test $type = $Lisp_Type_Char; then
|
|
|
252 if test $[$val > 32 && $val < 128] = 1; then
|
|
|
253 print -f"Char: %c" $val
|
|
|
254 else
|
|
|
255 print -f"Char: %d" $val
|
|
|
256 fi
|
|
|
257 elif test $lrecord_type = lrecord_type_string; then
|
|
|
258 pstruct alloc.c Lisp_String
|
|
|
259 elif test $lrecord_type = lrecord_type_cons; then
|
|
|
260 pstruct alloc.c Lisp_Cons
|
|
|
261 elif test $lrecord_type = lrecord_type_symbol; then
|
|
|
262 pstruct symbols.c Lisp_Symbol
|
|
|
263 echo "Symbol name: $[(char *)($type_ptr->name->data)]"
|
|
|
264 elif test $lrecord_type = lrecord_type_vector; then
|
|
|
265 pstruct alloc.c Lisp_Vector
|
|
|
266 echo "Vector of length $[$type_ptr->size]"
|
|
|
267 elif test $lrecord_type = lrecord_type_bit_vector; then
|
|
|
268 pstruct fns.c Lisp_Bit_Vector
|
|
|
269 elif test $lrecord_type = lrecord_type_buffer; then
|
|
|
270 pstruct buffer.c buffer
|
|
|
271 elif test $lrecord_type = lrecord_type_char_table; then
|
|
|
272 pstruct chartab.c Lisp_Char_Table
|
|
|
273 elif test $lrecord_type = lrecord_type_char_table_entry; then
|
|
|
274 pstruct chartab.c Lisp_Char_Table_Entry
|
|
|
275 elif test $lrecord_type = lrecord_type_charset; then
|
|
|
276 pstruct mule-charset.c Lisp_Charset
|
|
|
277 elif test $lrecord_type = lrecord_type_coding_system; then
|
|
|
278 pstruct file-coding.c Lisp_Coding_System
|
|
|
279 elif test $lrecord_type = lrecord_type_color_instance; then
|
|
|
280 pstruct objects.c Lisp_Color_Instance
|
|
|
281 elif test $lrecord_type = lrecord_type_command_builder; then
|
|
|
282 pstruct event-stream.c command_builder
|
|
|
283 elif test $lrecord_type = lrecord_type_compiled_function; then
|
|
|
284 pstruct bytecode.c Lisp_Compiled_Function
|
|
|
285 elif test $lrecord_type = lrecord_type_console; then
|
|
|
286 pstruct console.c console
|
|
|
287 elif test $lrecord_type = lrecord_type_database; then
|
|
|
288 pstruct database.c Lisp_Database
|
|
|
289 elif test $lrecord_type = lrecord_type_device; then
|
|
|
290 pstruct device.c device
|
|
|
291 elif test $lrecord_type = lrecord_type_event; then
|
|
|
292 pstruct events.c Lisp_Event
|
|
|
293 elif test $lrecord_type = lrecord_type_extent; then
|
|
|
294 pstruct extents.c extent
|
|
|
295 elif test $lrecord_type = lrecord_type_extent_auxiliary; then
|
|
|
296 pstruct extents.c extent_auxiliary
|
|
|
297 elif test $lrecord_type = lrecord_type_extent_info; then
|
|
|
298 pstruct extents.c extent_info
|
|
|
299 elif test $lrecord_type = lrecord_type_face; then
|
|
|
300 pstruct faces.c Lisp_Face
|
|
|
301 elif test $lrecord_type = lrecord_type_float; then
|
|
|
302 pstruct floatfns.c Lisp_Float
|
|
|
303 elif test $lrecord_type = lrecord_type_font_instance; then
|
|
|
304 pstruct objects.c Lisp_Font_Instance
|
|
|
305 elif test $lrecord_type = lrecord_type_frame; then
|
|
|
306 pstruct frame.c frame
|
|
|
307 elif test $lrecord_type = lrecord_type_glyph; then
|
|
|
308 pstruct glyph.c Lisp_Glyph
|
|
|
309 elif test $lrecord_type = lrecord_type_gui_item; then
|
|
|
310 pstruct gui.c Lisp_Gui_Item
|
|
|
311 elif test $lrecord_type = lrecord_type_hash_table; then
|
|
|
312 pstruct elhash.c Lisp_Hash_Table
|
|
|
313 elif test $lrecord_type = lrecord_type_image_instance; then
|
|
|
314 pstruct glyphs.c Lisp_Image_Instance
|
|
|
315 elif test $lrecord_type = lrecord_type_keymap; then
|
|
|
316 pstruct keymap.c Lisp_Keymap
|
|
|
317 elif test $lrecord_type = lrecord_type_lcrecord_list; then
|
|
|
318 pstruct alloc.c lcrecord_list
|
|
|
319 elif test $lrecord_type = lrecord_type_ldap; then
|
|
|
320 pstruct ldap.c Lisp_LDAP
|
|
|
321 elif test $lrecord_type = lrecord_type_lstream; then
|
|
|
322 pstruct lstream.c lstream
|
|
|
323 elif test $lrecord_type = lrecord_type_marker; then
|
|
|
324 pstruct marker.c Lisp_Marker
|
|
|
325 elif test $lrecord_type = lrecord_type_opaque; then
|
|
|
326 pstruct opaque.c Lisp_Opaque
|
|
|
327 elif test $lrecord_type = lrecord_type_opaque_ptr; then
|
|
|
328 pstruct opaque.c Lisp_Opaque_Ptr
|
|
|
329 elif test $lrecord_type = lrecord_type_popup_data; then
|
|
|
330 pstruct gui-x.c popup_data
|
|
|
331 elif test $lrecord_type = lrecord_type_process; then
|
|
|
332 pstruct process.c Lisp_Process
|
|
|
333 elif test $lrecord_type = lrecord_type_range_table; then
|
|
|
334 pstruct rangetab.c Lisp_Range_Table
|
|
|
335 elif test $lrecord_type = lrecord_type_specifier; then
|
|
|
336 pstruct specifier.c Lisp_Specifier
|
|
|
337 elif test $lrecord_type = lrecord_type_subr; then
|
|
|
338 pstruct eval.c Lisp_Subr
|
|
|
339 elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then
|
|
|
340 pstruct symbols.c symbol_value_buffer_local
|
|
|
341 elif test $lrecord_type = lrecord_type_symbol_value_forward; then
|
|
|
342 pstruct symbols.c symbol_value_forward
|
|
|
343 elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then
|
|
|
344 pstruct symbols.c symbol_value_lisp_magic
|
|
|
345 elif test $lrecord_type = lrecord_type_symbol_value_varalias; then
|
|
|
346 pstruct symbols.c symbol_value_varalias
|
|
|
347 elif test $lrecord_type = lrecord_type_timeout; then
|
|
|
348 pstruct event-stream.c Lisp_Timeout
|
|
|
349 elif test $lrecord_type = lrecord_type_toolbar_button; then
|
|
|
350 pstruct toolbar.c toolbar_button
|
|
|
351 elif test $lrecord_type = lrecord_type_tooltalk_message; then
|
|
|
352 pstruct tooltalk.c Lisp_Tooltalk_Message
|
|
|
353 elif test $lrecord_type = lrecord_type_tooltalk_pattern; then
|
|
|
354 pstruct tooltalk.c Lisp_Tooltalk_Pattern
|
|
|
355 elif test $lrecord_type = lrecord_type_weak_list; then
|
|
|
356 pstruct data.c weak_list
|
|
|
357 elif test $lrecord_type = lrecord_type_window; then
|
|
|
358 pstruct window.c window
|
|
|
359 elif test $lrecord_type = lrecord_type_window_configuration; then
|
|
|
360 pstruct window.c window_config
|
|
|
361 elif test "$type" = "null_pointer"; then
|
|
|
362 echo "Lisp Object is a null pointer!!"
|
|
|
363 else
|
|
|
364 echo "Unknown Lisp Object type"
|
|
|
365 print $1
|
|
|
366 fi
|
|
|
367 }
|
|
|
368
|
|
|
369 dbxenv suppress_startup_message 4.0
|
|
|
370 ## dbxenv mt_watchpoints on
|
|
|
371
|
|
|
372 function dp_core {
|
|
|
373 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
|
|
|
374 }
|
|
|
375
|
|
|
376 ## Barf!
|
|
|
377 function print_shell {
|
|
|
378 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
|
|
|
379 }
|
|
|
380
|
|
|
381 ## -------------------------------------------------------------
|
|
|
382 ## functions to test the debugging support itself.
|
|
|
383 ## If you change this file, make sure the following still work...
|
|
|
384 ## -------------------------------------------------------------
|
|
|
385 function test_xtype {
|
|
|
386 function doit { echo -n "$1: "; xtype "$1"; }
|
|
|
387 test_various_objects
|
|
|
388 }
|
|
|
389
|
|
|
390 function test_pobj {
|
|
|
391 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
|
|
|
392 test_various_objects
|
|
|
393 }
|
|
|
394
|
|
|
395 function test_various_objects {
|
|
|
396 doit Vemacs_major_version
|
|
|
397 doit Vhelp_char
|
|
|
398 doit Qnil
|
|
|
399 doit Qunbound
|
|
|
400 doit Vobarray
|
|
|
401 doit Vall_weak_lists
|
|
|
402 doit Vxemacs_codename
|
|
|
403 }
|
