Mercurial > hg > xemacs-beta

comparison src/dbxrc @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents fbbf69b4e8a7
children 8626e4521993
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
21 # Author: Martin Buchholz 21 # Author: Martin Buchholz
22 22
23 # You can use this file to debug XEmacs using Sun WorkShop's dbx. 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 24 # Add the contents of this file to $HOME/.dbxrc or
25 # Source the contents of this file with something like: 25 # Source the contents of this file with something like:
26 # if test -r ./dbxrc; then . ./dbxrc; fi 26 # test -r ./dbxrc && . ./dbxrc
27 27
28 # Some functions defined here require a running process, but most 28 # Some functions defined here require a running process, but most
29 # don't. Considerable effort has been expended to this end. 29 # don't. Considerable effort has been expended to this end.
30 30
31 # See also the comments in gdbinit. 31 # See also the comments in gdbinit.
56 call debug_print ($1); 56 call debug_print ($1);
57 } 57 }
58 58
59 # A bug in dbx prevents string variables from having values beginning with `-'!! 59 # A bug in dbx prevents string variables from having values beginning with `-'!!
60 function XEmacsInit { 60 function XEmacsInit {
61 function ToInt { eval "$1=\$[(int) $1]"; } 61 eval $(echo $(whatis -t `alloc.c`dbg_constants) | \
62 ToInt dbg_USE_MINIMAL_TAGBITS 62 perl -e 'print "@{[map {s/=(-\d+)/sprintf(q[=0x%x],$1)/oge; /\w+=[0-9a-fx]+/og} <>]}\n"')
63 ToInt dbg_USE_UNION_TYPE
64 ToInt dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
65 ToInt Lisp_Type_Int
66 ToInt Lisp_Type_Char
67 ToInt Lisp_Type_Cons
68 ToInt Lisp_Type_String
69 ToInt Lisp_Type_Vector
70 ToInt Lisp_Type_Symbol
71 ToInt Lisp_Type_Record
72 ToInt dbg_valbits
73 ToInt dbg_gctypebits
74 function ToLong { eval "$1=\$[(unsigned long) $1]"; }
75 ToLong dbg_valmask
76 ToLong dbg_typemask
77 xemacs_initted=yes 63 xemacs_initted=yes
64 #printvar dbg_valbits dbg_valmask
78 } 65 }
79 66
80 function printvar { 67 function printvar {
81 for i in $*; do eval "echo $i=\$$i"; done 68 for i in $*; do eval "echo $i=\$$i"; done
82 } 69 }
87 Defines variables $val, $type and $imp. 74 Defines variables $val, $type and $imp.
88 end 75 end
89 76
90 # Various dbx bugs cause ugliness in following code 77 # Various dbx bugs cause ugliness in following code
91 function decode_object { 78 function decode_object {
92 if test -z "$xemacs_initted"; then XEmacsInit; fi; 79 test -z "$xemacs_initted" && XEmacsInit
93 if test $dbg_USE_UNION_TYPE = 1; then 80 obj=$[*(void**)(&$1)]
94 # Repeat after me... dbx sux, dbx sux, dbx sux... 81 test "$obj" = "(nil)" && obj="0x0"
95 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
96 case $(whatis $1) in
97 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
98 *) obj="$[(unsigned long)($1)]";;
99 esac
100 else
101 obj="$[(unsigned long)($1)]";
102 fi
103 if test $dbg_USE_MINIMAL_TAGBITS = 1; then 82 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
104 if test $[(int)($obj & 1)] = 1; then 83 if test $[(int)($obj & 1)] = 1; then
105 # It's an int 84 # It's an int
106 val=$[(long)(((unsigned long long)$obj) >> 1)] 85 val=$[(long)(((unsigned long long)$obj) >> 1)]
107 type=$Lisp_Type_Int 86 type=$dbg_Lisp_Type_Int
108 else 87 else
109 type=$[(int)(((void*)$obj) & $dbg_typemask)] 88 type=$[(int)(((void*)$obj) & $dbg_typemask)]
110 if test $type = $Lisp_Type_Char; then 89 if test $type = $dbg_Lisp_Type_Char; then
111 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] 90 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
112 else 91 else
113 # It's a record pointer 92 # It's a record pointer
114 val=$[(void*)$obj] 93 val=$[(void*)$obj]
115 if test "$val" = "(nil)"; then type=null_pointer; fi
116 fi 94 fi
117 fi 95 fi
118 else 96 else
119 # not dbg_USE_MINIMAL_TAGBITS 97 # not dbg_USE_MINIMAL_TAGBITS
98 val=$[(void*)($obj & $dbg_valmask)]
99 test "$val" = "(nil)" && val="0x0"
120 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))] 100 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
121 if test "$type" = $Lisp_Type_Int; then
122 val=$[(int)($obj & $dbg_valmask)]
123 elif test "$type" = $Lisp_Type_Char; then
124 val=$[(int)($obj & $dbg_valmask)]
125 else
126 val=$[(void*)($obj & $dbg_valmask)]
127 if test "$val" = "(nil)"; then type=null_pointer; fi
128 fi
129 #val=$[(void*)($obj & $dbg_valmask)]
130 #printvar val type obj
131 fi 101 fi
132 102
133 if test $type = $Lisp_Type_Record; then 103 if test $type = $dbg_Lisp_Type_Record; then
134 typeset lheader="((struct lrecord_header *) $val)" 104 typeset lheader="((struct lrecord_header *) $val)"
135 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then 105 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
136 imp=$[(void*)(lrecord_implementations_table[$lheader->type])] 106 imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
137 else 107 else
138 imp=$[(void*)($lheader->implementation)] 108 imp=$[(void*)($lheader->implementation)]
139 fi 109 fi
140 else 110 else
141 imp="0xdeadbeef" 111 imp="0xdeadbeef"
142 fi 112 fi
143 # printvar obj val type imp 113 #printvar obj val type imp
144 } 114 }
145 115
146 function xint { 116 function xint {
147 decode_object "$*" 117 decode_object "$*"
148 print (long) ($val) 118 print (long) ($val)
149 } 119 }
150 120
151 function xtype { 121 function xtype {
152 decode_object "$*" 122 decode_object "$*"
153 if test $type = $Lisp_Type_Int; then echo "int" 123 if test $type = $dbg_Lisp_Type_Int; then echo "int"
154 elif test $type = $Lisp_Type_Char; then echo "char" 124 elif test $type = $dbg_Lisp_Type_Char; then echo "char"
155 elif test $type = $Lisp_Type_Symbol; then echo "symbol" 125 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
156 elif test $type = $Lisp_Type_String; then echo "string" 126 elif test $type = $dbg_Lisp_Type_String; then echo "string"
157 elif test $type = $Lisp_Type_Vector; then echo "vector" 127 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
158 elif test $type = $Lisp_Type_Cons; then echo "cons" 128 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
159 elif test $type = null_pointer; then echo "null_pointer"
160 else 129 else
161 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" 130 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
162 fi 131 fi
163 }
164
165 function lisp-shadows {
166 run -batch -vanilla -f list-load-path-shadows
167 }
168
169 function environment-to-run-temacs {
170 unset EMACSLOADPATH
171 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
172 export EMACSBOOTSTRAPMODULEPATH=../modules/:..
173 } 132 }
174 133
175 document run-temacs << 'end' 134 document run-temacs << 'end'
176 Usage: run-temacs 135 Usage: run-temacs
177 Run temacs interactively, like xemacs. 136 Run temacs interactively, like xemacs.
178 Use this with debugging tools (like purify) that cannot deal with dumping, 137 Use this with debugging tools (like purify) that cannot deal with dumping,
179 or when temacs builds successfully, but xemacs does not. 138 or when temacs builds successfully, but xemacs does not.
180 end 139 end
181 140
182 function run-temacs { 141 function run-temacs {
183 environment-to-run-temacs 142 unset EMACSLOADPATH
143 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
184 run -batch -l ../lisp/loadup.el run-temacs -q 144 run -batch -l ../lisp/loadup.el run-temacs -q
185 } 145 }
186 146
187 document update-elc << 'end' 147 document update-elc << 'end'
188 Usage: update-elc 148 Usage: update-elc
190 Use when debugging temacs, not xemacs! 150 Use when debugging temacs, not xemacs!
191 Use this when temacs builds successfully, but xemacs does not. 151 Use this when temacs builds successfully, but xemacs does not.
192 end 152 end
193 153
194 function update-elc { 154 function update-elc {
195 environment-to-run-temacs 155 unset EMACSLOADPATH
156 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
196 run -batch -l ../lisp/update-elc.el 157 run -batch -l ../lisp/update-elc.el
197 } 158 }
198 159
199 160
200 function dump-temacs { 161 function dump-temacs {
201 environment-to-run-temacs 162 unset EMACSLOADPATH
163 export EMACSBOOTSTRAPLOADPATH=../lisp/:..
202 run -batch -l ../lisp/loadup.el dump 164 run -batch -l ../lisp/loadup.el dump
203 } 165 }
204 166
205 document dump-temacs << 'end' 167 document dump-temacs << 'end'
206 Usage: dump-temacs 168 Usage: dump-temacs
224 Print the internal C structure of a underlying Lisp Object. 186 Print the internal C structure of a underlying Lisp Object.
225 end 187 end
226 188
227 function pobj { 189 function pobj {
228 decode_object $1 190 decode_object $1
229 if test $type = $Lisp_Type_Int; then 191 if test $type = $dbg_Lisp_Type_Int; then
230 print -f"Integer: %d" $val 192 print -f"Integer: %d" $val
231 elif test $type = $Lisp_Type_Char; then 193 elif test $type = $dbg_Lisp_Type_Char; then
232 if test $[$val > 32 && $val < 128] = 1; then 194 if $val < 128; then
233 print -f"Char: %c" $val 195 print -f"Char: %c" $val
234 else 196 else
235 print -f"Char: %d" $val 197 print -f"Char: %d" $val
236 fi 198 fi
237 elif test $type = $Lisp_Type_String || lrecord_type_p string; then 199 elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
238 pstruct Lisp_String 200 pstruct Lisp_String
239 elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then 201 elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then
240 pstruct Lisp_Cons 202 pstruct Lisp_Cons
241 elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then 203 elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
242 pstruct Lisp_Symbol 204 pstruct Lisp_Symbol
243 echo "Symbol name: $[(char *)($xstruct->name->_data)]" 205 echo "Symbol name: $[(char *)($xstruct->name->_data)]"
244 elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then 206 elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
245 pstruct Lisp_Vector 207 pstruct Lisp_Vector
246 echo "Vector of length $[$xstruct->size]" 208 echo "Vector of length $[$xstruct->size]"
247 elif lrecord_type_p bit_vector; then 209 elif lrecord_type_p bit_vector; then
248 pstruct Lisp_Bit_Vector 210 pstruct Lisp_Bit_Vector
249 elif lrecord_type_p buffer; then 211 elif lrecord_type_p buffer; then
263 elif lrecord_type_p compiled_function; then 225 elif lrecord_type_p compiled_function; then
264 pstruct Lisp_Compiled_Function 226 pstruct Lisp_Compiled_Function
265 elif lrecord_type_p console; then 227 elif lrecord_type_p console; then
266 pstruct console 228 pstruct console
267 elif lrecord_type_p database; then 229 elif lrecord_type_p database; then
268 pstruct Lisp_Database 230 pstruct database
269 elif lrecord_type_p device; then 231 elif lrecord_type_p device; then
270 pstruct device 232 pstruct device
271 elif lrecord_type_p event; then 233 elif lrecord_type_p event; then
272 pstruct Lisp_Event 234 pstruct Lisp_Event
273 elif lrecord_type_p extent; then 235 elif lrecord_type_p extent; then
285 elif lrecord_type_p frame; then 247 elif lrecord_type_p frame; then
286 pstruct frame 248 pstruct frame
287 elif lrecord_type_p glyph; then 249 elif lrecord_type_p glyph; then
288 pstruct Lisp_Glyph 250 pstruct Lisp_Glyph
289 elif lrecord_type_p hashtable; then 251 elif lrecord_type_p hashtable; then
290 pstruct Lisp_Hash_Table 252 pstruct hashtable
291 elif lrecord_type_p image_instance; then 253 elif lrecord_type_p image_instance; then
292 pstruct Lisp_Image_Instance 254 pstruct Lisp_Image_Instance
293 elif lrecord_type_p keymap; then 255 elif lrecord_type_p keymap; then
294 pstruct Lisp_Keymap 256 pstruct keymap
295 elif lrecord_type_p lcrecord_list; then 257 elif lrecord_type_p lcrecord_list; then
296 pstruct lcrecord_list 258 pstruct lcrecord_list
297 elif lrecord_type_p lstream; then 259 elif lrecord_type_p lstream; then
298 pstruct lstream 260 pstruct lstream
299 elif lrecord_type_p marker; then 261 elif lrecord_type_p marker; then
330 pstruct weak_list 292 pstruct weak_list
331 elif lrecord_type_p window; then 293 elif lrecord_type_p window; then
332 pstruct window 294 pstruct window
333 elif lrecord_type_p window_configuration; then 295 elif lrecord_type_p window_configuration; then
334 pstruct window_config 296 pstruct window_config
335 elif test "$type" = "null_pointer"; then
336 echo "Lisp Object is a null pointer!!"
337 else 297 else
338 echo "Unknown Lisp Object type" 298 echo "Unknown Lisp Object type"
339 print $1 299 print $1
340 fi 300 fi
341 } 301 }
345 ldp "(`process.c`struct Lisp_Process*)$1->name" ; 305 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
346 ldp "(`process.c`struct Lisp_Process*)$1->command" ; 306 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
347 } 307 }
348 308
349 dbxenv suppress_startup_message 4.0 309 dbxenv suppress_startup_message 4.0
350 dbxenv mt_watchpoints on
351 310
352 function dp_core { 311 function dp_core {
353 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core 312 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
354 } 313 }
355 314
356 # Barf! 315 # Barf!
357 function print_shell { 316 function print_shell {
358 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget) 317 print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
359 } 318 }
360
361 # -------------------------------------------------------------
362 # functions to test the debugging support itself.
363 # If you change this file, make sure the following still work...
364 # -------------------------------------------------------------
365 function test_xtype {
366 function doit { echo -n "$1: "; xtype "$1"; }
367 test_various_objects
368 }
369
370 function test_pobj {
371 function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
372 test_various_objects
373 }
374
375 function test_various_objects {
376 doit Vemacs_major_version
377 doit Vhelp_char
378 doit Qnil
379 doit Qunbound
380 doit Vobarray
381 doit Vall_weak_lists
382 doit Vxemacs_codename
383 }