Mercurial > hg > xemacs-beta

comparison src/.dbxrc @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 # -*- ksh -*-
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
23 # You can use this file to debug XEmacs using Sun WorkShop's dbx.
24
25 # Some functions defined here require a running process, but most
26 # don't. Considerable effort has been expended to this end.
27
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.
31
32 # See also the comments in .gdbinit.
33
34 # See also the question of the XEmacs FAQ, titled
35 # "How to Debug an XEmacs problem with a debugger".
36
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
41
42 dbxenv language_mode ansic
43
44 ignore POLL
45 ignore IO
46
47 document lbt << 'end'
48 Usage: lbt
49 Print the current Lisp stack trace.
50 Requires a running xemacs process.
51 end
52
53 function lbt {
54 call debug_backtrace()
55 }
56
57 document ldp << 'end'
58 Usage: ldp lisp_object
59 Print a Lisp Object value using the Lisp printer.
60 Requires a running xemacs process.
61 end
62
63 function ldp {
64 call debug_print ($1);
65 }
66
67 # A bug in dbx prevents string variables from having values beginning with `-'!!
68 function XEmacsInit {
69 function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
70 ToInt dbg_USE_UNION_TYPE
71 ToInt Lisp_Type_Int
72 ToInt Lisp_Type_Char
73 ToInt Lisp_Type_Cons
74 ToInt Lisp_Type_String
75 ToInt Lisp_Type_Vector
76 ToInt Lisp_Type_Symbol
77 ToInt Lisp_Type_Record
78 ToInt dbg_valbits
79 ToInt dbg_gctypebits
80 function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
81 ToLong dbg_valmask
82 ToLong dbg_typemask
83 xemacs_initted=yes
84 }
85
86 function printvar {
87 for i in $*; do eval "echo $i=\$$i"; done
88 }
89
90 document decode_object << 'end'
91 Usage: decode_object lisp_object
92 Extract implementation information from a Lisp Object.
93 Defines variables $val, $type and $imp.
94 end
95
96 # Various dbx bugs cause ugliness in following code
97 function decode_object {
98 if test -z "$xemacs_initted"; then XEmacsInit; fi;
99 if test $dbg_USE_UNION_TYPE = 1; then
100 # Repeat after me... dbx sux, dbx sux, dbx sux...
101 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
102 case $(whatis $1) in
103 *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
104 *) obj="$[(`alloc.c`unsigned long)($1)]";;
105 esac
106 else
107 obj="$[(`alloc.c`unsigned long)($1)]";
108 fi
109 if test $[(int)($obj & 1)] = 1; then
110 # It's an int
111 val=$[(long)(((unsigned long long)$obj) >> 1)]
112 type=$Lisp_Type_Int
113 else
114 type=$[(int)(((void*)$obj) & $dbg_typemask)]
115 if test $type = $Lisp_Type_Char; then
116 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
117 else
118 # It's a record pointer
119 val=$[(void*)$obj]
120 if test "$val" = "(nil)"; then type=null_pointer; fi
121 fi
122 fi
123
124 if test $type = $Lisp_Type_Record; then
125 typeset lheader="((struct lrecord_header *) $val)"
126 imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
127 else
128 imp="0xdeadbeef"
129 fi
130 # printvar obj val type imp
131 }
132
133 function xint {
134 decode_object "$*"
135 print (long) ($val)
136 }
137
138 document xtype << 'end'
139 Usage: xtype lisp_object
140 Print the Lisp type of a lisp object.
141 end
142
143 function xtype {
144 decode_object "$*"
145 if test $type = $Lisp_Type_Int; then echo "int"
146 elif test $type = $Lisp_Type_Char; then echo "char"
147 elif test $type = $Lisp_Type_Symbol; then echo "symbol"
148 elif test $type = $Lisp_Type_String; then echo "string"
149 elif test $type = $Lisp_Type_Vector; then echo "vector"
150 elif test $type = $Lisp_Type_Cons; then echo "cons"
151 elif test $type = null_pointer; then echo "null_pointer"
152 else
153 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
154 fi
155 }
156
157 function lisp-shadows {
158 run -batch -vanilla -f list-load-path-shadows
159 }
160
161 function environment-to-run-temacs {
162 unset EMACSLOADPATH
163 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
164 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
165 }
166
167 document run-temacs << 'end'
168 Usage: run-temacs
169 Run temacs interactively, like xemacs.
170 Use this with debugging tools (like purify) that cannot deal with dumping,
171 or when temacs builds successfully, but xemacs does not.
172 end
173
174 function run-temacs {
175 environment-to-run-temacs
176 run -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"}
177 }
178
179 document check-xemacs << 'end'
180 Usage: check-xemacs
181 Run the test suite. Equivalent to 'make check'.
182 end
183
184 function check-xemacs {
185 run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
186 }
187
188 document check-temacs << 'end'
189 Usage: check-temacs
190 Run the test suite on temacs. Equivalent to 'make check-temacs'.
191 Use this with debugging tools (like purify) that cannot deal with dumping,
192 or when temacs builds successfully, but xemacs does not.
193 end
194
195 function check-temacs {
196 run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
197 }
198
199 document update-elc << 'end'
200 Usage: update-elc
201 Run the core lisp byte compilation part of the build procedure.
202 Use when debugging temacs, not xemacs!
203 Use this when temacs builds successfully, but xemacs does not.
204 end
205
206 function update-elc {
207 environment-to-run-temacs
208 run -batch -l ../lisp/update-elc.el
209 }
210
211 document dump-temacs << 'end'
212 Usage: dump-temacs
213 Run the dumping 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 dump-temacs {
219 environment-to-run-temacs
220 run -batch -l ../lisp/loadup.el dump
221 }
222
223 function pstruct {
224 xstruct="((struct $1 *) $val)"
225 print $xstruct
226 print *$xstruct
227 }
228
229 function lrecord_type_p {
230 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
231 }
232
233 document pobj << 'end'
234 Usage: pobj lisp_object
235 Print the internal C representation of a Lisp Object.
236 end
237
238 function pobj {
239 decode_object $1
240 if test $type = $Lisp_Type_Int; then
241 print -f"Integer: %d" $val
242 elif test $type = $Lisp_Type_Char; then
243 if test $[$val > 32 && $val < 128] = 1; then
244 print -f"Char: %c" $val
245 else
246 print -f"Char: %d" $val
247 fi
248 elif test $type = $Lisp_Type_String || lrecord_type_p string; then
249 pstruct Lisp_String
250 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
251 pstruct Lisp_Cons
252 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
253 pstruct Lisp_Symbol
254 echo "Symbol name: $[(char *)($xstruct->name->data)]"
255 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
256 pstruct Lisp_Vector
257 echo "Vector of length $[$xstruct->size]"
258 elif lrecord_type_p bit_vector; then
259 pstruct Lisp_Bit_Vector
260 elif lrecord_type_p buffer; then
261 pstruct buffer
262 elif lrecord_type_p char_table; then
263 pstruct Lisp_Char_Table
264 elif lrecord_type_p char_table_entry; then
265 pstruct Lisp_Char_Table_Entry
266 elif lrecord_type_p charset; then
267 pstruct Lisp_Charset
268 elif lrecord_type_p coding_system; then
269 pstruct Lisp_Coding_System
270 elif lrecord_type_p color_instance; then
271 pstruct Lisp_Color_Instance
272 elif lrecord_type_p command_builder; then
273 pstruct command_builder
274 elif lrecord_type_p compiled_function; then
275 pstruct Lisp_Compiled_Function
276 elif lrecord_type_p console; then
277 pstruct console
278 elif lrecord_type_p database; then
279 pstruct Lisp_Database
280 elif lrecord_type_p device; then
281 pstruct device
282 elif lrecord_type_p event; then
283 pstruct Lisp_Event
284 elif lrecord_type_p extent; then
285 pstruct extent
286 elif lrecord_type_p extent_auxiliary; then
287 pstruct extent_auxiliary
288 elif lrecord_type_p extent_info; then
289 pstruct extent_info
290 elif lrecord_type_p face; then
291 pstruct Lisp_Face
292 elif lrecord_type_p float; then
293 pstruct Lisp_Float
294 elif lrecord_type_p font_instance; then
295 pstruct Lisp_Font_Instance
296 elif lrecord_type_p frame; then
297 pstruct frame
298 elif lrecord_type_p glyph; then
299 pstruct Lisp_Glyph
300 elif lrecord_type_p hash_table; then
301 pstruct Lisp_Hash_Table
302 elif lrecord_type_p image_instance; then
303 pstruct Lisp_Image_Instance
304 elif lrecord_type_p keymap; then
305 pstruct Lisp_Keymap
306 elif lrecord_type_p lcrecord_list; then
307 pstruct lcrecord_list
308 elif lrecord_type_p lstream; then
309 pstruct lstream
310 elif lrecord_type_p marker; then
311 pstruct Lisp_Marker
312 elif lrecord_type_p opaque; then
313 pstruct Lisp_Opaque
314 elif lrecord_type_p opaque_ptr; then
315 pstruct Lisp_Opaque_Ptr
316 elif lrecord_type_p popup_data; then
317 pstruct popup_data
318 elif lrecord_type_p process; then
319 pstruct Lisp_Process
320 elif lrecord_type_p range_table; then
321 pstruct Lisp_Range_Table
322 elif lrecord_type_p specifier; then
323 pstruct Lisp_Specifier
324 elif lrecord_type_p subr; then
325 pstruct Lisp_Subr
326 elif lrecord_type_p symbol_value_buffer_local; then
327 pstruct symbol_value_buffer_local
328 elif lrecord_type_p symbol_value_forward; then
329 pstruct symbol_value_forward
330 elif lrecord_type_p symbol_value_lisp_magic; then
331 pstruct symbol_value_lisp_magic
332 elif lrecord_type_p symbol_value_varalias; then
333 pstruct symbol_value_varalias
334 elif lrecord_type_p toolbar_button; then
335 pstruct toolbar_button
336 elif lrecord_type_p tooltalk_message; then
337 pstruct Lisp_Tooltalk_Message
338 elif lrecord_type_p tooltalk_pattern; then
339 pstruct Lisp_Tooltalk_Pattern
340 elif lrecord_type_p weak_list; then
341 pstruct weak_list
342 elif lrecord_type_p window; then
343 pstruct window
344 elif lrecord_type_p window_configuration; then
345 pstruct window_config
346 elif test "$type" = "null_pointer"; then
347 echo "Lisp Object is a null pointer!!"
348 else
349 echo "Unknown Lisp Object type"
350 print $1
351 fi
352 }
353
354 function pproc {
355 print *(`process.c`struct Lisp_Process*)$1 ;
356 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
357 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
358 }
359
360 dbxenv suppress_startup_message 4.0
361 dbxenv mt_watchpoints on
362
363 function dp_core {
364 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
365 }
366
367 # Barf!
368 function print_shell {
369 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
372 # -------------------------------------------------------------
373 # functions to test the debugging support itself.
374 # If you change this file, make sure the following still work...
375 # -------------------------------------------------------------
376 function test_xtype {
377 function doit { echo -n "$1: "; xtype "$1"; }
378 test_various_objects
379 }
380
381 function test_pobj {
382 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
383 test_various_objects
384 }
385
386 function test_various_objects {
387 doit Vemacs_major_version
388 doit Vhelp_char
389 doit Qnil
390 doit Qunbound
391 doit Vobarray
392 doit Vall_weak_lists
393 doit Vxemacs_codename
394 }