Mercurial > hg > xemacs-beta
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 |