aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2004-04-03 05:34:11 +0000
committerStefan Monnier2004-04-03 05:34:11 +0000
commit329aa18857a1567b11952bc33cedbedefe8448b4 (patch)
tree97aebfd309d1c7e2c177b8f8acdfcc18bde7e416
parent0dda8fd8d5c9c0cbf020ecedc64356a3570bb599 (diff)
downloademacs-329aa18857a1567b11952bc33cedbedefe8448b4.tar.gz
emacs-329aa18857a1567b11952bc33cedbedefe8448b4.zip
Make it work for USE_LSB_TAG and !NO_LISP_UNION.
(xgetptr, xgetint, xgettype): New funs. Use them everywhere. ($nonvalbits): Remove. ($valmask): Set it by calling xreload to avoid redundancy.
-rw-r--r--src/.gdbinit208
1 files changed, 131 insertions, 77 deletions
diff --git a/src/.gdbinit b/src/.gdbinit
index ccc36694da8..80ad1e249ad 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1,4 +1,4 @@
1# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001 1# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004
2# Free Software Foundation, Inc. 2# Free Software Foundation, Inc.
3# 3#
4# This file is part of GNU Emacs. 4# This file is part of GNU Emacs.
@@ -38,12 +38,22 @@ handle SIGALRM ignore
38# Set up a mask to use. 38# Set up a mask to use.
39# This should be EMACS_INT, but in some cases that is a macro. 39# This should be EMACS_INT, but in some cases that is a macro.
40# long ought to work in all cases right now. 40# long ought to work in all cases right now.
41set $valmask = ((long)1 << gdb_valbits) - 1 41
42set $nonvalbits = gdb_emacs_intbits - gdb_valbits 42define xgetptr
43 set $ptr = (gdb_use_union ? $arg0.u.val : $arg0 & $valmask) | gdb_data_seg_bits
44end
45
46define xgetint
47 set $int = gdb_use_union ? $arg0.s.val : (gdb_use_lsb ? $arg0 : $arg0 << gdb_gctypebits) >> gdb_gctypebits
48end
49
50define xgettype
51 set $type = gdb_use_union ? $arg0.s.type : (enum Lisp_Type) (gdb_use_lsb ? $arg0 & $tagmask : $arg0 >> gdb_valbits)
52end
43 53
44# Set up something to print out s-expressions. 54# Set up something to print out s-expressions.
45define pr 55define pr
46set debug_print ($) 56 set debug_print ($)
47end 57end
48document pr 58document pr
49Print the emacs s-expression which is $. 59Print the emacs s-expression which is $.
@@ -51,115 +61,135 @@ Works only when an inferior emacs is executing.
51end 61end
52 62
53define xtype 63define xtype
54output (enum Lisp_Type) (($ >> gdb_valbits) & 0x7) 64 xgettype $
55echo \n 65 output $type
56output ((($ >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) : (($ >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0) 66 echo \n
57echo \n 67 if $type == Lisp_Misc
68 xmisctype
69 else
70 if $type == Lisp_Vectorlike
71 xvectype
72 end
73 end
58end 74end
59document xtype 75document xtype
60Print the type of $, assuming it is an Emacs Lisp value. 76Print the type of $, assuming it is an Emacs Lisp value.
61If the first type printed is Lisp_Vector or Lisp_Misc, 77If the first type printed is Lisp_Vector or Lisp_Misc,
62the second line gives the more precise type. 78a second line gives the more precise type.
63Otherwise the second line doesn't mean anything.
64end 79end
65 80
66define xvectype 81define xvectype
67set $size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size 82 xgetptr $
68output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) 83 set $size = ((struct Lisp_Vector *) $ptr)->size
69echo \n 84 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size
85 echo \n
70end 86end
71document xvectype 87document xvectype
72Print the vector subtype of $, assuming it is a vector or pseudovector. 88Print the size or vector subtype of $, assuming it is a vector or pseudovector.
73end 89end
74 90
75define xmisctype 91define xmisctype
76output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) 92 xgetptr $
77echo \n 93 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
94 echo \n
78end 95end
79document xmisctype 96document xmisctype
80Print the specific type of $, assuming it is some misc type. 97Print the specific type of $, assuming it is some misc type.
81end 98end
82 99
83define xint 100define xint
84print (($ & $valmask) << $nonvalbits) >> $nonvalbits 101 xgetint $
102 print $int
85end 103end
86document xint 104document xint
87Print $, assuming it is an Emacs Lisp integer. This gets the sign right. 105Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
88end 106end
89 107
90define xptr 108define xptr
91print (void *) (($ & $valmask) | gdb_data_seg_bits) 109 xgetptr $
110 print (void *) $ptr
92end 111end
93document xptr 112document xptr
94Print the pointer portion of $, assuming it is an Emacs Lisp value. 113Print the pointer portion of $, assuming it is an Emacs Lisp value.
95end 114end
96 115
97define xmarker 116define xmarker
98print (struct Lisp_Marker *) (($ & $valmask) | gdb_data_seg_bits) 117 xgetptr $
118 print (struct Lisp_Marker *) $ptr
99end 119end
100document xmarker 120document xmarker
101Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. 121Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
102end 122end
103 123
104define xoverlay 124define xoverlay
105print (struct Lisp_Overlay *) (($ & $valmask) | gdb_data_seg_bits) 125 xgetptr $
126 print (struct Lisp_Overlay *) $ptr
106end 127end
107document xoverlay 128document xoverlay
108Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. 129Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
109end 130end
110 131
111define xmiscfree 132define xmiscfree
112print (struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits) 133 xgetptr $
134 print (struct Lisp_Free *) $ptr
113end 135end
114document xmiscfree 136document xmiscfree
115Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. 137Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
116end 138end
117 139
118define xintfwd 140define xintfwd
119print (struct Lisp_Intfwd *) (($ & $valmask) | gdb_data_seg_bits) 141 xgetptr $
142 print (struct Lisp_Intfwd *) $ptr
120end 143end
121document xintfwd 144document xintfwd
122Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. 145Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
123end 146end
124 147
125define xboolfwd 148define xboolfwd
126print (struct Lisp_Boolfwd *) (($ & $valmask) | gdb_data_seg_bits) 149 xgetptr $
150 print (struct Lisp_Boolfwd *) $ptr
127end 151end
128document xboolfwd 152document xboolfwd
129Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. 153Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
130end 154end
131 155
132define xobjfwd 156define xobjfwd
133print (struct Lisp_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 157 xgetptr $
158 print (struct Lisp_Objfwd *) $ptr
134end 159end
135document xobjfwd 160document xobjfwd
136Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. 161Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
137end 162end
138 163
139define xbufobjfwd 164define xbufobjfwd
140print (struct Lisp_Buffer_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 165 xgetptr $
166 print (struct Lisp_Buffer_Objfwd *) $ptr
141end 167end
142document xbufobjfwd 168document xbufobjfwd
143Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. 169Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
144end 170end
145 171
146define xkbobjfwd 172define xkbobjfwd
147print (struct Lisp_Kboard_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 173 xgetptr $
174 print (struct Lisp_Kboard_Objfwd *) $ptr
148end 175end
149document xkbobjfwd 176document xkbobjfwd
150Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. 177Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
151end 178end
152 179
153define xbuflocal 180define xbuflocal
154print (struct Lisp_Buffer_Local_Value *) (($ & $valmask) | gdb_data_seg_bits) 181 xgetptr $
182 print (struct Lisp_Buffer_Local_Value *) $ptr
155end 183end
156document xbuflocal 184document xbuflocal
157Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. 185Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
158end 186end
159 187
160define xsymbol 188define xsymbol
161print (struct Lisp_Symbol *) ((((int) $) & $valmask) | gdb_data_seg_bits) 189 xgetptr $
162xprintsym $ 190 print (struct Lisp_Symbol *) $ptr
191 xprintsym $
192 echo \n
163end 193end
164document xsymbol 194document xsymbol
165Print the name and address of the symbol $. 195Print the name and address of the symbol $.
@@ -167,9 +197,10 @@ This command assumes that $ is an Emacs Lisp symbol value.
167end 197end
168 198
169define xstring 199define xstring
170print (struct Lisp_String *) (($ & $valmask) | gdb_data_seg_bits) 200 xgetptr $
171output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) 201 print (struct Lisp_String *) $ptr
172echo \n 202 output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte)
203 echo \n
173end 204end
174document xstring 205document xstring
175Print the contents and address of the string $. 206Print the contents and address of the string $.
@@ -177,8 +208,9 @@ This command assumes that $ is an Emacs Lisp string value.
177end 208end
178 209
179define xvector 210define xvector
180print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) 211 xgetptr $
181output ($->size > 50) ? 0 : ($->contents[0])@($->size) 212 print (struct Lisp_Vector *) $ptr
213 output ($->size > 50) ? 0 : ($->contents[0])@($->size)
182echo \n 214echo \n
183end 215end
184document xvector 216document xvector
@@ -187,32 +219,36 @@ This command assumes that $ is an Emacs Lisp vector value.
187end 219end
188 220
189define xprocess 221define xprocess
190print (struct Lisp_Process *) (($ & $valmask) | gdb_data_seg_bits) 222 xgetptr $
191output *$ 223 print (struct Lisp_Process *) $ptr
192echo \n 224 output *$
225 echo \n
193end 226end
194document xprocess 227document xprocess
195Print the address of the struct Lisp_process which the Lisp_Object $ points to. 228Print the address of the struct Lisp_process which the Lisp_Object $ points to.
196end 229end
197 230
198define xframe 231define xframe
199print (struct frame *) (($ & $valmask) | gdb_data_seg_bits) 232 xgetptr $
233 print (struct frame *) $ptr
200end 234end
201document xframe 235document xframe
202Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. 236Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
203end 237end
204 238
205define xcompiled 239define xcompiled
206print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) 240 xgetptr $
207output ($->contents[0])@($->size & 0xff) 241 print (struct Lisp_Vector *) $ptr
242 output ($->contents[0])@($->size & 0xff)
208end 243end
209document xcompiled 244document xcompiled
210Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. 245Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
211end 246end
212 247
213define xwindow 248define xwindow
214print (struct window *) (($ & $valmask) | gdb_data_seg_bits) 249 xgetptr $
215printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top 250 print (struct window *) $ptr
251 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
216end 252end
217document xwindow 253document xwindow
218Print $ as a window pointer, assuming it is an Emacs Lisp window value. 254Print $ as a window pointer, assuming it is an Emacs Lisp window value.
@@ -220,27 +256,30 @@ Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
220end 256end
221 257
222define xwinconfig 258define xwinconfig
223print (struct save_window_data *) (($ & $valmask) | gdb_data_seg_bits) 259 xgetptr $
260 print (struct save_window_data *) $ptr
224end 261end
225document xwinconfig 262document xwinconfig
226Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. 263Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
227end 264end
228 265
229define xsubr 266define xsubr
230print (struct Lisp_Subr *) (($ & $valmask) | gdb_data_seg_bits) 267 xgetptr $
231output *$ 268 print (struct Lisp_Subr *) $ptr
232echo \n 269 output *$
270 echo \n
233end 271end
234document xsubr 272document xsubr
235Print the address of the subr which the Lisp_Object $ points to. 273Print the address of the subr which the Lisp_Object $ points to.
236end 274end
237 275
238define xchartable 276define xchartable
239print (struct Lisp_Char_Table *) (($ & $valmask) | gdb_data_seg_bits) 277 xgetptr $
240printf "Purpose: " 278 print (struct Lisp_Char_Table *) $ptr
241output (char*)&((struct Lisp_Symbol *) ((((int) $->purpose) & $valmask) | gdb_data_seg_bits))->name->data 279 printf "Purpose: "
242printf " %d extra slots", ($->size & 0x1ff) - 388 280 xprintsym $->purpose
243echo \n 281 printf " %d extra slots", ($->size & 0x1ff) - 388
282 echo \n
244end 283end
245document xchartable 284document xchartable
246Print the address of the char-table $, and its purpose. 285Print the address of the char-table $, and its purpose.
@@ -248,9 +287,10 @@ This command assumes that $ is an Emacs Lisp char-table value.
248end 287end
249 288
250define xboolvector 289define xboolvector
251print (struct Lisp_Bool_Vector *) (($ & $valmask) | gdb_data_seg_bits) 290 xgetptr $
252output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) 291 print (struct Lisp_Bool_Vector *) $ptr
253echo \n 292 output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8)
293 echo \n
254end 294end
255document xboolvector 295document xboolvector
256Print the contents and address of the bool-vector $. 296Print the contents and address of the bool-vector $.
@@ -258,9 +298,11 @@ This command assumes that $ is an Emacs Lisp bool-vector value.
258end 298end
259 299
260define xbuffer 300define xbuffer
261print (struct buffer *) (($ & $valmask) | gdb_data_seg_bits) 301 xgetptr $
262output ((struct Lisp_String *) ((($->name) & $valmask) | gdb_data_seg_bits))->data 302 print (struct buffer *) $ptr
263echo \n 303 xgetptr $->name
304 output ((struct Lisp_String *) $ptr)->data
305 echo \n
264end 306end
265document xbuffer 307document xbuffer
266Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. 308Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
@@ -268,24 +310,26 @@ Print the name of the buffer.
268end 310end
269 311
270define xhashtable 312define xhashtable
271print (struct Lisp_Hash_Table *) (($ & $valmask) | gdb_data_seg_bits) 313 xgetptr $
314 print (struct Lisp_Hash_Table *) $ptr
272end 315end
273document xhashtable 316document xhashtable
274Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. 317Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
275end 318end
276 319
277define xcons 320define xcons
278print (struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits) 321 xgetptr $
279output/x *$ 322 print (struct Lisp_Cons *) $ptr
280echo \n 323 output/x *$
324 echo \n
281end 325end
282document xcons 326document xcons
283Print the contents of $, assuming it is an Emacs Lisp cons. 327Print the contents of $, assuming it is an Emacs Lisp cons.
284end 328end
285 329
286define nextcons 330define nextcons
287p $.cdr 331 p $.cdr
288xcons 332 xcons
289end 333end
290document nextcons 334document nextcons
291Print the contents of the next cell in a list. 335Print the contents of the next cell in a list.
@@ -293,28 +337,34 @@ This assumes that the last thing you printed was a cons cell contents
293(type struct Lisp_Cons) or a pointer to one. 337(type struct Lisp_Cons) or a pointer to one.
294end 338end
295define xcar 339define xcar
296print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->car : 0) 340 xgetptr $
341 xgettype $
342 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
297end 343end
298document xcar 344document xcar
299Print the car of $, assuming it is an Emacs Lisp pair. 345Print the car of $, assuming it is an Emacs Lisp pair.
300end 346end
301 347
302define xcdr 348define xcdr
303print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->cdr : 0) 349 xgetptr $
350 xgettype $
351 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0)
304end 352end
305document xcdr 353document xcdr
306Print the cdr of $, assuming it is an Emacs Lisp pair. 354Print the cdr of $, assuming it is an Emacs Lisp pair.
307end 355end
308 356
309define xfloat 357define xfloat
310print ((struct Lisp_Float *) (($ & $valmask) | gdb_data_seg_bits))->data 358 xgetptr $
359 print ((struct Lisp_Float *) $ptr)->data
311end 360end
312document xfloat 361document xfloat
313Print $ assuming it is a lisp floating-point number. 362Print $ assuming it is a lisp floating-point number.
314end 363end
315 364
316define xscrollbar 365define xscrollbar
317print (struct scrollbar *) (($ & $valmask) | gdb_data_seg_bits) 366 xgetptr $
367 print (struct scrollbar *) $ptr
318output *$ 368output *$
319echo \n 369echo \n
320end 370end
@@ -323,10 +373,11 @@ Print $ as a scrollbar pointer.
323end 373end
324 374
325define xprintsym 375define xprintsym
326 set $sym = (struct Lisp_Symbol *) ((((int) $arg0) & $valmask) | gdb_data_seg_bits) 376 xgetptr $arg0
327 set $sym_name = ((struct Lisp_String *)(($sym->xname & $valmask) | gdb_data_seg_bits)) 377 set $sym = (struct Lisp_Symbol *) $ptr
378 xgetptr $sym->xname
379 set $sym_name = (struct Lisp_String *) $ptr
328 output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) 380 output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte)
329 echo \n
330end 381end
331document xprintsym 382document xprintsym
332 Print argument as a symbol. 383 Print argument as a symbol.
@@ -335,14 +386,16 @@ end
335define xbacktrace 386define xbacktrace
336 set $bt = backtrace_list 387 set $bt = backtrace_list
337 while $bt 388 while $bt
338 set $type = (enum Lisp_Type) ((*$bt->function >> gdb_valbits) & 0x7) 389 xgettype (*$bt->function)
339 if $type == Lisp_Symbol 390 if $type == Lisp_Symbol
340 xprintsym *$bt->function 391 xprintsym (*$bt->function)
392 echo \n
341 else 393 else
342 printf "0x%x ", *$bt->function 394 printf "0x%x ", *$bt->function
343 if $type == Lisp_Vectorlike 395 if $type == Lisp_Vectorlike
344 set $size = ((struct Lisp_Vector *) ((*$bt->function & $valmask) | gdb_data_seg_bits))->size 396 xgetptr (*$bt->function)
345 output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) 397 set $size = ((struct Lisp_Vector *) $ptr)->size
398 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size
346 else 399 else
347 printf "Lisp type %d", $type 400 printf "Lisp type %d", $type
348 end 401 end
@@ -358,16 +411,17 @@ document xbacktrace
358end 411end
359 412
360define xreload 413define xreload
361 set $valmask = ((long)1 << gdb_valbits) - 1 414 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
362 set $nonvalbits = gdb_emacs_intbits - gdb_valbits 415 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
363end 416end
364document xreload 417document xreload
365 When starting Emacs a second time in the same gdb session under 418 When starting Emacs a second time in the same gdb session under
366 FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost 419 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
367 their values. (The same happens on current (2000) versions of GNU/Linux 420 their values. (The same happens on current (2000) versions of GNU/Linux
368 with gdb 5.0.) 421 with gdb 5.0.)
369 This function reloads them. 422 This function reloads them.
370end 423end
424xreload
371 425
372define hook-run 426define hook-run
373 xreload 427 xreload