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 # Don't pass SIGALRM to Emacs. This makes problems when
41 # $valmask and $tagmask are mask values set up by the xreload macro below.
43 # Use $bugfix so that the value isn't a constant.
44 # Using a constant runs into GDB bugs sometimes.
47 set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
52 set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
57 set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
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!).
65 set $output_debug = print_output_debug_flag
66 set print_output_debug_flag = 0
68 set print_output_debug_flag = $output_debug
71 Print the emacs s-expression which is $.
72 Works only when an inferior emacs is executing.
75 # Print out s-expressions
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
84 Print the argument as an emacs s-expression
85 Works only when an inferior emacs is executing.
88 # Print out s-expressions from tool bar
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
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.
104 # Print value of lisp variable
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
113 Print the value of the lisp variable given as argument.
114 Works only when an inferior emacs is executing.
117 # Print value of lisp variable
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
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.
132 # Print out current buffer point and boundaries
134 set $b = current_buffer
136 printf "BUF PT: %d", $b->pt
137 if ($b->pt != $b->pt_byte)
138 printf "[%d]", $b->pt_byte
140 printf " of 1..%d", $t->z
141 if ($t->z != $t->z_byte)
142 printf "[%d]", $t->z_byte
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
150 printf " GAP: %d", $t->gpt
151 if ($t->gpt != $t->gpt_byte)
152 printf "[%d]", $t->gpt_byte
154 printf " SZ=%d\n", $t->gap_size
157 Print point, beg, end, narrow, and gap for current buffer.
160 # Print out iterator given as first arg
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
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
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)
177 if ($it->header_line_p)
180 if ($it->n_overlay_strings > 0)
181 printf " nov=%d", $it->n_overlay_strings
184 printf " sp=%d", $it->sp
186 if ($it->what == IT_CHARACTER)
187 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
188 printf " ch='%c'", $it->c
190 printf " ch=[%d,%d]", $it->c, $it->len
196 if ($it->method != GET_FROM_BUFFER)
199 if ($it->method == GET_FROM_STRING)
200 printf "[%d]", $it->current.string_pos.charpos
202 if ($it->method == GET_FROM_IMAGE)
203 printf "[%d]", $it->image_id
205 if ($it->method == GET_FROM_COMPOSITION)
206 printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
210 if ($it->region_beg_charpos >= 0)
211 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
213 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
214 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
215 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
216 printf " w=%d", $it->pixel_width
217 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
218 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
222 set $e = $it->stack[$i]
223 printf "stack[%d]: ", $i
225 printf "[%d]", $e->position.charpos
231 Pretty print a display iterator.
232 Take one arg, an iterator object or pointer.
239 Pretty print the display iterator it.
244 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
245 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
246 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
247 printf " vis=%d", $row->visible_height
248 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
250 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
254 if ($row->displays_text_p)
257 if ($row->mode_line_p)
260 if ($row->continued_p)
263 if ($row-> truncated_on_left_p)
266 if ($row-> truncated_on_right_p)
269 if ($row->starts_in_middle_of_char_p)
272 if ($row->ends_in_middle_of_char_p)
275 if ($row->ends_in_newline_from_string_p)
278 if ($row->ends_at_zv_p)
281 if ($row->overlapped_p)
284 if ($row->overlapping_p)
290 Pretty print information about glyph_row.
291 Takes one argument, a row object or pointer.
298 Pretty print information about glyph_row in row.
304 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
307 Pretty print a window cursor
312 pcursorx output_cursor
316 Pretty print the output_cursor
321 xgetint $w->sequence_number
322 if ($w->mini_p != Qnil)
325 printf "Window %d ", $int
327 set $tem = (struct buffer *) $ptr
329 printf "%s", ((struct Lisp_String *) $ptr)->data
332 set $tem = (struct Lisp_Marker *) $ptr
333 printf "start=%d end:", $tem->charpos
334 if ($w->window_end_valid != Qnil)
335 xgetint $w->window_end_pos
336 printf "pos=%d", $int
337 xgetint $w->window_end_vpos
338 printf " vpos=%d", $int
342 printf " vscroll=%d", $w->vscroll
343 if ($w->force_start != Qnil)
344 printf " FORCE_START"
346 if ($w->must_be_updated_p)
353 pcursorx $w->phys_cursor
354 if ($w->phys_cursor_on_p)
360 if ($w->last_cursor_off_p != $w->cursor_off_p)
361 if ($w->last_cursor_off_p)
367 if ($w->cursor_off_p)
375 Pretty print a window structure.
376 Takes one argument, a pointer to a window structure
383 Pretty print window structure w.
388 if ($g->type == CHAR_GLYPH)
389 if ($g->u.ch >= ' ' && $g->u.ch < 127)
390 printf "CHAR[%c]", $g->u.ch
392 printf "CHAR[0x%x]", $g->u.ch
395 if ($g->type == COMPOSITE_GLYPH)
396 printf "COMP[%d]", $g->u.cmp_id
398 if ($g->type == IMAGE_GLYPH)
399 printf "IMAGE[%d]", $g->u.img_id
401 if ($g->type == STRETCH_GLYPH)
402 printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
404 xgettype ($g->object)
405 if ($type == Lisp_String)
406 printf " str=%x[%d]", $g->object, $g->charpos
408 printf " pos=%d", $g->charpos
410 printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
411 if ($g->face_id != DEFAULT_FACE_ID)
412 printf " face=%d", $g->face_id
415 printf " vof=%d", $g->voffset
423 if ($g->glyph_not_available_p)
426 if ($g->overlaps_vertically_p)
429 if ($g->left_box_line_p)
432 if ($g->right_box_line_p)
435 if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
436 printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
441 Pretty print a glyph structure.
442 Takes one argument, a pointer to a glyph structure
450 Pretty print glyph structure glyph.
458 Pretty print glyph structure glyph[I].
459 Takes one argument, a integer I.
463 set $pgidx = $pgidx + 1
467 Pretty print next glyph structure.
475 set $used = $row->used[$area]
477 set $gl0 = $row->glyphs[$area]
479 printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
480 while ($pgidx < $used)
481 printf "%3d %4d: ", $pgidx, $xofs
483 set $xofs = $xofs + $gl0[$pgidx]->pixel_width
484 set $pgidx = $pgidx + 1
487 set $area = $area + 1
491 Pretty print all glyphs in a row structure.
492 Takes one argument, a pointer to a row structure.
499 Pretty print all glyphs in row structure row.
506 if $type == Lisp_Misc
509 if $type == Lisp_Vectorlike
515 Print the type of $, assuming it is an Emacs Lisp value.
516 If the first type printed is Lisp_Vector or Lisp_Misc,
517 a second line gives the more precise type.
522 set $size = ((struct Lisp_Vector *) $ptr)->size
523 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
527 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
532 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
536 Print the specific type of $, assuming it is some misc type.
544 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
552 Print the pointer portion of $, assuming it is an Emacs Lisp value.
557 print (struct Lisp_Marker *) $ptr
560 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
565 print (struct Lisp_Overlay *) $ptr
568 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
573 print (struct Lisp_Free *) $ptr
576 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
581 print (struct Lisp_Intfwd *) $ptr
584 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
589 print (struct Lisp_Boolfwd *) $ptr
592 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
597 print (struct Lisp_Objfwd *) $ptr
600 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
605 print (struct Lisp_Buffer_Objfwd *) $ptr
608 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
613 print (struct Lisp_Kboard_Objfwd *) $ptr
616 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
621 print (struct Lisp_Buffer_Local_Value *) $ptr
624 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
630 print (struct Lisp_Symbol *) $ptr
635 Print the name and address of the symbol $.
636 This command assumes that $ is an Emacs Lisp symbol value.
641 print (struct Lisp_String *) $ptr
646 Print the contents and address of the string $.
647 This command assumes that $ is an Emacs Lisp string value.
652 print (struct Lisp_Vector *) $ptr
653 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
657 Print the contents and address of the vector $.
658 This command assumes that $ is an Emacs Lisp vector value.
663 print (struct Lisp_Process *) $ptr
668 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
673 print (struct frame *) $ptr
675 set $ptr = (struct Lisp_String *) $ptr
680 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
685 print (struct Lisp_Vector *) $ptr
686 output ($->contents[0])@($->size & 0xff)
689 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
694 print (struct window *) $ptr
695 set $window = (struct window *) $ptr
696 xgetint $window->total_cols
698 xgetint $window->total_lines
700 xgetint $window->left_col
702 xgetint $window->top_line
704 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
707 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
708 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
713 print (struct save_window_data *) $ptr
716 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
721 print (struct Lisp_Subr *) $ptr
726 Print the address of the subr which the Lisp_Object $ points to.
731 print (struct Lisp_Char_Table *) $ptr
734 printf " %d extra slots", ($->size & 0x1ff) - 388
738 Print the address of the char-table $, and its purpose.
739 This command assumes that $ is an Emacs Lisp char-table value.
744 print (struct Lisp_Bool_Vector *) $ptr
745 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
749 Print the contents and address of the bool-vector $.
750 This command assumes that $ is an Emacs Lisp bool-vector value.
755 print (struct buffer *) $ptr
757 output ((struct Lisp_String *) $ptr)->data
761 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
762 Print the name of the buffer.
767 print (struct Lisp_Hash_Table *) $ptr
770 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
775 print (struct Lisp_Cons *) $ptr
780 Print the contents of $, assuming it is an Emacs Lisp cons.
788 Print the contents of the next cell in a list.
789 This assumes that the last thing you printed was a cons cell contents
790 (type struct Lisp_Cons) or a pointer to one.
795 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
798 Print the car of $, assuming it is an Emacs Lisp pair.
804 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
807 Print the cdr of $, assuming it is an Emacs Lisp pair.
812 set $cons = (struct Lisp_Cons *) $ptr
816 while $cons != $nil && $i < 10
820 set $cons = (struct Lisp_Cons *) $ptr
832 Print $ assuming it is a list.
837 print ((struct Lisp_Float *) $ptr)->u.data
840 Print $ assuming it is a lisp floating-point number.
845 print (struct scrollbar *) $ptr
850 Print $ as a scrollbar pointer.
858 if $type == Lisp_Symbol
861 if $type == Lisp_String
864 if $type == Lisp_Cons
867 if $type == Lisp_Float
870 if $type == Lisp_Misc
871 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
872 if $misc == Lisp_Misc_Free
875 if $misc == Lisp_Misc_Boolfwd
878 if $misc == Lisp_Misc_Marker
881 if $misc == Lisp_Misc_Intfwd
884 if $misc == Lisp_Misc_Boolfwd
887 if $misc == Lisp_Misc_Objfwd
890 if $misc == Lisp_Misc_Buffer_Objfwd
893 if $misc == Lisp_Misc_Buffer_Local_Value
896 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
899 if $misc == Lisp_Misc_Overlay
902 if $misc == Lisp_Misc_Kboard_Objfwd
905 # if $misc == Lisp_Misc_Save_Value
909 if $type == Lisp_Vectorlike
910 set $size = ((struct Lisp_Vector *) $ptr)->size
911 if ($size & PVEC_FLAG)
912 set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
913 if $vec == PVEC_NORMAL_VECTOR
916 if $vec == PVEC_PROCESS
919 if $vec == PVEC_FRAME
922 if $vec == PVEC_COMPILED
925 if $vec == PVEC_WINDOW
928 if $vec == PVEC_WINDOW_CONFIGURATION
934 if $vec == PVEC_CHAR_TABLE
937 if $vec == PVEC_BOOL_VECTOR
940 if $vec == PVEC_BUFFER
943 if $vec == PVEC_HASH_TABLE
952 Print $ as a lisp object of any type.
956 set $data = $arg0->data
957 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
962 set $sym = (struct Lisp_Symbol *) $ptr
964 set $sym_name = (struct Lisp_String *) $ptr
968 Print argument as a symbol.
972 set $bt = backtrace_list
974 xgettype (*$bt->function)
975 if $type == Lisp_Symbol
976 xprintsym (*$bt->function)
977 printf " (0x%x)\n", *$bt->args
979 printf "0x%x ", *$bt->function
980 if $type == Lisp_Vectorlike
981 xgetptr (*$bt->function)
982 set $size = ((struct Lisp_Vector *) $ptr)->size
983 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
985 printf "Lisp type %d", $type
993 Print a backtrace of Lisp function calls from backtrace_list.
994 Set a breakpoint at Fsignal and call this to see from where
995 an error was signaled.
999 set debug_print (which_symbols ($arg0))
1002 Print symbols which references a given lisp object,
1003 either as its symbol value or symbol function.
1007 set $bt = byte_stack_list
1009 xgettype ($bt->byte_string)
1010 printf "0x%x => ", $bt->byte_string
1011 which $bt->byte_string
1016 Print a backtrace of the byte code stack.
1019 # Show Lisp backtrace after normal backtrace.
1020 define hookpost-backtrace
1021 set $bt = backtrace_list
1024 echo Lisp Backtrace:\n
1030 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1031 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1034 When starting Emacs a second time in the same gdb session under
1035 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1036 their values. (The same happens on current (2000) versions of GNU/Linux
1038 This function reloads them.
1042 # Flush display (X only)
1047 Flush pending X window display updates to screen.
1048 Works only when an inferior emacs is executing.
1056 # Call xreload if a new Emacs executable is loaded.
1062 set print sevenbit-strings
1064 show environment DISPLAY
1065 show environment TERM
1066 set args -geometry 80x40+0+0
1068 # People get bothered when they see messages about non-existent functions...
1069 xgetptr Vsystem_type
1070 # $ptr is NULL in temacs
1072 set $tem = (struct Lisp_Symbol *) $ptr
1074 set $tem = (struct Lisp_String *) $ptr
1075 set $tem = (char *) $tem->data
1077 # Don't let abort actually run, as it will make stdio stop working and
1078 # therefore the `pr' command above as well.
1079 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1080 # The windows-nt build replaces abort with its own function.
1087 # x_error_quitter is defined only on X. But window-system is set up
1088 # only at run time, during Emacs startup, so we need to defer setting
1089 # the breakpoint. init_sys_modes is the first function called on
1090 # every platform after init_display, where window-system is set.
1091 tbreak init_sys_modes
1094 xgetptr Vwindow_system
1095 set $tem = (struct Lisp_Symbol *) $ptr
1097 set $tem = (struct Lisp_String *) $ptr
1098 set $tem = (char *) $tem->data
1099 # If we are running in synchronous mode, we want a chance to look
1100 # around before Emacs exits. Perhaps we should put the break
1101 # somewhere else instead...
1102 if $tem[0] == 'x' && $tem[1] == '\0'
1103 break x_error_quitter
1107 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe