Mercurial > hg > xemacs-beta

comparison src/dbxrc @ 337:fbbf69b4e8a7 r21-0-66

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