Mercurial > hg > xemacs-beta

comparison src/.dbxrc.in @ 5601:3e5d5e8e4bb7

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