comparison src/.gdbinit @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 23a1cea22d13
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
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, 2005, 2006
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.
5 # 5 #
6 # GNU Emacs is free software; you can redistribute it and/or modify 6 # GNU Emacs is free software; you can redistribute it and/or modify
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details. 14 # GNU General Public License for more details.
15 # 15 #
16 # You should have received a copy of the GNU General Public License 16 # You should have received a copy of the GNU General Public License
17 # along with GNU Emacs; see the file COPYING. If not, write to the 17 # along with GNU Emacs; see the file COPYING. If not, write to the
18 # Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 # Boston, MA 02111-1307, USA. 19 # Boston, MA 02110-1301, USA.
20 20
21 # Force loading of symbols, enough to give us gdb_valbits etc. 21 # Force loading of symbols, enough to give us gdb_valbits etc.
22 set main 22 set main
23 23
24 # Find lwlib source files too. 24 # Find lwlib source files too.
29 # This has one unfortunate effect: you can't type C-c 29 # This has one unfortunate effect: you can't type C-c
30 # at the GDB to stop Emacs, when using X. 30 # at the GDB to stop Emacs, when using X.
31 # However, C-z works just as well in that case. 31 # However, C-z works just as well in that case.
32 handle 2 noprint pass 32 handle 2 noprint pass
33 33
34 # Make it work like SIGINT normally does.
35 handle SIGTSTP nopass
36
34 # Don't pass SIGALRM to Emacs. This makes problems when 37 # Don't pass SIGALRM to Emacs. This makes problems when
35 # debugging. 38 # debugging.
36 handle SIGALRM ignore 39 handle SIGALRM ignore
37 40
38 # Set up a mask to use. 41 # $valmask and $tagmask are mask values set up by the xreload macro below.
39 # This should be EMACS_INT, but in some cases that is a macro. 42
40 # long ought to work in all cases right now. 43 # Use $bugfix so that the value isn't a constant.
41 set $valmask = ((long)1 << gdb_valbits) - 1 44 # Using a constant runs into GDB bugs sometimes.
42 set $nonvalbits = gdb_emacs_intbits - gdb_valbits 45 define xgetptr
46 set $bugfix = $arg0
47 set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
48 end
49
50 define xgetint
51 set $bugfix = $arg0
52 set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
53 end
54
55 define xgettype
56 set $bugfix = $arg0
57 set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
58 end
43 59
44 # Set up something to print out s-expressions. 60 # Set up something to print out s-expressions.
45 define pr 61 define pr
46 set debug_print ($) 62 set debug_print ($)
47 end 63 end
48 document pr 64 document pr
49 Print the emacs s-expression which is $. 65 Print the emacs s-expression which is $.
50 Works only when an inferior emacs is executing. 66 Works only when an inferior emacs is executing.
51 end 67 end
52 68
69 # Print out s-expressions
70 define pp
71 set $tmp = $arg0
72 set safe_debug_print ($tmp)
73 end
74 document pp
75 Print the argument as an emacs s-expression
76 Works only when an inferior emacs is executing.
77 end
78
79 # Print out s-expressions from tool bar
80 define pp1
81 set $tmp = $arg0
82 echo $arg0
83 printf " = "
84 set safe_debug_print ($tmp)
85 end
86 document pp1
87 Print the argument as an emacs s-expression
88 Works only when an inferior emacs is executing.
89 For use on tool bar when debugging in Emacs
90 where the variable name would not otherwise
91 be recorded in the GUD buffer.
92 end
93
94 # Print value of lisp variable
95 define pv
96 set $tmp = "$arg0"
97 set safe_debug_print ( find_symbol_value (intern ($tmp)))
98 end
99 document pv
100 Print the value of the lisp variable given as argument.
101 Works only when an inferior emacs is executing.
102 end
103
104 # Print value of lisp variable
105 define pv1
106 set $tmp = "$arg0"
107 echo $arg0
108 printf " = "
109 set safe_debug_print (find_symbol_value (intern ($tmp)))
110 end
111 document pv1
112 Print the value of the lisp variable given as argument.
113 Works only when an inferior emacs is executing.
114 For use on tool bar when debugging in Emacs
115 where the variable name would not otherwise
116 be recorded in the GUD buffer.
117 end
118
119 # Print out current buffer point and boundaries
120 define ppt
121 set $b = current_buffer
122 set $t = $b->text
123 printf "BUF PT: %d", $b->pt
124 if ($b->pt != $b->pt_byte)
125 printf "[%d]", $b->pt_byte
126 end
127 printf " of 1..%d", $t->z
128 if ($t->z != $t->z_byte)
129 printf "[%d]", $t->z_byte
130 end
131 if ($b->begv != 1 || $b->zv != $t->z)
132 printf " NARROW=%d..%d", $b->begv, $b->zv
133 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
134 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
135 end
136 end
137 printf " GAP: %d", $t->gpt
138 if ($t->gpt != $t->gpt_byte)
139 printf "[%d]", $t->gpt_byte
140 end
141 printf " SZ=%d\n", $t->gap_size
142 end
143 document ppt
144 Print point, beg, end, narrow, and gap for current buffer.
145 end
146
147 # Print out iterator given as first arg
148 define pitx
149 set $it = $arg0
150 printf "cur=%d", $it->current.pos.charpos
151 if ($it->current.pos.charpos != $it->current.pos.bytepos)
152 printf "[%d]", $it->current.pos.bytepos
153 end
154 printf " start=%d", $it->start.pos.charpos
155 if ($it->start.pos.charpos != $it->start.pos.bytepos)
156 printf "[%d]", $it->start.pos.bytepos
157 end
158 printf " end=%d", $it->end_charpos
159 printf " stop=%d", $it->stop_charpos
160 printf " face=%d", $it->face_id
161 if ($it->multibyte_p)
162 printf " MB"
163 end
164 if ($it->header_line_p)
165 printf " HL"
166 end
167 if ($it->n_overlay_strings > 0)
168 printf " nov=%d", $it->n_overlay_strings
169 end
170 if ($it->sp != 0)
171 printf " sp=%d", $it->sp
172 end
173 if ($it->what == IT_CHARACTER)
174 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
175 printf " ch='%c'", $it->c
176 else
177 printf " ch=[%d,%d]", $it->c, $it->len
178 end
179 else
180 if ($it->what == IT_IMAGE)
181 printf " IMAGE=%d", $it->image_id
182 else
183 printf " "
184 output $it->what
185 end
186 end
187 if ($it->method != GET_FROM_BUFFER)
188 printf " next="
189 output $it->method
190 if ($it->method == GET_FROM_STRING)
191 printf "[%d]", $it->current.string_pos.charpos
192 end
193 end
194 printf "\n"
195 if ($it->region_beg_charpos >= 0)
196 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
197 end
198 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
199 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
200 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
201 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
202 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
203 printf "\n"
204 end
205 document pitx
206 Pretty print a display iterator.
207 Take one arg, an iterator object or pointer.
208 end
209
210 define pit
211 pitx it
212 end
213 document pit
214 Pretty print the display iterator it.
215 end
216
217 define prowx
218 set $row = $arg0
219 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
220 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
221 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
222 printf " vis=%d", $row->visible_height
223 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
224 printf "\n"
225 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
226 if ($row->enabled_p)
227 printf " ENA"
228 end
229 if ($row->displays_text_p)
230 printf " DISP"
231 end
232 if ($row->mode_line_p)
233 printf " MODEL"
234 end
235 if ($row->continued_p)
236 printf " CONT"
237 end
238 if ($row-> truncated_on_left_p)
239 printf " TRUNC:L"
240 end
241 if ($row-> truncated_on_right_p)
242 printf " TRUNC:R"
243 end
244 if ($row->starts_in_middle_of_char_p)
245 printf " STARTMID"
246 end
247 if ($row->ends_in_middle_of_char_p)
248 printf " ENDMID"
249 end
250 if ($row->ends_in_newline_from_string_p)
251 printf " ENDNLFS"
252 end
253 if ($row->ends_at_zv_p)
254 printf " ENDZV"
255 end
256 if ($row->overlapped_p)
257 printf " OLAPD"
258 end
259 if ($row->overlapping_p)
260 printf " OLAPNG"
261 end
262 printf "\n"
263 end
264 document prowx
265 Pretty print information about glyph_row.
266 Takes one argument, a row object or pointer.
267 end
268
269 define prow
270 prowx row
271 end
272 document prow
273 Pretty print information about glyph_row in row.
274 end
275
276
277 define pcursorx
278 set $cp = $arg0
279 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
280 end
281 document pcursorx
282 Pretty print a window cursor
283 end
284
285 define pcursor
286 printf "output: "
287 pcursorx output_cursor
288 printf "\n"
289 end
290 document pcursor
291 Pretty print the output_cursor
292 end
293
294 define pwinx
295 set $w = $arg0
296 xgetint $w->sequence_number
297 if ($w->mini_p != Qnil)
298 printf "Mini "
299 end
300 printf "Window %d ", $int
301 xgetptr $w->buffer
302 set $tem = (struct buffer *) $ptr
303 xgetptr $tem->name
304 printf "%s", ((struct Lisp_String *) $ptr)->data
305 printf "\n"
306 xgetptr $w->start
307 set $tem = (struct Lisp_Marker *) $ptr
308 printf "start=%d end:", $tem->charpos
309 if ($w->window_end_valid != Qnil)
310 xgetint $w->window_end_pos
311 printf "pos=%d", $int
312 xgetint $w->window_end_vpos
313 printf " vpos=%d", $int
314 else
315 printf "invalid"
316 end
317 printf " vscroll=%d", $w->vscroll
318 if ($w->force_start != Qnil)
319 printf " FORCE_START"
320 end
321 if ($w->must_be_updated_p)
322 printf " MUST_UPD"
323 end
324 printf "\n"
325 printf "cursor: "
326 pcursorx $w->cursor
327 printf " phys: "
328 pcursorx $w->phys_cursor
329 if ($w->phys_cursor_on_p)
330 printf " ON"
331 else
332 printf " OFF"
333 end
334 printf " blk="
335 if ($w->last_cursor_off_p != $w->cursor_off_p)
336 if ($w->last_cursor_off_p)
337 printf "ON->"
338 else
339 printf "OFF->"
340 end
341 end
342 if ($w->cursor_off_p)
343 printf "ON"
344 else
345 printf "OFF"
346 end
347 printf "\n"
348 end
349 document pwinx
350 Pretty print a window structure.
351 Takes one argument, a pointer to a window structure
352 end
353
354 define pwin
355 pwinx w
356 end
357 document pwin
358 Pretty print window structure w.
359 end
360
361
53 define xtype 362 define xtype
54 output (enum Lisp_Type) (($ >> gdb_valbits) & 0x7) 363 xgettype $
55 echo \n 364 output $type
56 output ((($ >> 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) 365 echo \n
57 echo \n 366 if $type == Lisp_Misc
367 xmisctype
368 else
369 if $type == Lisp_Vectorlike
370 xvectype
371 end
372 end
58 end 373 end
59 document xtype 374 document xtype
60 Print the type of $, assuming it is an Emacs Lisp value. 375 Print the type of $, assuming it is an Emacs Lisp value.
61 If the first type printed is Lisp_Vector or Lisp_Misc, 376 If the first type printed is Lisp_Vector or Lisp_Misc,
62 the second line gives the more precise type. 377 a second line gives the more precise type.
63 Otherwise the second line doesn't mean anything.
64 end 378 end
65 379
66 define xvectype 380 define xvectype
67 set $size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size 381 xgetptr $
68 output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) 382 set $size = ((struct Lisp_Vector *) $ptr)->size
69 echo \n 383 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
384 echo \n
70 end 385 end
71 document xvectype 386 document xvectype
72 Print the vector subtype of $, assuming it is a vector or pseudovector. 387 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
73 end 388 end
74 389
75 define xmisctype 390 define xmisctype
76 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) 391 xgetptr $
77 echo \n 392 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
393 echo \n
78 end 394 end
79 document xmisctype 395 document xmisctype
80 Print the specific type of $, assuming it is some misc type. 396 Print the specific type of $, assuming it is some misc type.
81 end 397 end
82 398
83 define xint 399 define xint
84 print (($ & $valmask) << $nonvalbits) >> $nonvalbits 400 xgetint $
401 print $int
85 end 402 end
86 document xint 403 document xint
87 Print $, assuming it is an Emacs Lisp integer. This gets the sign right. 404 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
88 end 405 end
89 406
90 define xptr 407 define xptr
91 print (void *) (($ & $valmask) | gdb_data_seg_bits) 408 xgetptr $
409 print (void *) $ptr
92 end 410 end
93 document xptr 411 document xptr
94 Print the pointer portion of $, assuming it is an Emacs Lisp value. 412 Print the pointer portion of $, assuming it is an Emacs Lisp value.
95 end 413 end
96 414
97 define xmarker 415 define xmarker
98 print (struct Lisp_Marker *) (($ & $valmask) | gdb_data_seg_bits) 416 xgetptr $
417 print (struct Lisp_Marker *) $ptr
99 end 418 end
100 document xmarker 419 document xmarker
101 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. 420 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
102 end 421 end
103 422
104 define xoverlay 423 define xoverlay
105 print (struct Lisp_Overlay *) (($ & $valmask) | gdb_data_seg_bits) 424 xgetptr $
425 print (struct Lisp_Overlay *) $ptr
106 end 426 end
107 document xoverlay 427 document xoverlay
108 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. 428 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
109 end 429 end
110 430
111 define xmiscfree 431 define xmiscfree
112 print (struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits) 432 xgetptr $
433 print (struct Lisp_Free *) $ptr
113 end 434 end
114 document xmiscfree 435 document xmiscfree
115 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. 436 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
116 end 437 end
117 438
118 define xintfwd 439 define xintfwd
119 print (struct Lisp_Intfwd *) (($ & $valmask) | gdb_data_seg_bits) 440 xgetptr $
441 print (struct Lisp_Intfwd *) $ptr
120 end 442 end
121 document xintfwd 443 document xintfwd
122 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. 444 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
123 end 445 end
124 446
125 define xboolfwd 447 define xboolfwd
126 print (struct Lisp_Boolfwd *) (($ & $valmask) | gdb_data_seg_bits) 448 xgetptr $
449 print (struct Lisp_Boolfwd *) $ptr
127 end 450 end
128 document xboolfwd 451 document xboolfwd
129 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. 452 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
130 end 453 end
131 454
132 define xobjfwd 455 define xobjfwd
133 print (struct Lisp_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 456 xgetptr $
457 print (struct Lisp_Objfwd *) $ptr
134 end 458 end
135 document xobjfwd 459 document xobjfwd
136 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. 460 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
137 end 461 end
138 462
139 define xbufobjfwd 463 define xbufobjfwd
140 print (struct Lisp_Buffer_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 464 xgetptr $
465 print (struct Lisp_Buffer_Objfwd *) $ptr
141 end 466 end
142 document xbufobjfwd 467 document xbufobjfwd
143 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. 468 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
144 end 469 end
145 470
146 define xkbobjfwd 471 define xkbobjfwd
147 print (struct Lisp_Kboard_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) 472 xgetptr $
473 print (struct Lisp_Kboard_Objfwd *) $ptr
148 end 474 end
149 document xkbobjfwd 475 document xkbobjfwd
150 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. 476 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
151 end 477 end
152 478
153 define xbuflocal 479 define xbuflocal
154 print (struct Lisp_Buffer_Local_Value *) (($ & $valmask) | gdb_data_seg_bits) 480 xgetptr $
481 print (struct Lisp_Buffer_Local_Value *) $ptr
155 end 482 end
156 document xbuflocal 483 document xbuflocal
157 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. 484 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
158 end 485 end
159 486
160 define xsymbol 487 define xsymbol
161 print (struct Lisp_Symbol *) ((((int) $) & $valmask) | gdb_data_seg_bits) 488 set $sym = $
162 xprintsym $ 489 xgetptr $sym
490 print (struct Lisp_Symbol *) $ptr
491 xprintsym $sym
492 echo \n
163 end 493 end
164 document xsymbol 494 document xsymbol
165 Print the name and address of the symbol $. 495 Print the name and address of the symbol $.
166 This command assumes that $ is an Emacs Lisp symbol value. 496 This command assumes that $ is an Emacs Lisp symbol value.
167 end 497 end
168 498
169 define xstring 499 define xstring
170 print (struct Lisp_String *) (($ & $valmask) | gdb_data_seg_bits) 500 xgetptr $
171 output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) 501 print (struct Lisp_String *) $ptr
172 echo \n 502 xprintstr $
503 echo \n
173 end 504 end
174 document xstring 505 document xstring
175 Print the contents and address of the string $. 506 Print the contents and address of the string $.
176 This command assumes that $ is an Emacs Lisp string value. 507 This command assumes that $ is an Emacs Lisp string value.
177 end 508 end
178 509
179 define xvector 510 define xvector
180 print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) 511 xgetptr $
181 output ($->size > 50) ? 0 : ($->contents[0])@($->size) 512 print (struct Lisp_Vector *) $ptr
513 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
182 echo \n 514 echo \n
183 end 515 end
184 document xvector 516 document xvector
185 Print the contents and address of the vector $. 517 Print the contents and address of the vector $.
186 This command assumes that $ is an Emacs Lisp vector value. 518 This command assumes that $ is an Emacs Lisp vector value.
187 end 519 end
188 520
189 define xprocess 521 define xprocess
190 print (struct Lisp_Process *) (($ & $valmask) | gdb_data_seg_bits) 522 xgetptr $
191 output *$ 523 print (struct Lisp_Process *) $ptr
192 echo \n 524 output *$
525 echo \n
193 end 526 end
194 document xprocess 527 document xprocess
195 Print the address of the struct Lisp_process which the Lisp_Object $ points to. 528 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
196 end 529 end
197 530
198 define xframe 531 define xframe
199 print (struct frame *) (($ & $valmask) | gdb_data_seg_bits) 532 xgetptr $
533 print (struct frame *) $ptr
200 end 534 end
201 document xframe 535 document xframe
202 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. 536 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
203 end 537 end
204 538
205 define xcompiled 539 define xcompiled
206 print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) 540 xgetptr $
207 output ($->contents[0])@($->size & 0xff) 541 print (struct Lisp_Vector *) $ptr
542 output ($->contents[0])@($->size & 0xff)
208 end 543 end
209 document xcompiled 544 document xcompiled
210 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. 545 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
211 end 546 end
212 547
213 define xwindow 548 define xwindow
214 print (struct window *) (($ & $valmask) | gdb_data_seg_bits) 549 xgetptr $
215 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top 550 print (struct window *) $ptr
551 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
216 end 552 end
217 document xwindow 553 document xwindow
218 Print $ as a window pointer, assuming it is an Emacs Lisp window value. 554 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
219 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". 555 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
220 end 556 end
221 557
222 define xwinconfig 558 define xwinconfig
223 print (struct save_window_data *) (($ & $valmask) | gdb_data_seg_bits) 559 xgetptr $
560 print (struct save_window_data *) $ptr
224 end 561 end
225 document xwinconfig 562 document xwinconfig
226 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. 563 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
227 end 564 end
228 565
229 define xsubr 566 define xsubr
230 print (struct Lisp_Subr *) (($ & $valmask) | gdb_data_seg_bits) 567 xgetptr $
231 output *$ 568 print (struct Lisp_Subr *) $ptr
232 echo \n 569 output *$
570 echo \n
233 end 571 end
234 document xsubr 572 document xsubr
235 Print the address of the subr which the Lisp_Object $ points to. 573 Print the address of the subr which the Lisp_Object $ points to.
236 end 574 end
237 575
238 define xchartable 576 define xchartable
239 print (struct Lisp_Char_Table *) (($ & $valmask) | gdb_data_seg_bits) 577 xgetptr $
240 printf "Purpose: " 578 print (struct Lisp_Char_Table *) $ptr
241 output (char*)&((struct Lisp_Symbol *) ((((int) $->purpose) & $valmask) | gdb_data_seg_bits))->name->data 579 printf "Purpose: "
242 printf " %d extra slots", ($->size & 0x1ff) - 388 580 xprintsym $->purpose
243 echo \n 581 printf " %d extra slots", ($->size & 0x1ff) - 388
582 echo \n
244 end 583 end
245 document xchartable 584 document xchartable
246 Print the address of the char-table $, and its purpose. 585 Print the address of the char-table $, and its purpose.
247 This command assumes that $ is an Emacs Lisp char-table value. 586 This command assumes that $ is an Emacs Lisp char-table value.
248 end 587 end
249 588
250 define xboolvector 589 define xboolvector
251 print (struct Lisp_Bool_Vector *) (($ & $valmask) | gdb_data_seg_bits) 590 xgetptr $
252 output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) 591 print (struct Lisp_Bool_Vector *) $ptr
253 echo \n 592 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
593 echo \n
254 end 594 end
255 document xboolvector 595 document xboolvector
256 Print the contents and address of the bool-vector $. 596 Print the contents and address of the bool-vector $.
257 This command assumes that $ is an Emacs Lisp bool-vector value. 597 This command assumes that $ is an Emacs Lisp bool-vector value.
258 end 598 end
259 599
260 define xbuffer 600 define xbuffer
261 print (struct buffer *) (($ & $valmask) | gdb_data_seg_bits) 601 xgetptr $
262 output ((struct Lisp_String *) ((($->name) & $valmask) | gdb_data_seg_bits))->data 602 print (struct buffer *) $ptr
263 echo \n 603 xgetptr $->name
604 output ((struct Lisp_String *) $ptr)->data
605 echo \n
264 end 606 end
265 document xbuffer 607 document xbuffer
266 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. 608 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
267 Print the name of the buffer. 609 Print the name of the buffer.
268 end 610 end
269 611
270 define xhashtable 612 define xhashtable
271 print (struct Lisp_Hash_Table *) (($ & $valmask) | gdb_data_seg_bits) 613 xgetptr $
614 print (struct Lisp_Hash_Table *) $ptr
272 end 615 end
273 document xhashtable 616 document xhashtable
274 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. 617 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
275 end 618 end
276 619
277 define xcons 620 define xcons
278 print (struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits) 621 xgetptr $
279 output/x *$ 622 print (struct Lisp_Cons *) $ptr
280 echo \n 623 output/x *$
624 echo \n
281 end 625 end
282 document xcons 626 document xcons
283 Print the contents of $, assuming it is an Emacs Lisp cons. 627 Print the contents of $, assuming it is an Emacs Lisp cons.
284 end 628 end
285 629
286 define nextcons 630 define nextcons
287 p $.cdr 631 p $.u.cdr
288 xcons 632 xcons
289 end 633 end
290 document nextcons 634 document nextcons
291 Print the contents of the next cell in a list. 635 Print the contents of the next cell in a list.
292 This assumes that the last thing you printed was a cons cell contents 636 This assumes that the last thing you printed was a cons cell contents
293 (type struct Lisp_Cons) or a pointer to one. 637 (type struct Lisp_Cons) or a pointer to one.
294 end 638 end
295 define xcar 639 define xcar
296 print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->car : 0) 640 xgetptr $
641 xgettype $
642 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
297 end 643 end
298 document xcar 644 document xcar
299 Print the car of $, assuming it is an Emacs Lisp pair. 645 Print the car of $, assuming it is an Emacs Lisp pair.
300 end 646 end
301 647
302 define xcdr 648 define xcdr
303 print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->cdr : 0) 649 xgetptr $
650 xgettype $
651 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
304 end 652 end
305 document xcdr 653 document xcdr
306 Print the cdr of $, assuming it is an Emacs Lisp pair. 654 Print the cdr of $, assuming it is an Emacs Lisp pair.
307 end 655 end
308 656
309 define xfloat 657 define xfloat
310 print ((struct Lisp_Float *) (($ & $valmask) | gdb_data_seg_bits))->data 658 xgetptr $
659 print ((struct Lisp_Float *) $ptr)->u.data
311 end 660 end
312 document xfloat 661 document xfloat
313 Print $ assuming it is a lisp floating-point number. 662 Print $ assuming it is a lisp floating-point number.
314 end 663 end
315 664
316 define xscrollbar 665 define xscrollbar
317 print (struct scrollbar *) (($ & $valmask) | gdb_data_seg_bits) 666 xgetptr $
667 print (struct scrollbar *) $ptr
318 output *$ 668 output *$
319 echo \n 669 echo \n
320 end 670 end
321 document xscrollbar 671 document xscrollbar
322 Print $ as a scrollbar pointer. 672 Print $ as a scrollbar pointer.
323 end 673 end
324 674
675 define xprintstr
676 set $data = $arg0->data
677 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
678 end
679
325 define xprintsym 680 define xprintsym
326 set $sym = (struct Lisp_Symbol *) ((((int) $arg0) & $valmask) | gdb_data_seg_bits) 681 xgetptr $arg0
327 set $sym_name = ((struct Lisp_String *)(($sym->xname & $valmask) | gdb_data_seg_bits)) 682 set $sym = (struct Lisp_Symbol *) $ptr
328 output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) 683 xgetptr $sym->xname
329 echo \n 684 set $sym_name = (struct Lisp_String *) $ptr
685 xprintstr $sym_name
330 end 686 end
331 document xprintsym 687 document xprintsym
332 Print argument as a symbol. 688 Print argument as a symbol.
333 end 689 end
334 690
335 define xbacktrace 691 define xbacktrace
336 set $bt = backtrace_list 692 set $bt = backtrace_list
337 while $bt 693 while $bt
338 set $type = (enum Lisp_Type) ((*$bt->function >> gdb_valbits) & 0x7) 694 xgettype (*$bt->function)
339 if $type == Lisp_Symbol 695 if $type == Lisp_Symbol
340 xprintsym *$bt->function 696 xprintsym (*$bt->function)
697 echo \n
341 else 698 else
342 printf "0x%x ", *$bt->function 699 printf "0x%x ", *$bt->function
343 if $type == Lisp_Vectorlike 700 if $type == Lisp_Vectorlike
344 set $size = ((struct Lisp_Vector *) ((*$bt->function & $valmask) | gdb_data_seg_bits))->size 701 xgetptr (*$bt->function)
345 output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) 702 set $size = ((struct Lisp_Vector *) $ptr)->size
703 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
346 else 704 else
347 printf "Lisp type %d", $type 705 printf "Lisp type %d", $type
348 end 706 end
349 echo \n 707 echo \n
350 end 708 end
355 Print a backtrace of Lisp function calls from backtrace_list. 713 Print a backtrace of Lisp function calls from backtrace_list.
356 Set a breakpoint at Fsignal and call this to see from where 714 Set a breakpoint at Fsignal and call this to see from where
357 an error was signaled. 715 an error was signaled.
358 end 716 end
359 717
718 # Show Lisp backtrace after normal backtrace.
719 define hookpost-backtrace
720 set $bt = backtrace_list
721 if $bt
722 echo \n
723 echo Lisp Backtrace:\n
724 xbacktrace
725 end
726 end
727
360 define xreload 728 define xreload
361 set $valmask = ((long)1 << gdb_valbits) - 1 729 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
362 set $nonvalbits = gdb_emacs_intbits - gdb_valbits 730 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
363 end 731 end
364 document xreload 732 document xreload
365 When starting Emacs a second time in the same gdb session under 733 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 734 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
367 their values. (The same happens on current (2000) versions of GNU/Linux 735 their values. (The same happens on current (2000) versions of GNU/Linux
368 with gdb 5.0.) 736 with gdb 5.0.)
369 This function reloads them. 737 This function reloads them.
370 end 738 end
739 xreload
740
741 # Flush display (X only)
742 define ff
743 set x_flush (0)
744 end
745 document ff
746 Flush pending X window display updates to screen.
747 Works only when an inferior emacs is executing.
748 end
749
371 750
372 define hook-run 751 define hook-run
373 xreload 752 xreload
374 end 753 end
375 754
383 762
384 show environment DISPLAY 763 show environment DISPLAY
385 show environment TERM 764 show environment TERM
386 set args -geometry 80x40+0+0 765 set args -geometry 80x40+0+0
387 766
388 # Don't let abort actually run, as it will make 767 # People get bothered when they see messages about non-existent functions...
389 # stdio stop working and therefore the `pr' command above as well. 768 xgetptr Vsystem_type
390 break abort 769 set $tem = (struct Lisp_Symbol *) $ptr
391 770 xgetptr $tem->xname
392 # If we are running in synchronous mode, we want a chance to look around 771 set $tem = (struct Lisp_String *) $ptr
393 # before Emacs exits. Perhaps we should put the break somewhere else 772 set $tem = (char *) $tem->data
394 # instead... 773
395 break x_error_quitter 774 # Don't let abort actually run, as it will make stdio stop working and
775 # therefore the `pr' command above as well.
776 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
777 # The windows-nt build replaces abort with its own function.
778 break w32_abort
779 else
780 break abort
781 end
782
783 # x_error_quitter is defined only on X. But window-system is set up
784 # only at run time, during Emacs startup, so we need to defer setting
785 # the breakpoint. init_sys_modes is the first function called on
786 # every platform after init_display, where window-system is set.
787 tbreak init_sys_modes
788 commands
789 silent
790 xgetptr Vwindow_system
791 set $tem = (struct Lisp_Symbol *) $ptr
792 xgetptr $tem->xname
793 set $tem = (struct Lisp_String *) $ptr
794 set $tem = (char *) $tem->data
795 # If we are running in synchronous mode, we want a chance to look
796 # around before Emacs exits. Perhaps we should put the break
797 # somewhere else instead...
798 if $tem[0] == 'x' && $tem[1] == '\0'
799 break x_error_quitter
800 end
801 continue
802 end
803 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe