1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
2 # 2004, 2005, 2006 Free Software Foundation, Inc.
4 # This file is part of GNU Emacs.
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)
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.
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.
21 # Force loading of symbols, enough to give us gdb_valbits etc.
24 # Find lwlib source files too.
26 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
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.
34 # Make it work like SIGINT normally does.
37 # Pass on user signals
38 handle SIGUSR1 noprint pass
39 handle SIGUSR2 noprint pass
41 # Don't pass SIGALRM to Emacs. This makes problems when
45 # $valmask and $tagmask are mask values set up by the xreload macro below.
47 # Use $bugfix so that the value isn't a constant.
48 # Using a constant runs into GDB bugs sometimes.
51 set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
56 set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
61 set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
64 # Set up something to print out s-expressions.
65 # We save and restore print_output_debug_flag to prevent the w32 port
66 # from calling OutputDebugString, which causes GDB to display each
67 # character twice (yuk!).
69 set $output_debug = print_output_debug_flag
70 set print_output_debug_flag = 0
72 set print_output_debug_flag = $output_debug
75 Print the emacs s-expression which is $.
76 Works only when an inferior emacs is executing.
79 # Print out s-expressions
82 set $output_debug = print_output_debug_flag
83 set print_output_debug_flag = 0
84 set safe_debug_print ($tmp)
85 set print_output_debug_flag = $output_debug
88 Print the argument as an emacs s-expression
89 Works only when an inferior emacs is executing.
92 # Print out s-expressions from tool bar
95 set $output_debug = print_output_debug_flag
96 set print_output_debug_flag = 0
97 set safe_debug_print ($tmp)
98 set print_output_debug_flag = $output_debug
101 Print the argument as an emacs s-expression.
102 Works only when an inferior emacs is executing.
103 For use on tool bar when debugging in Emacs
104 where the variable name would not otherwise
105 be recorded in the GUD buffer.
108 # Print value of lisp variable
111 set $output_debug = print_output_debug_flag
112 set print_output_debug_flag = 0
113 set safe_debug_print ( find_symbol_value (intern ($tmp)))
114 set print_output_debug_flag = $output_debug
117 Print the value of the lisp variable given as argument.
118 Works only when an inferior emacs is executing.
121 # Print value of lisp variable
124 set $output_debug = print_output_debug_flag
125 set print_output_debug_flag = 0
126 set safe_debug_print (find_symbol_value (intern ($tmp)))
127 set print_output_debug_flag = $output_debug
130 Print the value of the lisp variable given as argument.
131 Works only when an inferior emacs is executing.
132 For use when debugging in Emacs where the variable
133 name would not otherwise be recorded in the GUD buffer.
136 # Print out current buffer point and boundaries
138 set $b = current_buffer
140 printf "BUF PT: %d", $b->pt
141 if ($b->pt != $b->pt_byte)
142 printf "[%d]", $b->pt_byte
144 printf " of 1..%d", $t->z
145 if ($t->z != $t->z_byte)
146 printf "[%d]", $t->z_byte
148 if ($b->begv != 1 || $b->zv != $t->z)
149 printf " NARROW=%d..%d", $b->begv, $b->zv
150 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
151 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
154 printf " GAP: %d", $t->gpt
155 if ($t->gpt != $t->gpt_byte)
156 printf "[%d]", $t->gpt_byte
158 printf " SZ=%d\n", $t->gap_size
161 Print point, beg, end, narrow, and gap for current buffer.
164 # Print out iterator given as first arg
167 printf "cur=%d", $it->current.pos.charpos
168 if ($it->current.pos.charpos != $it->current.pos.bytepos)
169 printf "[%d]", $it->current.pos.bytepos
171 printf " pos=%d", $it->position.charpos
172 if ($it->position.charpos != $it->position.bytepos)
173 printf "[%d]", $it->position.bytepos
175 printf " start=%d", $it->start.pos.charpos
176 if ($it->start.pos.charpos != $it->start.pos.bytepos)
177 printf "[%d]", $it->start.pos.bytepos
179 printf " end=%d", $it->end_charpos
180 printf " stop=%d", $it->stop_charpos
181 printf " face=%d", $it->face_id
182 if ($it->multibyte_p)
185 if ($it->header_line_p)
188 if ($it->n_overlay_strings > 0)
189 printf " nov=%d", $it->n_overlay_strings
192 printf " sp=%d", $it->sp
194 if ($it->what == IT_CHARACTER)
195 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
196 printf " ch='%c'", $it->c
198 printf " ch=[%d,%d]", $it->c, $it->len
204 if ($it->method != GET_FROM_BUFFER)
207 if ($it->method == GET_FROM_STRING)
208 printf "[%d]", $it->current.string_pos.charpos
210 if ($it->method == GET_FROM_IMAGE)
211 printf "[%d]", $it->image_id
213 if ($it->method == GET_FROM_COMPOSITION)
214 printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
218 if ($it->region_beg_charpos >= 0)
219 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
221 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
222 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
223 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
224 printf " w=%d", $it->pixel_width
225 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
226 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
229 while ($i < $it->sp && $i < 4)
230 set $e = $it->stack[$i]
231 printf "stack[%d]: ", $i
233 printf "[%d]", $e->position.charpos
239 Pretty print a display iterator.
240 Take one arg, an iterator object or pointer.
247 Pretty print the display iterator it.
252 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
253 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
254 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
255 printf " vis=%d", $row->visible_height
256 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
258 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
262 if ($row->displays_text_p)
265 if ($row->mode_line_p)
268 if ($row->continued_p)
271 if ($row-> truncated_on_left_p)
274 if ($row-> truncated_on_right_p)
277 if ($row->starts_in_middle_of_char_p)
280 if ($row->ends_in_middle_of_char_p)
283 if ($row->ends_in_newline_from_string_p)
286 if ($row->ends_at_zv_p)
289 if ($row->overlapped_p)
292 if ($row->overlapping_p)
298 Pretty print information about glyph_row.
299 Takes one argument, a row object or pointer.
306 Pretty print information about glyph_row in row.
312 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
315 Pretty print a window cursor
320 pcursorx output_cursor
324 Pretty print the output_cursor
329 xgetint $w->sequence_number
330 if ($w->mini_p != Qnil)
333 printf "Window %d ", $int
335 set $tem = (struct buffer *) $ptr
337 printf "%s", ((struct Lisp_String *) $ptr)->data
340 set $tem = (struct Lisp_Marker *) $ptr
341 printf "start=%d end:", $tem->charpos
342 if ($w->window_end_valid != Qnil)
343 xgetint $w->window_end_pos
344 printf "pos=%d", $int
345 xgetint $w->window_end_vpos
346 printf " vpos=%d", $int
350 printf " vscroll=%d", $w->vscroll
351 if ($w->force_start != Qnil)
352 printf " FORCE_START"
354 if ($w->must_be_updated_p)
361 pcursorx $w->phys_cursor
362 if ($w->phys_cursor_on_p)
368 if ($w->last_cursor_off_p != $w->cursor_off_p)
369 if ($w->last_cursor_off_p)
375 if ($w->cursor_off_p)
383 Pretty print a window structure.
384 Takes one argument, a pointer to a window structure
391 Pretty print window structure w.
396 if ($g->type == CHAR_GLYPH)
397 if ($g->u.ch >= ' ' && $g->u.ch < 127)
398 printf "CHAR[%c]", $g->u.ch
400 printf "CHAR[0x%x]", $g->u.ch
403 if ($g->type == COMPOSITE_GLYPH)
404 printf "COMP[%d]", $g->u.cmp_id
406 if ($g->type == IMAGE_GLYPH)
407 printf "IMAGE[%d]", $g->u.img_id
409 if ($g->type == STRETCH_GLYPH)
410 printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
412 xgettype ($g->object)
413 if ($type == Lisp_String)
414 printf " str=%x[%d]", $g->object, $g->charpos
416 printf " pos=%d", $g->charpos
418 printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
419 if ($g->face_id != DEFAULT_FACE_ID)
420 printf " face=%d", $g->face_id
423 printf " vof=%d", $g->voffset
431 if ($g->glyph_not_available_p)
434 if ($g->overlaps_vertically_p)
437 if ($g->left_box_line_p)
440 if ($g->right_box_line_p)
443 if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
444 printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
449 Pretty print a glyph structure.
450 Takes one argument, a pointer to a glyph structure
458 Pretty print glyph structure glyph.
466 Pretty print glyph structure glyph[I].
467 Takes one argument, a integer I.
471 set $pgidx = $pgidx + 1
475 Pretty print next glyph structure.
483 set $used = $row->used[$area]
485 set $gl0 = $row->glyphs[$area]
487 printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
488 while ($pgidx < $used)
489 printf "%3d %4d: ", $pgidx, $xofs
491 set $xofs = $xofs + $gl0[$pgidx]->pixel_width
492 set $pgidx = $pgidx + 1
495 set $area = $area + 1
499 Pretty print all glyphs in a row structure.
500 Takes one argument, a pointer to a row structure.
507 Pretty print all glyphs in row structure row.
514 if $type == Lisp_Misc
517 if $type == Lisp_Vectorlike
523 Print the type of $, assuming it is an Emacs Lisp value.
524 If the first type printed is Lisp_Vector or Lisp_Misc,
525 a second line gives the more precise type.
530 set $size = ((struct Lisp_Vector *) $ptr)->size
531 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
535 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
540 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
544 Print the specific type of $, assuming it is some misc type.
552 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
560 Print the pointer portion of $, assuming it is an Emacs Lisp value.
565 print (struct Lisp_Marker *) $ptr
568 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
573 print (struct Lisp_Overlay *) $ptr
576 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
581 print (struct Lisp_Free *) $ptr
584 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
589 print (struct Lisp_Intfwd *) $ptr
592 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
597 print (struct Lisp_Boolfwd *) $ptr
600 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
605 print (struct Lisp_Objfwd *) $ptr
608 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
613 print (struct Lisp_Buffer_Objfwd *) $ptr
616 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
621 print (struct Lisp_Kboard_Objfwd *) $ptr
624 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
629 print (struct Lisp_Buffer_Local_Value *) $ptr
632 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
638 print (struct Lisp_Symbol *) $ptr
643 Print the name and address of the symbol $.
644 This command assumes that $ is an Emacs Lisp symbol value.
649 print (struct Lisp_String *) $ptr
654 Print the contents and address of the string $.
655 This command assumes that $ is an Emacs Lisp string value.
660 print (struct Lisp_Vector *) $ptr
661 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
665 Print the contents and address of the vector $.
666 This command assumes that $ is an Emacs Lisp vector value.
671 print (struct Lisp_Process *) $ptr
676 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
681 print (struct frame *) $ptr
683 set $ptr = (struct Lisp_String *) $ptr
688 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
693 print (struct Lisp_Vector *) $ptr
694 output ($->contents[0])@($->size & 0xff)
697 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
702 print (struct window *) $ptr
703 set $window = (struct window *) $ptr
704 xgetint $window->total_cols
706 xgetint $window->total_lines
708 xgetint $window->left_col
710 xgetint $window->top_line
712 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
715 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
716 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
721 print (struct save_window_data *) $ptr
724 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
729 print (struct Lisp_Subr *) $ptr
734 Print the address of the subr which the Lisp_Object $ points to.
739 print (struct Lisp_Char_Table *) $ptr
742 printf " %d extra slots", ($->size & 0x1ff) - 388
746 Print the address of the char-table $, and its purpose.
747 This command assumes that $ is an Emacs Lisp char-table value.
752 print (struct Lisp_Bool_Vector *) $ptr
753 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
757 Print the contents and address of the bool-vector $.
758 This command assumes that $ is an Emacs Lisp bool-vector value.
763 print (struct buffer *) $ptr
765 output ((struct Lisp_String *) $ptr)->data
769 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
770 Print the name of the buffer.
775 print (struct Lisp_Hash_Table *) $ptr
778 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
783 print (struct Lisp_Cons *) $ptr
788 Print the contents of $, assuming it is an Emacs Lisp cons.
796 Print the contents of the next cell in a list.
797 This assumes that the last thing you printed was a cons cell contents
798 (type struct Lisp_Cons) or a pointer to one.
803 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
806 Print the car of $, assuming it is an Emacs Lisp pair.
812 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
815 Print the cdr of $, assuming it is an Emacs Lisp pair.
820 set $cons = (struct Lisp_Cons *) $ptr
824 while $cons != $nil && $i < 10
828 set $cons = (struct Lisp_Cons *) $ptr
840 Print $ assuming it is a list.
845 print ((struct Lisp_Float *) $ptr)->u.data
848 Print $ assuming it is a lisp floating-point number.
853 print (struct scrollbar *) $ptr
858 Print $ as a scrollbar pointer.
866 if $type == Lisp_Symbol
869 if $type == Lisp_String
872 if $type == Lisp_Cons
875 if $type == Lisp_Float
878 if $type == Lisp_Misc
879 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
880 if $misc == Lisp_Misc_Free
883 if $misc == Lisp_Misc_Boolfwd
886 if $misc == Lisp_Misc_Marker
889 if $misc == Lisp_Misc_Intfwd
892 if $misc == Lisp_Misc_Boolfwd
895 if $misc == Lisp_Misc_Objfwd
898 if $misc == Lisp_Misc_Buffer_Objfwd
901 if $misc == Lisp_Misc_Buffer_Local_Value
904 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
907 if $misc == Lisp_Misc_Overlay
910 if $misc == Lisp_Misc_Kboard_Objfwd
913 # if $misc == Lisp_Misc_Save_Value
917 if $type == Lisp_Vectorlike
918 set $size = ((struct Lisp_Vector *) $ptr)->size
919 if ($size & PVEC_FLAG)
920 set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
921 if $vec == PVEC_NORMAL_VECTOR
924 if $vec == PVEC_PROCESS
927 if $vec == PVEC_FRAME
930 if $vec == PVEC_COMPILED
933 if $vec == PVEC_WINDOW
936 if $vec == PVEC_WINDOW_CONFIGURATION
942 if $vec == PVEC_CHAR_TABLE
945 if $vec == PVEC_BOOL_VECTOR
948 if $vec == PVEC_BUFFER
951 if $vec == PVEC_HASH_TABLE
960 Print $ as a lisp object of any type.
964 set $data = $arg0->data
965 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
970 set $sym = (struct Lisp_Symbol *) $ptr
972 set $sym_name = (struct Lisp_String *) $ptr
976 Print argument as a symbol.
980 set $bt = backtrace_list
982 xgettype (*$bt->function)
983 if $type == Lisp_Symbol
984 xprintsym (*$bt->function)
985 printf " (0x%x)\n", *$bt->args
987 printf "0x%x ", *$bt->function
988 if $type == Lisp_Vectorlike
989 xgetptr (*$bt->function)
990 set $size = ((struct Lisp_Vector *) $ptr)->size
991 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
993 printf "Lisp type %d", $type
1001 Print a backtrace of Lisp function calls from backtrace_list.
1002 Set a breakpoint at Fsignal and call this to see from where
1003 an error was signaled.
1007 set debug_print (which_symbols ($arg0))
1010 Print symbols which references a given lisp object,
1011 either as its symbol value or symbol function.
1015 set $bt = byte_stack_list
1017 xgettype ($bt->byte_string)
1018 printf "0x%x => ", $bt->byte_string
1019 which $bt->byte_string
1024 Print a backtrace of the byte code stack.
1027 # Show Lisp backtrace after normal backtrace.
1028 define hookpost-backtrace
1029 set $bt = backtrace_list
1032 echo Lisp Backtrace:\n
1038 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1039 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1042 When starting Emacs a second time in the same gdb session under
1043 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1044 their values. (The same happens on current (2000) versions of GNU/Linux
1046 This function reloads them.
1050 # Flush display (X only)
1055 Flush pending X window display updates to screen.
1056 Works only when an inferior emacs is executing.
1064 # Call xreload if a new Emacs executable is loaded.
1070 set print sevenbit-strings
1072 show environment DISPLAY
1073 show environment TERM
1074 set args -geometry 80x40+0+0
1076 # People get bothered when they see messages about non-existent functions...
1077 xgetptr Vsystem_type
1078 # $ptr is NULL in temacs
1080 set $tem = (struct Lisp_Symbol *) $ptr
1082 set $tem = (struct Lisp_String *) $ptr
1083 set $tem = (char *) $tem->data
1085 # Don't let abort actually run, as it will make stdio stop working and
1086 # therefore the `pr' command above as well.
1087 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1088 # The windows-nt build replaces abort with its own function.
1095 # x_error_quitter is defined only on X. But window-system is set up
1096 # only at run time, during Emacs startup, so we need to defer setting
1097 # the breakpoint. init_sys_modes is the first function called on
1098 # every platform after init_display, where window-system is set.
1099 tbreak init_sys_modes
1102 xgetptr Vwindow_system
1103 set $tem = (struct Lisp_Symbol *) $ptr
1105 set $tem = (struct Lisp_String *) $ptr
1106 set $tem = (char *) $tem->data
1107 # If we are running in synchronous mode, we want a chance to look
1108 # around before Emacs exits. Perhaps we should put the break
1109 # somewhere else instead...
1110 if $tem[0] == 'x' && $tem[1] == '\0'
1111 break x_error_quitter
1115 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe