1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
2 # 2002, 2003, 2004, 2005, 2006, 2007 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 3, 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 current buffer's point and boundaries.
162 Prints values of point, beg, end, narrow, and gap for current buffer.
165 # Print out iterator given as first arg
168 printf "cur=%d", $it->current.pos.charpos
169 if ($it->current.pos.charpos != $it->current.pos.bytepos)
170 printf "[%d]", $it->current.pos.bytepos
172 printf " pos=%d", $it->position.charpos
173 if ($it->position.charpos != $it->position.bytepos)
174 printf "[%d]", $it->position.bytepos
176 printf " start=%d", $it->start.pos.charpos
177 if ($it->start.pos.charpos != $it->start.pos.bytepos)
178 printf "[%d]", $it->start.pos.bytepos
180 printf " end=%d", $it->end_charpos
181 printf " stop=%d", $it->stop_charpos
182 printf " face=%d", $it->face_id
183 if ($it->multibyte_p)
186 if ($it->header_line_p)
189 if ($it->n_overlay_strings > 0)
190 printf " nov=%d", $it->n_overlay_strings
193 printf " sp=%d", $it->sp
195 if ($it->what == IT_CHARACTER)
196 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
197 printf " ch='%c'", $it->c
199 printf " ch=[%d,%d]", $it->c, $it->len
205 if ($it->method != GET_FROM_BUFFER)
208 if ($it->method == GET_FROM_STRING)
209 printf "[%d]", $it->current.string_pos.charpos
211 if ($it->method == GET_FROM_IMAGE)
212 printf "[%d]", $it->image_id
214 if ($it->method == GET_FROM_COMPOSITION)
215 printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
219 if ($it->region_beg_charpos >= 0)
220 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
222 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
223 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
224 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
225 printf " w=%d", $it->pixel_width
226 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
227 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
230 while ($i < $it->sp && $i < 4)
231 set $e = $it->stack[$i]
232 printf "stack[%d]: ", $i
234 printf "[%d]", $e->position.charpos
240 Pretty print a display iterator.
241 Take one arg, an iterator object or pointer.
248 Pretty print the display iterator it.
253 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
254 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
255 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
256 printf " vis=%d", $row->visible_height
257 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
259 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
263 if ($row->displays_text_p)
266 if ($row->mode_line_p)
269 if ($row->continued_p)
272 if ($row-> truncated_on_left_p)
275 if ($row-> truncated_on_right_p)
278 if ($row->starts_in_middle_of_char_p)
281 if ($row->ends_in_middle_of_char_p)
284 if ($row->ends_in_newline_from_string_p)
287 if ($row->ends_at_zv_p)
290 if ($row->overlapped_p)
293 if ($row->overlapping_p)
299 Pretty print information about glyph_row.
300 Takes one argument, a row object or pointer.
307 Pretty print information about glyph_row in row.
313 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
316 Pretty print a window cursor.
321 pcursorx output_cursor
325 Pretty print the output_cursor.
330 xgetint $w->sequence_number
331 if ($w->mini_p != Qnil)
334 printf "Window %d ", $int
336 set $tem = (struct buffer *) $ptr
338 printf "%s", ((struct Lisp_String *) $ptr)->data
341 set $tem = (struct Lisp_Marker *) $ptr
342 printf "start=%d end:", $tem->charpos
343 if ($w->window_end_valid != Qnil)
344 xgetint $w->window_end_pos
345 printf "pos=%d", $int
346 xgetint $w->window_end_vpos
347 printf " vpos=%d", $int
351 printf " vscroll=%d", $w->vscroll
352 if ($w->force_start != Qnil)
353 printf " FORCE_START"
355 if ($w->must_be_updated_p)
362 pcursorx $w->phys_cursor
363 if ($w->phys_cursor_on_p)
369 if ($w->last_cursor_off_p != $w->cursor_off_p)
370 if ($w->last_cursor_off_p)
376 if ($w->cursor_off_p)
384 Pretty print a window structure.
385 Takes one argument, a pointer to a window structure.
392 Pretty print window structure w.
397 if ($g->type == CHAR_GLYPH)
398 if ($g->u.ch >= ' ' && $g->u.ch < 127)
399 printf "CHAR[%c]", $g->u.ch
401 printf "CHAR[0x%x]", $g->u.ch
404 if ($g->type == COMPOSITE_GLYPH)
405 printf "COMP[%d]", $g->u.cmp_id
407 if ($g->type == IMAGE_GLYPH)
408 printf "IMAGE[%d]", $g->u.img_id
410 if ($g->type == STRETCH_GLYPH)
411 printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
413 xgettype ($g->object)
414 if ($type == Lisp_String)
415 printf " str=%x[%d]", $g->object, $g->charpos
417 printf " pos=%d", $g->charpos
419 printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
420 if ($g->face_id != DEFAULT_FACE_ID)
421 printf " face=%d", $g->face_id
424 printf " vof=%d", $g->voffset
432 if ($g->glyph_not_available_p)
435 if ($g->overlaps_vertically_p)
438 if ($g->left_box_line_p)
441 if ($g->right_box_line_p)
444 if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
445 printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
450 Pretty print a glyph structure.
451 Takes one argument, a pointer to a glyph structure.
459 Pretty print glyph structure glyph.
467 Pretty print glyph structure glyph[I].
468 Takes one argument, a integer I.
472 set $pgidx = $pgidx + 1
476 Pretty print next glyph structure.
484 set $used = $row->used[$area]
486 set $gl0 = $row->glyphs[$area]
488 printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
489 while ($pgidx < $used)
490 printf "%3d %4d: ", $pgidx, $xofs
492 set $xofs = $xofs + $gl0[$pgidx]->pixel_width
493 set $pgidx = $pgidx + 1
496 set $area = $area + 1
500 Pretty print all glyphs in a row structure.
501 Takes one argument, a pointer to a row structure.
508 Pretty print all glyphs in row structure row.
515 if $type == Lisp_Misc
518 if $type == Lisp_Vectorlike
524 Print the type of $, assuming it is an Emacs Lisp value.
525 If the first type printed is Lisp_Vector or Lisp_Misc,
526 a second line gives the more precise type.
531 set $size = ((struct Lisp_Vector *) $ptr)->size
532 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
536 Print the size or vector subtype of $.
537 This command assumes that $ is a vector or pseudovector.
542 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
546 Assume that $ is some misc type and print its specific type.
554 Print $ as an Emacs Lisp integer. This gets the sign right.
562 Print the pointer portion of an Emacs Lisp value in $.
567 print (struct Lisp_Marker *) $ptr
570 Print $ as a marker pointer.
571 This command assumes that $ is an Emacs Lisp marker value.
576 print (struct Lisp_Overlay *) $ptr
579 Print $ as a overlay pointer.
580 This command assumes that $ is an Emacs Lisp overlay value.
585 print (struct Lisp_Free *) $ptr
588 Print $ as a misc free-cell pointer.
589 This command assumes that $ is an Emacs Lisp Misc value.
594 print (struct Lisp_Intfwd *) $ptr
597 Print $ as an integer forwarding pointer.
598 This command assumes that $ is an Emacs Lisp Misc value.
603 print (struct Lisp_Boolfwd *) $ptr
606 Print $ as a boolean forwarding pointer.
607 This command assumes that $ is an Emacs Lisp Misc value.
612 print (struct Lisp_Objfwd *) $ptr
615 Print $ as an object forwarding pointer.
616 This command assumes that $ is an Emacs Lisp Misc value.
621 print (struct Lisp_Buffer_Objfwd *) $ptr
624 Print $ as a buffer-local object forwarding pointer.
625 This command assumes that $ is an Emacs Lisp Misc value.
630 print (struct Lisp_Kboard_Objfwd *) $ptr
633 Print $ as a kboard-local object forwarding pointer.
634 This command assumes that $ is an Emacs Lisp Misc value.
639 print (struct Lisp_Buffer_Local_Value *) $ptr
642 Print $ as a buffer-local-value pointer.
643 This command assumes that $ is an Emacs Lisp Misc value.
649 print (struct Lisp_Symbol *) $ptr
654 Print the name and address of the symbol $.
655 This command assumes that $ is an Emacs Lisp symbol value.
660 print (struct Lisp_String *) $ptr
665 Print the contents and address of the string $.
666 This command assumes that $ is an Emacs Lisp string value.
671 print (struct Lisp_Vector *) $ptr
672 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
676 Print the contents and address of the vector $.
677 This command assumes that $ is an Emacs Lisp vector value.
682 print (struct Lisp_Process *) $ptr
687 Print the address of the struct Lisp_process to which $ points.
688 This command assumes that $ is a Lisp_Object.
693 print (struct frame *) $ptr
695 set $ptr = (struct Lisp_String *) $ptr
700 Print $ as a frame pointer.
701 This command assumes $ is an Emacs Lisp frame value.
706 print (struct Lisp_Vector *) $ptr
707 output ($->contents[0])@($->size & 0xff)
710 Print $ as a compiled function pointer.
711 This command assumes that $ is an Emacs Lisp compiled value.
716 print (struct window *) $ptr
717 set $window = (struct window *) $ptr
718 xgetint $window->total_cols
720 xgetint $window->total_lines
722 xgetint $window->left_col
724 xgetint $window->top_line
726 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
729 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
730 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
735 print (struct save_window_data *) $ptr
738 Print $ as a window configuration pointer.
739 This command assumes that $ is an Emacs Lisp window configuration value.
744 print (struct Lisp_Subr *) $ptr
749 Print the address of the subr which the Lisp_Object $ points to.
754 print (struct Lisp_Char_Table *) $ptr
757 printf " %d extra slots", ($->size & 0x1ff) - 388
761 Print the address of the char-table $, and its purpose.
762 This command assumes that $ is an Emacs Lisp char-table value.
767 print (struct Lisp_Bool_Vector *) $ptr
768 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
772 Print the contents and address of the bool-vector $.
773 This command assumes that $ is an Emacs Lisp bool-vector value.
778 print (struct buffer *) $ptr
780 output ((struct Lisp_String *) $ptr)->data
784 Set $ as a buffer pointer and the name of the buffer.
785 This command assumes $ is an Emacs Lisp buffer value.
790 print (struct Lisp_Hash_Table *) $ptr
793 Set $ as a hash table pointer.
794 This command assumes that $ is an Emacs Lisp hash table value.
799 print (struct Lisp_Cons *) $ptr
804 Print the contents of $ as an Emacs Lisp cons.
812 Print the contents of the next cell in a list.
813 This command assumes that the last thing you printed was a cons cell contents
814 (type struct Lisp_Cons) or a pointer to one.
819 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
822 Assume that $ is an Emacs Lisp pair and print its car.
828 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
831 Assume that $ is an Emacs Lisp pair and print its cdr.
836 set $cons = (struct Lisp_Cons *) $ptr
840 while $cons != $nil && $i < 10
844 set $cons = (struct Lisp_Cons *) $ptr
856 Print $ assuming it is a list.
861 print ((struct Lisp_Float *) $ptr)->u.data
864 Print $ assuming it is a lisp floating-point number.
869 print (struct scrollbar *) $ptr
874 Print $ as a scrollbar pointer.
882 if $type == Lisp_Symbol
885 if $type == Lisp_String
888 if $type == Lisp_Cons
891 if $type == Lisp_Float
894 if $type == Lisp_Misc
895 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
896 if $misc == Lisp_Misc_Free
899 if $misc == Lisp_Misc_Boolfwd
902 if $misc == Lisp_Misc_Marker
905 if $misc == Lisp_Misc_Intfwd
908 if $misc == Lisp_Misc_Boolfwd
911 if $misc == Lisp_Misc_Objfwd
914 if $misc == Lisp_Misc_Buffer_Objfwd
917 if $misc == Lisp_Misc_Buffer_Local_Value
920 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
923 if $misc == Lisp_Misc_Overlay
926 if $misc == Lisp_Misc_Kboard_Objfwd
929 # if $misc == Lisp_Misc_Save_Value
933 if $type == Lisp_Vectorlike
934 set $size = ((struct Lisp_Vector *) $ptr)->size
935 if ($size & PVEC_FLAG)
936 set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
937 if $vec == PVEC_NORMAL_VECTOR
940 if $vec == PVEC_PROCESS
943 if $vec == PVEC_FRAME
946 if $vec == PVEC_COMPILED
949 if $vec == PVEC_WINDOW
952 if $vec == PVEC_WINDOW_CONFIGURATION
958 if $vec == PVEC_CHAR_TABLE
961 if $vec == PVEC_BOOL_VECTOR
964 if $vec == PVEC_BUFFER
967 if $vec == PVEC_HASH_TABLE
976 Print $ as a lisp object of any type.
980 set $data = (char *) $arg0->data
981 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
986 set $sym = (struct Lisp_Symbol *) $ptr
988 set $sym_name = (struct Lisp_String *) $ptr
992 Print argument as a symbol.
996 set $bt = backtrace_list
998 xgettype (*$bt->function)
999 if $type == Lisp_Symbol
1000 xprintsym (*$bt->function)
1001 printf " (0x%x)\n", *$bt->args
1003 printf "0x%x ", *$bt->function
1004 if $type == Lisp_Vectorlike
1005 xgetptr (*$bt->function)
1006 set $size = ((struct Lisp_Vector *) $ptr)->size
1007 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
1009 printf "Lisp type %d", $type
1017 Print a backtrace of Lisp function calls from backtrace_list.
1018 Set a breakpoint at Fsignal and call this to see from where
1019 an error was signaled.
1023 set debug_print (which_symbols ($arg0))
1026 Print symbols which references a given lisp object
1027 either as its symbol value or symbol function.
1031 set $bt = byte_stack_list
1033 xgettype ($bt->byte_string)
1034 printf "0x%x => ", $bt->byte_string
1035 which $bt->byte_string
1040 Print a backtrace of the byte code stack.
1043 # Show Lisp backtrace after normal backtrace.
1044 define hookpost-backtrace
1045 set $bt = backtrace_list
1048 echo Lisp Backtrace:\n
1054 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1055 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1058 When starting Emacs a second time in the same gdb session under
1059 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1060 their values. (The same happens on current (2000) versions of GNU/Linux
1062 This function reloads them.
1066 # Flush display (X only)
1071 Flush pending X window display updates to screen.
1072 Works only when an inferior emacs is executing.
1080 # Call xreload if a new Emacs executable is loaded.
1086 set print sevenbit-strings
1088 show environment DISPLAY
1089 show environment TERM
1090 set args -geometry 80x40+0+0
1092 # People get bothered when they see messages about non-existent functions...
1093 xgetptr Vsystem_type
1094 # $ptr is NULL in temacs
1096 set $tem = (struct Lisp_Symbol *) $ptr
1098 set $tem = (struct Lisp_String *) $ptr
1099 set $tem = (char *) $tem->data
1101 # Don't let abort actually run, as it will make stdio stop working and
1102 # therefore the `pr' command above as well.
1103 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1104 # The windows-nt build replaces abort with its own function.
1111 # x_error_quitter is defined only on X. But window-system is set up
1112 # only at run time, during Emacs startup, so we need to defer setting
1113 # the breakpoint. init_sys_modes is the first function called on
1114 # every platform after init_display, where window-system is set.
1115 tbreak init_sys_modes
1118 xgetptr Vwindow_system
1119 set $tem = (struct Lisp_Symbol *) $ptr
1121 set $tem = (struct Lisp_String *) $ptr
1122 set $tem = (char *) $tem->data
1123 # If we are running in synchronous mode, we want a chance to look
1124 # around before Emacs exits. Perhaps we should put the break
1125 # somewhere else instead...
1126 if $tem[0] == 'x' && $tem[1] == '\0'
1127 break x_error_quitter
1131 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe