comparison src/gdbinit @ 396:6719134a07c2 r21-2-13

Import from CVS: tag r21-2-13
author cvs
date Mon, 13 Aug 2007 11:12:05 +0200
parents 1f50e6fe4f3f
children
comparison
equal deleted inserted replaced
395:de2c2a7459d2 396:6719134a07c2
51 set $obj = (unsigned long) $arg0 51 set $obj = (unsigned long) $arg0
52 if dbg_USE_MINIMAL_TAGBITS 52 if dbg_USE_MINIMAL_TAGBITS
53 if $obj & 1 53 if $obj & 1
54 # It's an int 54 # It's an int
55 set $val = $obj >> 1 55 set $val = $obj >> 1
56 set $type = dbg_Lisp_Type_Int 56 set $type = Lisp_Type_Int
57 else 57 else
58 set $type = $obj & dbg_typemask 58 set $type = $obj & dbg_typemask
59 if $type == dbg_Lisp_Type_Char 59 if $type == Lisp_Type_Char
60 set $val = ($obj & dbg_valmask) >> dbg_gctypebits 60 set $val = ($obj & dbg_valmask) >> dbg_gctypebits
61 else 61 else
62 # It's a record pointer 62 # It's a record pointer
63 set $val = $obj 63 set $val = $obj
64 end 64 end
67 # not dbg_USE_MINIMAL_TAGBITS 67 # not dbg_USE_MINIMAL_TAGBITS
68 set $val = $obj & dbg_valmask 68 set $val = $obj & dbg_valmask
69 set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1) 69 set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1)
70 end 70 end
71 71
72 if $type == dbg_Lisp_Type_Record 72 if $type == Lisp_Type_Record
73 set $lheader = (struct lrecord_header *) $val 73 set $lheader = (struct lrecord_header *) $val
74 if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION 74 if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
75 set $imp = lrecord_implementations_table[$lheader->type] 75 set $imp = lrecord_implementations_table[$lheader->type]
76 else 76 else
77 set $imp = $lheader->implementation 77 set $imp = $lheader->implementation
92 print ((long) $val) 92 print ((long) $val)
93 end 93 end
94 94
95 define xtype 95 define xtype
96 decode_object $arg0 96 decode_object $arg0
97 if $type == dbg_Lisp_Type_Int 97 if $type == Lisp_Type_Int
98 echo int\n 98 echo int\n
99 else 99 else
100 if $type == dbg_Lisp_Type_Char 100 if $type == Lisp_Type_Char
101 echo char\n 101 echo char\n
102 else 102 else
103 if $type == dbg_Lisp_Type_Symbol 103 if $type == Lisp_Type_Symbol
104 echo symbol\n 104 echo symbol\n
105 else 105 else
106 if $type == dbg_Lisp_Type_String 106 if $type == Lisp_Type_String
107 echo string\n 107 echo string\n
108 else 108 else
109 if $type == dbg_Lisp_Type_Vector 109 if $type == Lisp_Type_Vector
110 echo vector\n 110 echo vector\n
111 else 111 else
112 if $type == dbg_Lisp_Type_Cons 112 if $type == Lisp_Type_Cons
113 echo cons\n 113 echo cons\n
114 else 114 else
115 printf "record type: %s\n", $imp->name 115 printf "record type: %s\n", $imp->name
116 # barf 116 # barf
117 end 117 end
131 Run xemacs to check for lisp shadows 131 Run xemacs to check for lisp shadows
132 end 132 end
133 133
134 define environment-to-run-temacs 134 define environment-to-run-temacs
135 unset env EMACSLOADPATH 135 unset env EMACSLOADPATH
136 set env EMACSBOOTSTRAPLOADPATH = ../lisp/:.. 136 set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
137 set env EMACSBOOTSTRAPMODULEPATH = ../lisp/ 137 set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
138 end 138 end
139 139
140 define run-temacs 140 define run-temacs
141 environment-to-run-temacs 141 environment-to-run-temacs
142 run -batch -l ../lisp/loadup.el run-temacs -q 142 run -batch -l ../lisp/loadup.el run-temacs -q
195 Usage: lbt 195 Usage: lbt
196 Print the current Lisp stack trace. 196 Print the current Lisp stack trace.
197 Requires a running xemacs process. 197 Requires a running xemacs process.
198 end 198 end
199 199
200
201 define leval
202 ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
203 end
204
205 document leval
206 Usage: leval "SEXP"
207 Eval a lisp expression.
208 Requires a running xemacs process.
209
210 Example:
211 (gdb) leval "(+ 1 2)"
212 Lisp ==> 3
213 end
214
215
200 define wtype 216 define wtype
201 print $arg0->core.widget_class->core_class.class_name 217 print $arg0->core.widget_class->core_class.class_name
202 end 218 end
203 219
204 define xtname 220 define xtname
213 print *$xstruct 229 print *$xstruct
214 end 230 end
215 231
216 define pobj 232 define pobj
217 decode_object $arg0 233 decode_object $arg0
218 if $type == dbg_Lisp_Type_Int 234 if $type == Lisp_Type_Int
219 printf "Integer: %d\n", $val 235 printf "Integer: %d\n", $val
220 else 236 else
221 if $type == dbg_Lisp_Type_Char 237 if $type == Lisp_Type_Char
222 if $val < 128 238 if $val > 32 && $val < 128
223 printf "Char: %c\n", $val 239 printf "Char: %c\n", $val
224 else 240 else
225 printf "Char: %d\n", $val 241 printf "Char: %d\n", $val
226 end 242 end
227 else 243 else
228 if $type == dbg_Lisp_Type_String || $imp == lrecord_string 244 if $type == Lisp_Type_String || $imp == lrecord_string
229 pstruct Lisp_String 245 pstruct Lisp_String
230 else 246 else
231 if $type == dbg_Lisp_Type_Cons || $imp == lrecord_cons 247 if $type == Lisp_Type_Cons || $imp == lrecord_cons
232 pstruct Lisp_Cons 248 pstruct Lisp_Cons
233 else 249 else
234 if $type == dbg_Lisp_Type_Symbol || $imp == lrecord_symbol 250 if $type == Lisp_Type_Symbol || $imp == lrecord_symbol
235 pstruct Lisp_Symbol 251 pstruct Lisp_Symbol
236 printf "Symbol name: %s\n", $xstruct->name->data 252 printf "Symbol name: %s\n", $xstruct->name->data
237 else 253 else
238 if $type == dbg_Lisp_Type_Vector || $imp == lrecord_vector 254 if $type == Lisp_Type_Vector || $imp == lrecord_vector
239 pstruct Lisp_Vector 255 pstruct Lisp_Vector
240 printf "Vector of length %d\n", $xstruct->size 256 printf "Vector of length %d\n", $xstruct->size
241 #print *($xstruct->data) @ $xstruct->size 257 #print *($xstruct->data) @ $xstruct->size
242 else 258 else
243 if $imp == lrecord_bit_vector 259 if $imp == lrecord_bit_vector
431 447
432 document pobj 448 document pobj
433 Usage: pobj lisp_object 449 Usage: pobj lisp_object
434 Print the internal C structure of a underlying Lisp Object. 450 Print the internal C structure of a underlying Lisp Object.
435 end 451 end
452
453 # -------------------------------------------------------------
454 # functions to test the debugging support itself.
455 # If you change this file, make sure the following still work...
456 # -------------------------------------------------------------
457 define test_xtype
458 printf "Vemacs_major_version: "
459 xtype Vemacs_major_version
460 printf "Vhelp_char: "
461 xtype Vhelp_char
462 printf "Qnil: "
463 xtype Qnil
464 printf "Qunbound: "
465 xtype Qunbound
466 printf "Vobarray: "
467 xtype Vobarray
468 printf "Vall_weak_lists: "
469 xtype Vall_weak_lists
470 printf "Vxemacs_codename: "
471 xtype Vxemacs_codename
472 end
473
474 define test_pobj
475 printf "Vemacs_major_version: "
476 pobj Vemacs_major_version
477 printf "Vhelp_char: "
478 pobj Vhelp_char
479 printf "Qnil: "
480 pobj Qnil
481 printf "Qunbound: "
482 pobj Qunbound
483 printf "Vobarray: "
484 pobj Vobarray
485 printf "Vall_weak_lists: "
486 pobj Vall_weak_lists
487 printf "Vxemacs_codename: "
488 pobj Vxemacs_codename
489 end
490