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