Mercurial > hg > xemacs-beta

comparison src/.dbxrc.in @ 3092:141c2920ea48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-11-25 01:41:31 by crestani] Incremental Garbage Collector
author crestani
date Fri, 25 Nov 2005 01:42:08 +0000
parents
children
comparison
equal deleted inserted replaced
3091:c22d8984148c 3092:141c2920ea48
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
41 #define NOT_C_CODE
42 #include "config.h"
43
44 if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
45
46 dbxenv language_mode ansic
47
48 ignore POLL
49 ignore IO
50
51 #ifdef VDB_POSIX
52 ignore SIGSEGV SIGBUS
53 #endif
54
55 document lbt << 'end'
56 Usage: lbt
57 Print the current Lisp stack trace.
58 Requires a running xemacs process.
59 end
60
61 function lbt {
62 call debug_backtrace()
63 }
64
65 document ldp << 'end'
66 Usage: ldp lisp_object
67 Print a Lisp Object value using the Lisp printer.
68 Requires a running xemacs process.
69 end
70
71 function ldp {
72 call debug_print ($1);
73 }
74
75 Lisp_Type_Int=-2
76
77 ## A bug in dbx prevents string variables from having values beginning with `-'!!
78 function XEmacsInit {
79 function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
80 ToInt dbg_USE_UNION_TYPE
81 ToInt Lisp_Type_Char
82 ToInt Lisp_Type_Record
83 ToInt dbg_valbits
84 ToInt dbg_gctypebits
85 function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
86 ToLong dbg_valmask
87 ToLong dbg_typemask
88 xemacs_initted=yes
89 }
90
91 function printvar {
92 for i in $*; do eval "echo $i=\$$i"; done
93 }
94
95 document decode_object << 'end'
96 Usage: decode_object lisp_object
97 Extract implementation information from a Lisp Object.
98 Defines variables $val, $type and $imp.
99 end
100
101 ## Various dbx bugs cause ugliness in following code
102 function decode_object {
103 if test -z "$xemacs_initted"; then XEmacsInit; fi;
104 if test $dbg_USE_UNION_TYPE = 1; then
105 ## Repeat after me... dbx sux, dbx sux, dbx sux...
106 ## Allow both `pobj Qnil' and `pobj 0x82746834' to work
107 case $(whatis $1) in
108 *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
109 *) obj="$[(`alloc.c`unsigned long)($1)]";;
110 esac
111 else
112 obj="$[(`alloc.c`unsigned long)($1)]";
113 fi
114 if test $[(int)($obj & 1)] = 1; then
115 ## It's an int
116 val=$[(long)(((unsigned long long)$obj) >> 1)]
117 type=$Lisp_Type_Int
118 else
119 type=$[(int)(((void*)$obj) & $dbg_typemask)]
120 if test $type = $Lisp_Type_Char; then
121 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
122 else
123 ## It's a record pointer
124 val=$[(void*)$obj]
125 if test "$val" = "(nil)"; then type=null_pointer; fi
126 fi
127 fi
128
129 if test $type = $Lisp_Type_Record; then
130 lheader="((struct lrecord_header *) $val)"
131 lrecord_type=$[(enum lrecord_type) $lheader->type]
132 imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
133 else
134 lheader="((struct lrecord_header *) -1)"
135 lrecord_type=-1
136 imp="0xdeadbeef"
137 fi
138 ## printvar obj val type imp
139 }
140
141 function xint {
142 decode_object "$*"
143 print (long) ($val)
144 }
145
146 document xtype << 'end'
147 Usage: xtype lisp_object
148 Print the Lisp type of a lisp object.
149 end
150
151 function xtype {
152 decode_object "$*"
153 if test $type = $Lisp_Type_Int; then echo "int"
154 elif test $type = $Lisp_Type_Char; then echo "char"
155 elif test $type = null_pointer; then echo "null_pointer"
156 else
157 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
158 fi
159 }
160
161 function lisp-shadows {
162 run -batch -vanilla -f list-load-path-shadows
163 }
164
165 function environment-to-run-temacs {
166 unset EMACSLOADPATH
167 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
168 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
169 }
170
171 document run-temacs << 'end'
172 Usage: run-temacs
173 Run temacs interactively, like xemacs.
174 Use this with debugging tools (like purify) that cannot deal with dumping,
175 or when temacs builds successfully, but xemacs does not.
176 end
177
178 function run-temacs {
179 environment-to-run-temacs
180 run -nd -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"}
181 }
182
183 document check-xemacs << 'end'
184 Usage: check-xemacs
185 Run the test suite. Equivalent to 'make check'.
186 end
187
188 function check-xemacs {
189 run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
190 }
191
192 document check-temacs << 'end'
193 Usage: check-temacs
194 Run the test suite on temacs. Equivalent to 'make check-temacs'.
195 Use this with debugging tools (like purify) that cannot deal with dumping,
196 or when temacs builds successfully, but xemacs does not.
197 end
198
199 function check-temacs {
200 run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
201 }
202
203 document update-elc << 'end'
204 Usage: update-elc
205 Run the core lisp byte compilation part of the build procedure.
206 Use when debugging temacs, not xemacs!
207 Use this when temacs builds successfully, but xemacs does not.
208 end
209
210 function update-elc {
211 environment-to-run-temacs
212 run -nd -batch -l ../lisp/update-elc.el
213 }
214
215 document dmp << 'end'
216 Usage: dmp
217 Run the dumping part of the build procedure.
218 Use when debugging temacs, not xemacs!
219 Use this when temacs builds successfully, but xemacs does not.
220 end
221
222 function dmp {
223 environment-to-run-temacs
224 run -nd -batch -l ../lisp/loadup.el dump
225 }
226
227 function pstruct { ## pstruct foo.c struct-name
228 module "$1" > /dev/null
229 type_ptr="((struct $2 *) $val)"
230 print $type_ptr
231 print *$type_ptr
232 }
233
234 document pobj << 'end'
235 Usage: pobj lisp_object
236 Print the internal C representation of a Lisp Object.
237 end
238
239 function pobj {
240 decode_object $1
241 if test $type = $Lisp_Type_Int; then
242 print -f"Integer: %d" $val
243 elif test $type = $Lisp_Type_Char; then
244 if test $[$val > 32 && $val < 128] = 1; then
245 print -f"Char: %c" $val
246 else
247 print -f"Char: %d" $val
248 fi
249 elif test $lrecord_type = lrecord_type_string; then
250 pstruct alloc.c Lisp_String
251 elif test $lrecord_type = lrecord_type_cons; then
252 pstruct alloc.c Lisp_Cons
253 elif test $lrecord_type = lrecord_type_symbol; then
254 pstruct symbols.c Lisp_Symbol
255 echo "Symbol name: $[(char *)($type_ptr->name->data)]"
256 elif test $lrecord_type = lrecord_type_vector; then
257 pstruct alloc.c Lisp_Vector
258 echo "Vector of length $[$type_ptr->size]"
259 elif test $lrecord_type = lrecord_type_bit_vector; then
260 pstruct fns.c Lisp_Bit_Vector
261 elif test $lrecord_type = lrecord_type_buffer; then
262 pstruct buffer.c buffer
263 elif test $lrecord_type = lrecord_type_char_table; then
264 pstruct chartab.c Lisp_Char_Table
265 elif test $lrecord_type = lrecord_type_char_table_entry; then
266 pstruct chartab.c Lisp_Char_Table_Entry
267 elif test $lrecord_type = lrecord_type_charset; then
268 pstruct mule-charset.c Lisp_Charset
269 elif test $lrecord_type = lrecord_type_coding_system; then
270 pstruct file-coding.c Lisp_Coding_System
271 elif test $lrecord_type = lrecord_type_color_instance; then
272 pstruct objects.c Lisp_Color_Instance
273 elif test $lrecord_type = lrecord_type_command_builder; then
274 pstruct event-stream.c command_builder
275 elif test $lrecord_type = lrecord_type_compiled_function; then
276 pstruct bytecode.c Lisp_Compiled_Function
277 elif test $lrecord_type = lrecord_type_console; then
278 pstruct console.c console
279 elif test $lrecord_type = lrecord_type_database; then
280 pstruct database.c Lisp_Database
281 elif test $lrecord_type = lrecord_type_device; then
282 pstruct device.c device
283 elif test $lrecord_type = lrecord_type_event; then
284 pstruct events.c Lisp_Event
285 elif test $lrecord_type = lrecord_type_extent; then
286 pstruct extents.c extent
287 elif test $lrecord_type = lrecord_type_extent_auxiliary; then
288 pstruct extents.c extent_auxiliary
289 elif test $lrecord_type = lrecord_type_extent_info; then
290 pstruct extents.c extent_info
291 elif test $lrecord_type = lrecord_type_face; then
292 pstruct faces.c Lisp_Face
293 elif test $lrecord_type = lrecord_type_float; then
294 pstruct floatfns.c Lisp_Float
295 elif test $lrecord_type = lrecord_type_font_instance; then
296 pstruct objects.c Lisp_Font_Instance
297 elif test $lrecord_type = lrecord_type_frame; then
298 pstruct frame.c frame
299 elif test $lrecord_type = lrecord_type_glyph; then
300 pstruct glyph.c Lisp_Glyph
301 elif test $lrecord_type = lrecord_type_gui_item; then
302 pstruct gui.c Lisp_Gui_Item
303 elif test $lrecord_type = lrecord_type_hash_table; then
304 pstruct elhash.c Lisp_Hash_Table
305 elif test $lrecord_type = lrecord_type_image_instance; then
306 pstruct glyphs.c Lisp_Image_Instance
307 elif test $lrecord_type = lrecord_type_keymap; then
308 pstruct keymap.c Lisp_Keymap
309 elif test $lrecord_type = lrecord_type_lcrecord_list; then
310 pstruct alloc.c lcrecord_list
311 elif test $lrecord_type = lrecord_type_ldap; then
312 pstruct ldap.c Lisp_LDAP
313 elif test $lrecord_type = lrecord_type_lstream; then
314 pstruct lstream.c lstream
315 elif test $lrecord_type = lrecord_type_marker; then
316 pstruct marker.c Lisp_Marker
317 elif test $lrecord_type = lrecord_type_opaque; then
318 pstruct opaque.c Lisp_Opaque
319 elif test $lrecord_type = lrecord_type_opaque_ptr; then
320 pstruct opaque.c Lisp_Opaque_Ptr
321 elif test $lrecord_type = lrecord_type_popup_data; then
322 pstruct gui-x.c popup_data
323 elif test $lrecord_type = lrecord_type_process; then
324 pstruct process.c Lisp_Process
325 elif test $lrecord_type = lrecord_type_range_table; then
326 pstruct rangetab.c Lisp_Range_Table
327 elif test $lrecord_type = lrecord_type_specifier; then
328 pstruct specifier.c Lisp_Specifier
329 elif test $lrecord_type = lrecord_type_subr; then
330 pstruct eval.c Lisp_Subr
331 elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then
332 pstruct symbols.c symbol_value_buffer_local
333 elif test $lrecord_type = lrecord_type_symbol_value_forward; then
334 pstruct symbols.c symbol_value_forward
335 elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then
336 pstruct symbols.c symbol_value_lisp_magic
337 elif test $lrecord_type = lrecord_type_symbol_value_varalias; then
338 pstruct symbols.c symbol_value_varalias
339 elif test $lrecord_type = lrecord_type_timeout; then
340 pstruct event-stream.c Lisp_Timeout
341 elif test $lrecord_type = lrecord_type_toolbar_button; then
342 pstruct toolbar.c toolbar_button
343 elif test $lrecord_type = lrecord_type_tooltalk_message; then
344 pstruct tooltalk.c Lisp_Tooltalk_Message
345 elif test $lrecord_type = lrecord_type_tooltalk_pattern; then
346 pstruct tooltalk.c Lisp_Tooltalk_Pattern
347 elif test $lrecord_type = lrecord_type_weak_list; then
348 pstruct data.c weak_list
349 elif test $lrecord_type = lrecord_type_window; then
350 pstruct window.c window
351 elif test $lrecord_type = lrecord_type_window_configuration; then
352 pstruct window.c window_config
353 elif test "$type" = "null_pointer"; then
354 echo "Lisp Object is a null pointer!!"
355 else
356 echo "Unknown Lisp Object type"
357 print $1
358 fi
359 }
360
361 dbxenv suppress_startup_message 4.0
362 ## dbxenv mt_watchpoints on
363
364 function dp_core {
365 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
366 }
367
368 ## Barf!
369 function print_shell {
370 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
371 }
372
373 ## -------------------------------------------------------------
374 ## functions to test the debugging support itself.
375 ## If you change this file, make sure the following still work...
376 ## -------------------------------------------------------------
377 function test_xtype {
378 function doit { echo -n "$1: "; xtype "$1"; }
379 test_various_objects
380 }
381
382 function test_pobj {
383 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
384 test_various_objects
385 }
386
387 function test_various_objects {
388 doit Vemacs_major_version
389 doit Vhelp_char
390 doit Qnil
391 doit Qunbound
392 doit Vobarray
393 doit Vall_weak_lists
394 doit Vxemacs_codename
395 }