Mercurial > hg > xemacs-beta

comparison src/dbxrc @ 412:697ef44129c6 r21-2-14

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