Mercurial > hg > xemacs-beta

comparison src/dbxrc @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents cc15677e0335
children 6719134a07c2
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
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.
74 Defines variables $val, $type and $imp. 74 Defines variables $val, $type and $imp.
75 end 75 end
76 76
77 # Various dbx bugs cause ugliness in following code 77 # Various dbx bugs cause ugliness in following code
78 function decode_object { 78 function decode_object {
79 test -z "$xemacs_initted" && XEmacsInit 79 if test -z "$xemacs_initted"; then XEmacsInit; fi;
80 obj=$[*(void**)(&$1)] 80 if test $dbg_USE_UNION_TYPE = 1; then
81 test "$obj" = "(nil)" && obj="0x0" 81 # Repeat after me... dbx sux, dbx sux, dbx sux...
82 # Allow both `pobj Qnil' and `pobj 0x82746834' to work
83 case $(whatis $1) in
84 *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
85 *) obj="$[(unsigned long)($1)]";;
86 esac
87 else
88 obj="$[(unsigned long)($1)]";
89 fi
82 if test $dbg_USE_MINIMAL_TAGBITS = 1; then 90 if test $dbg_USE_MINIMAL_TAGBITS = 1; then
83 if test $[(int)($obj & 1)] = 1; then 91 if test $[(int)($obj & 1)] = 1; then
84 # It's an int 92 # It's an int
85 val=$[(long)(((unsigned long long)$obj) >> 1)] 93 val=$[(long)(((unsigned long long)$obj) >> 1)]
86 type=$dbg_Lisp_Type_Int 94 type=$dbg_Lisp_Type_Int
89 if test $type = $dbg_Lisp_Type_Char; then 97 if test $type = $dbg_Lisp_Type_Char; then
90 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] 98 val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
91 else 99 else
92 # It's a record pointer 100 # It's a record pointer
93 val=$[(void*)$obj] 101 val=$[(void*)$obj]
102 if test "$val" = "(nil)"; then type=null_pointer; fi
94 fi 103 fi
95 fi 104 fi
96 else 105 else
97 # not dbg_USE_MINIMAL_TAGBITS 106 # 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))] 107 type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
108 if test "$[$type == Lisp_Type_Int]" = 1; then
109 val=$[(int)($obj & $dbg_valmask)]
110 elif test "$[$type == Lisp_Type_Char]" = 1; then
111 val=$[(int)($obj & $dbg_valmask)]
112 else
113 val=$[(void*)($obj & $dbg_valmask)]
114 if test "$val" = "(nil)"; then type=null_pointer; fi
115 fi
116 #val=$[(void*)($obj & $dbg_valmask)]
117 #printvar val type obj
101 fi 118 fi
102 119
103 if test $type = $dbg_Lisp_Type_Record; then 120 if test $type = $dbg_Lisp_Type_Record; then
104 typeset lheader="((struct lrecord_header *) $val)" 121 typeset lheader="((struct lrecord_header *) $val)"
105 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then 122 if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
124 elif test $type = $dbg_Lisp_Type_Char; then echo "char" 141 elif test $type = $dbg_Lisp_Type_Char; then echo "char"
125 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol" 142 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
126 elif test $type = $dbg_Lisp_Type_String; then echo "string" 143 elif test $type = $dbg_Lisp_Type_String; then echo "string"
127 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector" 144 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
128 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons" 145 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
146 elif test $type = null_pointer; then echo "$type"
129 else 147 else
130 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" 148 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
131 fi 149 fi
132 } 150 }
133 151
225 elif lrecord_type_p compiled_function; then 243 elif lrecord_type_p compiled_function; then
226 pstruct Lisp_Compiled_Function 244 pstruct Lisp_Compiled_Function
227 elif lrecord_type_p console; then 245 elif lrecord_type_p console; then
228 pstruct console 246 pstruct console
229 elif lrecord_type_p database; then 247 elif lrecord_type_p database; then
230 pstruct database 248 pstruct Lisp_Database
231 elif lrecord_type_p device; then 249 elif lrecord_type_p device; then
232 pstruct device 250 pstruct device
233 elif lrecord_type_p event; then 251 elif lrecord_type_p event; then
234 pstruct Lisp_Event 252 pstruct Lisp_Event
235 elif lrecord_type_p extent; then 253 elif lrecord_type_p extent; then
246 pstruct Lisp_Font_Instance 264 pstruct Lisp_Font_Instance
247 elif lrecord_type_p frame; then 265 elif lrecord_type_p frame; then
248 pstruct frame 266 pstruct frame
249 elif lrecord_type_p glyph; then 267 elif lrecord_type_p glyph; then
250 pstruct Lisp_Glyph 268 pstruct Lisp_Glyph
251 elif lrecord_type_p hashtable; then 269 elif lrecord_type_p hash_table; then
252 pstruct hashtable 270 pstruct Lisp_Hash_Table
253 elif lrecord_type_p image_instance; then 271 elif lrecord_type_p image_instance; then
254 pstruct Lisp_Image_Instance 272 pstruct Lisp_Image_Instance
255 elif lrecord_type_p keymap; then 273 elif lrecord_type_p keymap; then
256 pstruct keymap 274 pstruct Lisp_Keymap
257 elif lrecord_type_p lcrecord_list; then 275 elif lrecord_type_p lcrecord_list; then
258 pstruct lcrecord_list 276 pstruct lcrecord_list
259 elif lrecord_type_p lstream; then 277 elif lrecord_type_p lstream; then
260 pstruct lstream 278 pstruct lstream
261 elif lrecord_type_p marker; then 279 elif lrecord_type_p marker; then
292 pstruct weak_list 310 pstruct weak_list
293 elif lrecord_type_p window; then 311 elif lrecord_type_p window; then
294 pstruct window 312 pstruct window
295 elif lrecord_type_p window_configuration; then 313 elif lrecord_type_p window_configuration; then
296 pstruct window_config 314 pstruct window_config
315 elif test "$type" = "null_pointer"; then
316 echo "Lisp Object is a null pointer!!"
297 else 317 else
298 echo "Unknown Lisp Object type" 318 echo "Unknown Lisp Object type"
299 print $1 319 print $1
300 fi 320 fi
301 } 321 }
305 ldp "(`process.c`struct Lisp_Process*)$1->name" ; 325 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
306 ldp "(`process.c`struct Lisp_Process*)$1->command" ; 326 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
307 } 327 }
308 328
309 dbxenv suppress_startup_message 4.0 329 dbxenv suppress_startup_message 4.0
330 dbxenv mt_watchpoints on
310 331
311 function dp_core { 332 function dp_core {
312 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core 333 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
313 } 334 }
314 335