]> code.delx.au - gnu-emacs/blob - src/.gdbinit
(Program Modes): Replace inforef to emacs-xtra by conditional xref's, depending
[gnu-emacs] / src / .gdbinit
1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
2 # 2004, 2005, 2006 Free Software Foundation, Inc.
3 #
4 # This file is part of GNU Emacs.
5 #
6 # GNU Emacs is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2, or (at your option)
9 # any later version.
10 #
11 # GNU Emacs is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
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
18 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 # Boston, MA 02110-1301, USA.
20
21 # Force loading of symbols, enough to give us gdb_valbits etc.
22 set main
23
24 # Find lwlib source files too.
25 dir ../lwlib
26 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
27
28 # Don't enter GDB when user types C-g to quit.
29 # This has one unfortunate effect: you can't type C-c
30 # at the GDB to stop Emacs, when using X.
31 # However, C-z works just as well in that case.
32 handle 2 noprint pass
33
34 # Make it work like SIGINT normally does.
35 handle SIGTSTP nopass
36
37 # Don't pass SIGALRM to Emacs. This makes problems when
38 # debugging.
39 handle SIGALRM ignore
40
41 # $valmask and $tagmask are mask values set up by the xreload macro below.
42
43 # Use $bugfix so that the value isn't a constant.
44 # Using a constant runs into GDB bugs sometimes.
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
59
60 # Set up something to print out s-expressions.
61 # We save and restore print_output_debug_flag to prevent the w32 port
62 # from calling OutputDebugString, which causes GDB to display each
63 # character twice (yuk!).
64 define pr
65 set $output_debug = print_output_debug_flag
66 set print_output_debug_flag = 0
67 set debug_print ($)
68 set print_output_debug_flag = $output_debug
69 end
70 document pr
71 Print the emacs s-expression which is $.
72 Works only when an inferior emacs is executing.
73 end
74
75 # Print out s-expressions
76 define pp
77 set $tmp = $arg0
78 set $output_debug = print_output_debug_flag
79 set print_output_debug_flag = 0
80 set safe_debug_print ($tmp)
81 set print_output_debug_flag = $output_debug
82 end
83 document pp
84 Print the argument as an emacs s-expression
85 Works only when an inferior emacs is executing.
86 end
87
88 # Print out s-expressions from tool bar
89 define pp1
90 set $tmp = $arg0
91 set $output_debug = print_output_debug_flag
92 set print_output_debug_flag = 0
93 set safe_debug_print ($tmp)
94 set print_output_debug_flag = $output_debug
95 end
96 document pp1
97 Print the argument as an emacs s-expression.
98 Works only when an inferior emacs is executing.
99 For use on tool bar when debugging in Emacs
100 where the variable name would not otherwise
101 be recorded in the GUD buffer.
102 end
103
104 # Print value of lisp variable
105 define pv
106 set $tmp = "$arg0"
107 set $output_debug = print_output_debug_flag
108 set print_output_debug_flag = 0
109 set safe_debug_print ( find_symbol_value (intern ($tmp)))
110 set print_output_debug_flag = $output_debug
111 end
112 document pv
113 Print the value of the lisp variable given as argument.
114 Works only when an inferior emacs is executing.
115 end
116
117 # Print value of lisp variable
118 define pv1
119 set $tmp = "$arg0"
120 set $output_debug = print_output_debug_flag
121 set print_output_debug_flag = 0
122 set safe_debug_print (find_symbol_value (intern ($tmp)))
123 set print_output_debug_flag = $output_debug
124 end
125 document pv1
126 Print the value of the lisp variable given as argument.
127 Works only when an inferior emacs is executing.
128 For use when debugging in Emacs where the variable
129 name would not otherwise be recorded in the GUD buffer.
130 end
131
132 # Print out current buffer point and boundaries
133 define ppt
134 set $b = current_buffer
135 set $t = $b->text
136 printf "BUF PT: %d", $b->pt
137 if ($b->pt != $b->pt_byte)
138 printf "[%d]", $b->pt_byte
139 end
140 printf " of 1..%d", $t->z
141 if ($t->z != $t->z_byte)
142 printf "[%d]", $t->z_byte
143 end
144 if ($b->begv != 1 || $b->zv != $t->z)
145 printf " NARROW=%d..%d", $b->begv, $b->zv
146 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
147 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
148 end
149 end
150 printf " GAP: %d", $t->gpt
151 if ($t->gpt != $t->gpt_byte)
152 printf "[%d]", $t->gpt_byte
153 end
154 printf " SZ=%d\n", $t->gap_size
155 end
156 document ppt
157 Print point, beg, end, narrow, and gap for current buffer.
158 end
159
160 # Print out iterator given as first arg
161 define pitx
162 set $it = $arg0
163 printf "cur=%d", $it->current.pos.charpos
164 if ($it->current.pos.charpos != $it->current.pos.bytepos)
165 printf "[%d]", $it->current.pos.bytepos
166 end
167 printf " start=%d", $it->start.pos.charpos
168 if ($it->start.pos.charpos != $it->start.pos.bytepos)
169 printf "[%d]", $it->start.pos.bytepos
170 end
171 printf " end=%d", $it->end_charpos
172 printf " stop=%d", $it->stop_charpos
173 printf " face=%d", $it->face_id
174 if ($it->multibyte_p)
175 printf " MB"
176 end
177 if ($it->header_line_p)
178 printf " HL"
179 end
180 if ($it->n_overlay_strings > 0)
181 printf " nov=%d", $it->n_overlay_strings
182 end
183 if ($it->sp != 0)
184 printf " sp=%d", $it->sp
185 end
186 if ($it->what == IT_CHARACTER)
187 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
188 printf " ch='%c'", $it->c
189 else
190 printf " ch=[%d,%d]", $it->c, $it->len
191 end
192 else
193 if ($it->what == IT_IMAGE)
194 printf " IMAGE=%d", $it->image_id
195 else
196 printf " "
197 output $it->what
198 end
199 end
200 if ($it->method != GET_FROM_BUFFER)
201 printf " next="
202 output $it->method
203 if ($it->method == GET_FROM_STRING)
204 printf "[%d]", $it->current.string_pos.charpos
205 end
206 end
207 printf "\n"
208 if ($it->region_beg_charpos >= 0)
209 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
210 end
211 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
212 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
213 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
214 printf " w=%d", $it->pixel_width
215 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
216 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
217 printf "\n"
218 end
219 document pitx
220 Pretty print a display iterator.
221 Take one arg, an iterator object or pointer.
222 end
223
224 define pit
225 pitx it
226 end
227 document pit
228 Pretty print the display iterator it.
229 end
230
231 define prowx
232 set $row = $arg0
233 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
234 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
235 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
236 printf " vis=%d", $row->visible_height
237 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
238 printf "\n"
239 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
240 if ($row->enabled_p)
241 printf " ENA"
242 end
243 if ($row->displays_text_p)
244 printf " DISP"
245 end
246 if ($row->mode_line_p)
247 printf " MODEL"
248 end
249 if ($row->continued_p)
250 printf " CONT"
251 end
252 if ($row-> truncated_on_left_p)
253 printf " TRUNC:L"
254 end
255 if ($row-> truncated_on_right_p)
256 printf " TRUNC:R"
257 end
258 if ($row->starts_in_middle_of_char_p)
259 printf " STARTMID"
260 end
261 if ($row->ends_in_middle_of_char_p)
262 printf " ENDMID"
263 end
264 if ($row->ends_in_newline_from_string_p)
265 printf " ENDNLFS"
266 end
267 if ($row->ends_at_zv_p)
268 printf " ENDZV"
269 end
270 if ($row->overlapped_p)
271 printf " OLAPD"
272 end
273 if ($row->overlapping_p)
274 printf " OLAPNG"
275 end
276 printf "\n"
277 end
278 document prowx
279 Pretty print information about glyph_row.
280 Takes one argument, a row object or pointer.
281 end
282
283 define prow
284 prowx row
285 end
286 document prow
287 Pretty print information about glyph_row in row.
288 end
289
290
291 define pcursorx
292 set $cp = $arg0
293 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
294 end
295 document pcursorx
296 Pretty print a window cursor
297 end
298
299 define pcursor
300 printf "output: "
301 pcursorx output_cursor
302 printf "\n"
303 end
304 document pcursor
305 Pretty print the output_cursor
306 end
307
308 define pwinx
309 set $w = $arg0
310 xgetint $w->sequence_number
311 if ($w->mini_p != Qnil)
312 printf "Mini "
313 end
314 printf "Window %d ", $int
315 xgetptr $w->buffer
316 set $tem = (struct buffer *) $ptr
317 xgetptr $tem->name
318 printf "%s", ((struct Lisp_String *) $ptr)->data
319 printf "\n"
320 xgetptr $w->start
321 set $tem = (struct Lisp_Marker *) $ptr
322 printf "start=%d end:", $tem->charpos
323 if ($w->window_end_valid != Qnil)
324 xgetint $w->window_end_pos
325 printf "pos=%d", $int
326 xgetint $w->window_end_vpos
327 printf " vpos=%d", $int
328 else
329 printf "invalid"
330 end
331 printf " vscroll=%d", $w->vscroll
332 if ($w->force_start != Qnil)
333 printf " FORCE_START"
334 end
335 if ($w->must_be_updated_p)
336 printf " MUST_UPD"
337 end
338 printf "\n"
339 printf "cursor: "
340 pcursorx $w->cursor
341 printf " phys: "
342 pcursorx $w->phys_cursor
343 if ($w->phys_cursor_on_p)
344 printf " ON"
345 else
346 printf " OFF"
347 end
348 printf " blk="
349 if ($w->last_cursor_off_p != $w->cursor_off_p)
350 if ($w->last_cursor_off_p)
351 printf "ON->"
352 else
353 printf "OFF->"
354 end
355 end
356 if ($w->cursor_off_p)
357 printf "ON"
358 else
359 printf "OFF"
360 end
361 printf "\n"
362 end
363 document pwinx
364 Pretty print a window structure.
365 Takes one argument, a pointer to a window structure
366 end
367
368 define pwin
369 pwinx w
370 end
371 document pwin
372 Pretty print window structure w.
373 end
374
375
376 define xtype
377 xgettype $
378 output $type
379 echo \n
380 if $type == Lisp_Misc
381 xmisctype
382 else
383 if $type == Lisp_Vectorlike
384 xvectype
385 end
386 end
387 end
388 document xtype
389 Print the type of $, assuming it is an Emacs Lisp value.
390 If the first type printed is Lisp_Vector or Lisp_Misc,
391 a second line gives the more precise type.
392 end
393
394 define xvectype
395 xgetptr $
396 set $size = ((struct Lisp_Vector *) $ptr)->size
397 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
398 echo \n
399 end
400 document xvectype
401 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
402 end
403
404 define xmisctype
405 xgetptr $
406 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
407 echo \n
408 end
409 document xmisctype
410 Print the specific type of $, assuming it is some misc type.
411 end
412
413 define xint
414 xgetint $
415 print $int
416 end
417 document xint
418 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
419 end
420
421 define xptr
422 xgetptr $
423 print (void *) $ptr
424 end
425 document xptr
426 Print the pointer portion of $, assuming it is an Emacs Lisp value.
427 end
428
429 define xmarker
430 xgetptr $
431 print (struct Lisp_Marker *) $ptr
432 end
433 document xmarker
434 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
435 end
436
437 define xoverlay
438 xgetptr $
439 print (struct Lisp_Overlay *) $ptr
440 end
441 document xoverlay
442 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
443 end
444
445 define xmiscfree
446 xgetptr $
447 print (struct Lisp_Free *) $ptr
448 end
449 document xmiscfree
450 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
451 end
452
453 define xintfwd
454 xgetptr $
455 print (struct Lisp_Intfwd *) $ptr
456 end
457 document xintfwd
458 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
459 end
460
461 define xboolfwd
462 xgetptr $
463 print (struct Lisp_Boolfwd *) $ptr
464 end
465 document xboolfwd
466 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
467 end
468
469 define xobjfwd
470 xgetptr $
471 print (struct Lisp_Objfwd *) $ptr
472 end
473 document xobjfwd
474 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
475 end
476
477 define xbufobjfwd
478 xgetptr $
479 print (struct Lisp_Buffer_Objfwd *) $ptr
480 end
481 document xbufobjfwd
482 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
483 end
484
485 define xkbobjfwd
486 xgetptr $
487 print (struct Lisp_Kboard_Objfwd *) $ptr
488 end
489 document xkbobjfwd
490 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
491 end
492
493 define xbuflocal
494 xgetptr $
495 print (struct Lisp_Buffer_Local_Value *) $ptr
496 end
497 document xbuflocal
498 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
499 end
500
501 define xsymbol
502 set $sym = $
503 xgetptr $sym
504 print (struct Lisp_Symbol *) $ptr
505 xprintsym $sym
506 echo \n
507 end
508 document xsymbol
509 Print the name and address of the symbol $.
510 This command assumes that $ is an Emacs Lisp symbol value.
511 end
512
513 define xstring
514 xgetptr $
515 print (struct Lisp_String *) $ptr
516 xprintstr $
517 echo \n
518 end
519 document xstring
520 Print the contents and address of the string $.
521 This command assumes that $ is an Emacs Lisp string value.
522 end
523
524 define xvector
525 xgetptr $
526 print (struct Lisp_Vector *) $ptr
527 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
528 echo \n
529 end
530 document xvector
531 Print the contents and address of the vector $.
532 This command assumes that $ is an Emacs Lisp vector value.
533 end
534
535 define xprocess
536 xgetptr $
537 print (struct Lisp_Process *) $ptr
538 output *$
539 echo \n
540 end
541 document xprocess
542 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
543 end
544
545 define xframe
546 xgetptr $
547 print (struct frame *) $ptr
548 xgetptr $->name
549 set $ptr = (struct Lisp_String *) $ptr
550 xprintstr $ptr
551 echo \n
552 end
553 document xframe
554 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
555 end
556
557 define xcompiled
558 xgetptr $
559 print (struct Lisp_Vector *) $ptr
560 output ($->contents[0])@($->size & 0xff)
561 end
562 document xcompiled
563 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
564 end
565
566 define xwindow
567 xgetptr $
568 print (struct window *) $ptr
569 set $window = (struct window *) $ptr
570 xgetint $window->total_cols
571 set $width=$int
572 xgetint $window->total_lines
573 set $height=$int
574 xgetint $window->left_col
575 set $left=$int
576 xgetint $window->top_line
577 set $top=$int
578 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
579 end
580 document xwindow
581 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
582 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
583 end
584
585 define xwinconfig
586 xgetptr $
587 print (struct save_window_data *) $ptr
588 end
589 document xwinconfig
590 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
591 end
592
593 define xsubr
594 xgetptr $
595 print (struct Lisp_Subr *) $ptr
596 output *$
597 echo \n
598 end
599 document xsubr
600 Print the address of the subr which the Lisp_Object $ points to.
601 end
602
603 define xchartable
604 xgetptr $
605 print (struct Lisp_Char_Table *) $ptr
606 printf "Purpose: "
607 xprintsym $->purpose
608 printf " %d extra slots", ($->size & 0x1ff) - 388
609 echo \n
610 end
611 document xchartable
612 Print the address of the char-table $, and its purpose.
613 This command assumes that $ is an Emacs Lisp char-table value.
614 end
615
616 define xboolvector
617 xgetptr $
618 print (struct Lisp_Bool_Vector *) $ptr
619 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
620 echo \n
621 end
622 document xboolvector
623 Print the contents and address of the bool-vector $.
624 This command assumes that $ is an Emacs Lisp bool-vector value.
625 end
626
627 define xbuffer
628 xgetptr $
629 print (struct buffer *) $ptr
630 xgetptr $->name
631 output ((struct Lisp_String *) $ptr)->data
632 echo \n
633 end
634 document xbuffer
635 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
636 Print the name of the buffer.
637 end
638
639 define xhashtable
640 xgetptr $
641 print (struct Lisp_Hash_Table *) $ptr
642 end
643 document xhashtable
644 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
645 end
646
647 define xcons
648 xgetptr $
649 print (struct Lisp_Cons *) $ptr
650 output/x *$
651 echo \n
652 end
653 document xcons
654 Print the contents of $, assuming it is an Emacs Lisp cons.
655 end
656
657 define nextcons
658 p $.u.cdr
659 xcons
660 end
661 document nextcons
662 Print the contents of the next cell in a list.
663 This assumes that the last thing you printed was a cons cell contents
664 (type struct Lisp_Cons) or a pointer to one.
665 end
666 define xcar
667 xgetptr $
668 xgettype $
669 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
670 end
671 document xcar
672 Print the car of $, assuming it is an Emacs Lisp pair.
673 end
674
675 define xcdr
676 xgetptr $
677 xgettype $
678 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
679 end
680 document xcdr
681 Print the cdr of $, assuming it is an Emacs Lisp pair.
682 end
683
684 define xlist
685 xgetptr $
686 set $cons = (struct Lisp_Cons *) $ptr
687 xgetptr Qnil
688 set $nil = $ptr
689 set $i = 0
690 while $cons != $nil && $i < 10
691 p/x $cons->car
692 xpr
693 xgetptr $cons->u.cdr
694 set $cons = (struct Lisp_Cons *) $ptr
695 set $i = $i + 1
696 printf "---\n"
697 end
698 if $cons == $nil
699 printf "nil\n"
700 else
701 printf "...\n"
702 p $ptr
703 end
704 end
705 document xlist
706 Print $ assuming it is a list.
707 end
708
709 define xfloat
710 xgetptr $
711 print ((struct Lisp_Float *) $ptr)->u.data
712 end
713 document xfloat
714 Print $ assuming it is a lisp floating-point number.
715 end
716
717 define xscrollbar
718 xgetptr $
719 print (struct scrollbar *) $ptr
720 output *$
721 echo \n
722 end
723 document xscrollbar
724 Print $ as a scrollbar pointer.
725 end
726
727 define xpr
728 xtype
729 if $type == Lisp_Int
730 xint
731 end
732 if $type == Lisp_Symbol
733 xsymbol
734 end
735 if $type == Lisp_String
736 xstring
737 end
738 if $type == Lisp_Cons
739 xcons
740 end
741 if $type == Lisp_Float
742 xfloat
743 end
744 if $type == Lisp_Misc
745 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
746 if $misc == Lisp_Misc_Free
747 xmiscfree
748 end
749 if $misc == Lisp_Misc_Boolfwd
750 xboolfwd
751 end
752 if $misc == Lisp_Misc_Marker
753 xmarker
754 end
755 if $misc == Lisp_Misc_Intfwd
756 xintfwd
757 end
758 if $misc == Lisp_Misc_Boolfwd
759 xboolfwd
760 end
761 if $misc == Lisp_Misc_Objfwd
762 xobjfwd
763 end
764 if $misc == Lisp_Misc_Buffer_Objfwd
765 xbufobjfwd
766 end
767 if $misc == Lisp_Misc_Buffer_Local_Value
768 xbuflocal
769 end
770 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
771 # xvalue
772 # end
773 if $misc == Lisp_Misc_Overlay
774 xoverlay
775 end
776 if $misc == Lisp_Misc_Kboard_Objfwd
777 xkbobjfwd
778 end
779 # if $misc == Lisp_Misc_Save_Value
780 # xsavevalue
781 # end
782 end
783 if $type == Lisp_Vectorlike
784 set $size = ((struct Lisp_Vector *) $ptr)->size
785 if ($size & PVEC_FLAG)
786 set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
787 if $vec == PVEC_NORMAL_VECTOR
788 xvector
789 end
790 if $vec == PVEC_PROCESS
791 xprocess
792 end
793 if $vec == PVEC_FRAME
794 xframe
795 end
796 if $vec == PVEC_COMPILED
797 xcompiled
798 end
799 if $vec == PVEC_WINDOW
800 xwindow
801 end
802 if $vec == PVEC_WINDOW_CONFIGURATION
803 xwinconfig
804 end
805 if $vec == PVEC_SUBR
806 xsubr
807 end
808 if $vec == PVEC_CHAR_TABLE
809 xchartable
810 end
811 if $vec == PVEC_BOOL_VECTOR
812 xboolvector
813 end
814 if $vec == PVEC_BUFFER
815 xbuffer
816 end
817 if $vec == PVEC_HASH_TABLE
818 xhashtable
819 end
820 else
821 xvector
822 end
823 end
824 end
825 document xpr
826 Print $ as a lisp object of any type.
827 end
828
829 define xprintstr
830 set $data = $arg0->data
831 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
832 end
833
834 define xprintsym
835 xgetptr $arg0
836 set $sym = (struct Lisp_Symbol *) $ptr
837 xgetptr $sym->xname
838 set $sym_name = (struct Lisp_String *) $ptr
839 xprintstr $sym_name
840 end
841 document xprintsym
842 Print argument as a symbol.
843 end
844
845 define xbacktrace
846 set $bt = backtrace_list
847 while $bt
848 xgettype (*$bt->function)
849 if $type == Lisp_Symbol
850 xprintsym (*$bt->function)
851 printf " (0x%x)\n", *$bt->args
852 else
853 printf "0x%x ", *$bt->function
854 if $type == Lisp_Vectorlike
855 xgetptr (*$bt->function)
856 set $size = ((struct Lisp_Vector *) $ptr)->size
857 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
858 else
859 printf "Lisp type %d", $type
860 end
861 echo \n
862 end
863 set $bt = $bt->next
864 end
865 end
866 document xbacktrace
867 Print a backtrace of Lisp function calls from backtrace_list.
868 Set a breakpoint at Fsignal and call this to see from where
869 an error was signaled.
870 end
871
872 define which
873 set debug_print (which_symbols ($arg0))
874 end
875 document which
876 Print symbols which references a given lisp object,
877 either as its symbol value or symbol function.
878 end
879
880 define xbytecode
881 set $bt = byte_stack_list
882 while $bt
883 xgettype ($bt->byte_string)
884 printf "0x%x => ", $bt->byte_string
885 which $bt->byte_string
886 set $bt = $bt->next
887 end
888 end
889 document xbytecode
890 Print a backtrace of the byte code stack.
891 end
892
893 # Show Lisp backtrace after normal backtrace.
894 define hookpost-backtrace
895 set $bt = backtrace_list
896 if $bt
897 echo \n
898 echo Lisp Backtrace:\n
899 xbacktrace
900 end
901 end
902
903 define xreload
904 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
905 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
906 end
907 document xreload
908 When starting Emacs a second time in the same gdb session under
909 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
910 their values. (The same happens on current (2000) versions of GNU/Linux
911 with gdb 5.0.)
912 This function reloads them.
913 end
914 xreload
915
916 # Flush display (X only)
917 define ff
918 set x_flush (0)
919 end
920 document ff
921 Flush pending X window display updates to screen.
922 Works only when an inferior emacs is executing.
923 end
924
925
926 define hook-run
927 xreload
928 end
929
930 # Call xreload if a new Emacs executable is loaded.
931 define hookpost-run
932 xreload
933 end
934
935 set print pretty on
936 set print sevenbit-strings
937
938 show environment DISPLAY
939 show environment TERM
940 set args -geometry 80x40+0+0
941
942 # People get bothered when they see messages about non-existent functions...
943 xgetptr Vsystem_type
944 # $ptr is NULL in temacs
945 if ($ptr != 0)
946 set $tem = (struct Lisp_Symbol *) $ptr
947 xgetptr $tem->xname
948 set $tem = (struct Lisp_String *) $ptr
949 set $tem = (char *) $tem->data
950
951 # Don't let abort actually run, as it will make stdio stop working and
952 # therefore the `pr' command above as well.
953 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
954 # The windows-nt build replaces abort with its own function.
955 break w32_abort
956 else
957 break abort
958 end
959 end
960
961 # x_error_quitter is defined only on X. But window-system is set up
962 # only at run time, during Emacs startup, so we need to defer setting
963 # the breakpoint. init_sys_modes is the first function called on
964 # every platform after init_display, where window-system is set.
965 tbreak init_sys_modes
966 commands
967 silent
968 xgetptr Vwindow_system
969 set $tem = (struct Lisp_Symbol *) $ptr
970 xgetptr $tem->xname
971 set $tem = (struct Lisp_String *) $ptr
972 set $tem = (char *) $tem->data
973 # If we are running in synchronous mode, we want a chance to look
974 # around before Emacs exits. Perhaps we should put the break
975 # somewhere else instead...
976 if $tem[0] == 'x' && $tem[1] == '\0'
977 break x_error_quitter
978 end
979 continue
980 end
981 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe