|
2
|
1 # -*- ksh -*-
|
|
272
|
2 # Copyright (C) 1998 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 # This file is part of XEmacs.
|
|
|
5
|
|
|
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
|
|
|
9 # later version.
|
|
|
10
|
|
|
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
|
|
|
14 # for more details.
|
|
|
15
|
|
|
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.
|
|
|
20
|
|
|
21 # Author: Martin Buchholz
|
|
|
22
|
|
2
|
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:
|
|
337
|
26 # if test -r ./dbxrc; then . ./dbxrc; fi
|
|
2
|
27
|
|
272
|
28 # Some functions defined here require a running process, but most
|
|
|
29 # don't. Considerable effort has been expended to this end.
|
|
|
30
|
|
|
31 # See also the comments in gdbinit.
|
|
|
32
|
|
|
33 # See also the question of the XEmacs FAQ, titled
|
|
|
34 # "How to Debug an XEmacs problem with a debugger".
|
|
|
35
|
|
2
|
36 ignore POLL
|
|
|
37 ignore IO
|
|
|
38
|
|
272
|
39 document lbt << 'end'
|
|
|
40 Usage: lbt
|
|
|
41 Print the current Lisp stack trace.
|
|
|
42 Requires a running xemacs process.
|
|
|
43 end
|
|
|
44
|
|
2
|
45 function lbt {
|
|
272
|
46 call debug_backtrace()
|
|
2
|
47 }
|
|
|
48
|
|
272
|
49 document ldp << 'end'
|
|
|
50 Usage: ldp lisp_object
|
|
|
51 Print a Lisp Object value using the Lisp printer.
|
|
|
52 Requires a running xemacs process.
|
|
|
53 end
|
|
|
54
|
|
|
55 function ldp {
|
|
2
|
56 call debug_print ($1);
|
|
|
57 }
|
|
|
58
|
|
272
|
59 # A bug in dbx prevents string variables from having values beginning with `-'!!
|
|
|
60 function XEmacsInit {
|
|
337
|
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
|
|
|
65 ToInt Lisp_Type_Int
|
|
|
66 ToInt Lisp_Type_Char
|
|
|
67 ToInt Lisp_Type_Cons
|
|
|
68 ToInt Lisp_Type_String
|
|
|
69 ToInt Lisp_Type_Vector
|
|
|
70 ToInt Lisp_Type_Symbol
|
|
|
71 ToInt Lisp_Type_Record
|
|
|
72 ToInt dbg_valbits
|
|
|
73 ToInt dbg_gctypebits
|
|
|
74 function ToLong { eval "$1=\$[(unsigned long) $1]"; }
|
|
|
75 ToLong dbg_valmask
|
|
|
76 ToLong dbg_typemask
|
|
272
|
77 xemacs_initted=yes
|
|
|
78 }
|
|
|
79
|
|
|
80 function printvar {
|
|
|
81 for i in $*; do eval "echo $i=\$$i"; done
|
|
|
82 }
|
|
|
83
|
|
|
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.
|
|
|
88 end
|
|
|
89
|
|
|
90 # Various dbx bugs cause ugliness in following code
|
|
|
91 function decode_object {
|
|
337
|
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
|
|
|
96 case $(whatis $1) in
|
|
|
97 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
|
|
|
98 *) obj="$[(unsigned long)($1)]";;
|
|
|
99 esac
|
|
|
100 else
|
|
|
101 obj="$[(unsigned long)($1)]";
|
|
|
102 fi
|
|
272
|
103 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
|
|
|
104 if test $[(int)($obj & 1)] = 1; then
|
|
|
105 # It's an int
|
|
|
106 val=$[(long)(((unsigned long long)$obj) >> 1)]
|
|
337
|
107 type=$Lisp_Type_Int
|
|
272
|
108 else
|
|
|
109 type=$[(int)(((void*)$obj) & $dbg_typemask)]
|
|
337
|
110 if test $type = $Lisp_Type_Char; then
|
|
272
|
111 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
|
|
|
112 else
|
|
|
113 # It's a record pointer
|
|
|
114 val=$[(void*)$obj]
|
|
337
|
115 if test "$val" = "(nil)"; then type=null_pointer; fi
|
|
272
|
116 fi
|
|
|
117 fi
|
|
|
118 else
|
|
|
119 # not dbg_USE_MINIMAL_TAGBITS
|
|
|
120 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
|
|
337
|
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)]
|
|
|
125 else
|
|
|
126 val=$[(void*)($obj & $dbg_valmask)]
|
|
|
127 if test "$val" = "(nil)"; then type=null_pointer; fi
|
|
|
128 fi
|
|
|
129 #val=$[(void*)($obj & $dbg_valmask)]
|
|
|
130 #printvar val type obj
|
|
272
|
131 fi
|
|
|
132
|
|
337
|
133 if test $type = $Lisp_Type_Record; then
|
|
272
|
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])]
|
|
|
137 else
|
|
|
138 imp=$[(void*)($lheader->implementation)]
|
|
|
139 fi
|
|
|
140 else
|
|
|
141 imp="0xdeadbeef"
|
|
|
142 fi
|
|
337
|
143 # printvar obj val type imp
|
|
2
|
144 }
|
|
|
145
|
|
|
146 function xint {
|
|
272
|
147 decode_object "$*"
|
|
|
148 print (long) ($val)
|
|
|
149 }
|
|
|
150
|
|
|
151 function xtype {
|
|
|
152 decode_object "$*"
|
|
337
|
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"
|
|
272
|
160 else
|
|
|
161 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
|
|
|
162 fi
|
|
2
|
163 }
|
|
|
164
|
|
337
|
165 function lisp-shadows {
|
|
|
166 run -batch -vanilla -f list-load-path-shadows
|
|
|
167 }
|
|
|
168
|
|
|
169 function environment-to-run-temacs {
|
|
|
170 unset EMACSLOADPATH
|
|
|
171 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
|
|
|
172 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
|
|
|
173 }
|
|
|
174
|
|
272
|
175 document run-temacs << 'end'
|
|
|
176 Usage: run-temacs
|
|
|
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.
|
|
|
180 end
|
|
2
|
181
|
|
272
|
182 function run-temacs {
|
|
337
|
183 environment-to-run-temacs
|
|
284
|
184 run -batch -l ../lisp/loadup.el run-temacs -q
|
|
2
|
185 }
|
|
|
186
|
|
272
|
187 document update-elc << 'end'
|
|
|
188 Usage: update-elc
|
|
284
|
189 Run the core lisp byte compilation part of the build procedure.
|
|
272
|
190 Use when debugging temacs, not xemacs!
|
|
|
191 Use this when temacs builds successfully, but xemacs does not.
|
|
|
192 end
|
|
|
193
|
|
|
194 function update-elc {
|
|
337
|
195 environment-to-run-temacs
|
|
284
|
196 run -batch -l ../lisp/update-elc.el
|
|
2
|
197 }
|
|
|
198
|
|
284
|
199
|
|
|
200 function dump-temacs {
|
|
337
|
201 environment-to-run-temacs
|
|
284
|
202 run -batch -l ../lisp/loadup.el dump
|
|
|
203 }
|
|
|
204
|
|
|
205 document dump-temacs << 'end'
|
|
|
206 Usage: dump-temacs
|
|
|
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.
|
|
|
210 end
|
|
|
211
|
|
272
|
212 function pstruct {
|
|
|
213 xstruct="((struct $1 *) $val)"
|
|
|
214 print $xstruct
|
|
|
215 print *$xstruct
|
|
|
216 }
|
|
|
217
|
|
|
218 function lrecord_type_p {
|
|
|
219 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
|
|
2
|
220 }
|
|
|
221
|
|
272
|
222 document pobj << 'end'
|
|
|
223 Usage: pobj lisp_object
|
|
|
224 Print the internal C structure of a underlying Lisp Object.
|
|
|
225 end
|
|
|
226
|
|
|
227 function pobj {
|
|
|
228 decode_object $1
|
|
337
|
229 if test $type = $Lisp_Type_Int; then
|
|
272
|
230 print -f"Integer: %d" $val
|
|
337
|
231 elif test $type = $Lisp_Type_Char; then
|
|
|
232 if test $[$val > 32 && $val < 128] = 1; then
|
|
272
|
233 print -f"Char: %c" $val
|
|
|
234 else
|
|
|
235 print -f"Char: %d" $val
|
|
|
236 fi
|
|
337
|
237 elif test $type = $Lisp_Type_String || lrecord_type_p string; then
|
|
272
|
238 pstruct Lisp_String
|
|
337
|
239 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
|
|
272
|
240 pstruct Lisp_Cons
|
|
337
|
241 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
|
|
272
|
242 pstruct Lisp_Symbol
|
|
|
243 echo "Symbol name: $[(char *)($xstruct->name->_data)]"
|
|
337
|
244 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
|
|
272
|
245 pstruct Lisp_Vector
|
|
|
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
|
|
|
250 pstruct buffer
|
|
|
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
|
|
|
256 pstruct Lisp_Charset
|
|
|
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
|
|
|
266 pstruct console
|
|
|
267 elif lrecord_type_p database; then
|
|
337
|
268 pstruct Lisp_Database
|
|
272
|
269 elif lrecord_type_p device; then
|
|
|
270 pstruct device
|
|
|
271 elif lrecord_type_p event; then
|
|
|
272 pstruct Lisp_Event
|
|
|
273 elif lrecord_type_p extent; then
|
|
|
274 pstruct extent
|
|
|
275 elif lrecord_type_p extent_auxiliary; then
|
|
|
276 pstruct extent_auxiliary
|
|
|
277 elif lrecord_type_p extent_info; then
|
|
|
278 pstruct extent_info
|
|
|
279 elif lrecord_type_p face; then
|
|
|
280 pstruct Lisp_Face
|
|
|
281 elif lrecord_type_p float; then
|
|
|
282 pstruct Lisp_Float
|
|
|
283 elif lrecord_type_p font_instance; then
|
|
|
284 pstruct Lisp_Font_Instance
|
|
|
285 elif lrecord_type_p frame; then
|
|
|
286 pstruct frame
|
|
|
287 elif lrecord_type_p glyph; then
|
|
|
288 pstruct Lisp_Glyph
|
|
|
289 elif lrecord_type_p hashtable; then
|
|
337
|
290 pstruct Lisp_Hash_Table
|
|
272
|
291 elif lrecord_type_p image_instance; then
|
|
|
292 pstruct Lisp_Image_Instance
|
|
|
293 elif lrecord_type_p keymap; then
|
|
337
|
294 pstruct Lisp_Keymap
|
|
272
|
295 elif lrecord_type_p lcrecord_list; then
|
|
|
296 pstruct lcrecord_list
|
|
|
297 elif lrecord_type_p lstream; then
|
|
|
298 pstruct lstream
|
|
|
299 elif lrecord_type_p marker; then
|
|
|
300 pstruct Lisp_Marker
|
|
|
301 elif lrecord_type_p opaque; then
|
|
|
302 pstruct Lisp_Opaque
|
|
|
303 elif lrecord_type_p opaque_list; then
|
|
|
304 pstruct Lisp_Opaque_List
|
|
|
305 elif lrecord_type_p popup_data; then
|
|
|
306 pstruct popup_data
|
|
|
307 elif lrecord_type_p process; then
|
|
|
308 pstruct Lisp_Process
|
|
|
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
|
|
|
314 pstruct Lisp_Subr
|
|
|
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
|
|
|
330 pstruct weak_list
|
|
|
331 elif lrecord_type_p window; then
|
|
|
332 pstruct window
|
|
|
333 elif lrecord_type_p window_configuration; then
|
|
|
334 pstruct window_config
|
|
337
|
335 elif test "$type" = "null_pointer"; then
|
|
|
336 echo "Lisp Object is a null pointer!!"
|
|
272
|
337 else
|
|
|
338 echo "Unknown Lisp Object type"
|
|
|
339 print $1
|
|
|
340 fi
|
|
|
341 }
|
|
2
|
342
|
|
|
343 function pproc {
|
|
|
344 print *(`process.c`struct Lisp_Process*)$1 ;
|
|
272
|
345 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
|
|
|
346 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
|
|
2
|
347 }
|
|
|
348
|
|
|
349 dbxenv suppress_startup_message 4.0
|
|
337
|
350 dbxenv mt_watchpoints on
|
|
2
|
351
|
|
|
352 function dp_core {
|
|
|
353 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
|
|
|
354 }
|
|
|
355
|
|
|
356 # Barf!
|
|
|
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)
|
|
|
359 }
|
|
337
|
360
|
|
|
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"; }
|
|
|
367 test_various_objects
|
|
|
368 }
|
|
|
369
|
|
|
370 function test_pobj {
|
|
|
371 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
|
|
|
372 test_various_objects
|
|
|
373 }
|
|
|
374
|
|
|
375 function test_various_objects {
|
|
|
376 doit Vemacs_major_version
|
|
|
377 doit Vhelp_char
|
|
|
378 doit Qnil
|
|
|
379 doit Qunbound
|
|
|
380 doit Vobarray
|
|
|
381 doit Vall_weak_lists
|
|
|
382 doit Vxemacs_codename
|
|
|
383 }
|
