comparison etc/dbxrc.in @ 3418:a1e20876b806

[xemacs-hg @ 2006-05-23 13:18:50 by stephent] Generate dbx/gdb rc files right. <873bf0zz31.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Tue, 23 May 2006 13:18:56 +0000
parents
children 14f0dd1fabdb 8b2f75cecb89
comparison
equal deleted inserted replaced
3417:abdb33cc1f52 3418:a1e20876b806
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 }