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 Pretty print a display iterator.
223 Take one arg, an iterator object or pointer.
230 Pretty print the display iterator it.
235 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
236 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
237 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
238 printf " vis=%d", $row->visible_height
239 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
241 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
245 if ($row->displays_text_p)
248 if ($row->mode_line_p)
251 if ($row->continued_p)
254 if ($row-> truncated_on_left_p)
257 if ($row-> truncated_on_right_p)
260 if ($row->starts_in_middle_of_char_p)
263 if ($row->ends_in_middle_of_char_p)
266 if ($row->ends_in_newline_from_string_p)
269 if ($row->ends_at_zv_p)
272 if ($row->overlapped_p)
275 if ($row->overlapping_p)
281 Pretty print information about glyph_row.
282 Takes one argument, a row object or pointer.
289 Pretty print information about glyph_row in row.
295 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
298 Pretty print a window cursor
303 pcursorx output_cursor
307 Pretty print the output_cursor
312 xgetint $w->sequence_number
313 if ($w->mini_p != Qnil)
316 printf "Window %d ", $int
318 set $tem = (struct buffer *) $ptr
320 printf "%s", ((struct Lisp_String *) $ptr)->data
323 set $tem = (struct Lisp_Marker *) $ptr
324 printf "start=%d end:", $tem->charpos
325 if ($w->window_end_valid != Qnil)
326 xgetint $w->window_end_pos
327 printf "pos=%d", $int
328 xgetint $w->window_end_vpos
329 printf " vpos=%d", $int
333 printf " vscroll=%d", $w->vscroll
334 if ($w->force_start != Qnil)
335 printf " FORCE_START"
337 if ($w->must_be_updated_p)
344 pcursorx $w->phys_cursor
345 if ($w->phys_cursor_on_p)
351 if ($w->last_cursor_off_p != $w->cursor_off_p)
352 if ($w->last_cursor_off_p)
358 if ($w->cursor_off_p)
366 Pretty print a window structure.
367 Takes one argument, a pointer to a window structure
374 Pretty print window structure w.
379 if ($g->type == CHAR_GLYPH)
380 if ($g->u.ch >= ' ' && $g->u.ch < 127)
381 printf "CHAR[%c]", $g->u.ch
383 printf "CHAR[0x%x]", $g->u.ch
386 if ($g->type == COMPOSITE_GLYPH)
387 printf "COMP[%d]", $g->u.cmp_id
389 if ($g->type == IMAGE_GLYPH)
390 printf "IMAGE[%d]", $g->u.img_id
392 if ($g->type == STRETCH_GLYPH)
393 printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
395 xgettype ($g->object)
396 if ($type == Lisp_String)
397 printf " str=%x[%d]", $g->object, $g->charpos
399 printf " pos=%d", $g->charpos
401 printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
402 if ($g->face_id != DEFAULT_FACE_ID)
403 printf " face=%d", $g->face_id
406 printf " vof=%d", $g->voffset
414 if ($g->glyph_not_available_p)
417 if ($g->overlaps_vertically_p)
420 if ($g->left_box_line_p)
423 if ($g->right_box_line_p)
426 if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
427 printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
432 Pretty print a glyph structure.
433 Takes one argument, a pointer to a glyph structure
441 Pretty print glyph structure glyph.
449 Pretty print glyph structure glyph[I].
450 Takes one argument, a integer I.
454 set $pgidx = $pgidx + 1
458 Pretty print next glyph structure.
466 set $used = $row->used[$area]
468 set $gl0 = $row->glyphs[$area]
470 printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
471 while ($pgidx < $used)
472 printf "%3d %4d: ", $pgidx, $xofs
474 set $xofs = $xofs + $gl0[$pgidx]->pixel_width
475 set $pgidx = $pgidx + 1
478 set $area = $area + 1
482 Pretty print all glyphs in a row structure.
483 Takes one argument, a pointer to a row structure.
490 Pretty print all glyphs in row structure row.
497 if $type == Lisp_Misc
500 if $type == Lisp_Vectorlike
506 Print the type of $, assuming it is an Emacs Lisp value.
507 If the first type printed is Lisp_Vector or Lisp_Misc,
508 a second line gives the more precise type.
513 set $size = ((struct Lisp_Vector *) $ptr)->size
514 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
518 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
523 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
527 Print the specific type of $, assuming it is some misc type.
535 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
543 Print the pointer portion of $, assuming it is an Emacs Lisp value.
548 print (struct Lisp_Marker *) $ptr
551 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
556 print (struct Lisp_Overlay *) $ptr
559 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
564 print (struct Lisp_Free *) $ptr
567 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
572 print (struct Lisp_Intfwd *) $ptr
575 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
580 print (struct Lisp_Boolfwd *) $ptr
583 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
588 print (struct Lisp_Objfwd *) $ptr
591 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
596 print (struct Lisp_Buffer_Objfwd *) $ptr
599 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
604 print (struct Lisp_Kboard_Objfwd *) $ptr
607 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
612 print (struct Lisp_Buffer_Local_Value *) $ptr
615 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
621 print (struct Lisp_Symbol *) $ptr
626 Print the name and address of the symbol $.
627 This command assumes that $ is an Emacs Lisp symbol value.
632 print (struct Lisp_String *) $ptr
637 Print the contents and address of the string $.
638 This command assumes that $ is an Emacs Lisp string value.
643 print (struct Lisp_Vector *) $ptr
644 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
648 Print the contents and address of the vector $.
649 This command assumes that $ is an Emacs Lisp vector value.
654 print (struct Lisp_Process *) $ptr
659 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
664 print (struct frame *) $ptr
666 set $ptr = (struct Lisp_String *) $ptr
671 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
676 print (struct Lisp_Vector *) $ptr
677 output ($->contents[0])@($->size & 0xff)
680 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
685 print (struct window *) $ptr
686 set $window = (struct window *) $ptr
687 xgetint $window->total_cols
689 xgetint $window->total_lines
691 xgetint $window->left_col
693 xgetint $window->top_line
695 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
698 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
699 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
704 print (struct save_window_data *) $ptr
707 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
712 print (struct Lisp_Subr *) $ptr
717 Print the address of the subr which the Lisp_Object $ points to.
722 print (struct Lisp_Char_Table *) $ptr
725 printf " %d extra slots", ($->size & 0x1ff) - 388
729 Print the address of the char-table $, and its purpose.
730 This command assumes that $ is an Emacs Lisp char-table value.
735 print (struct Lisp_Bool_Vector *) $ptr
736 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
740 Print the contents and address of the bool-vector $.
741 This command assumes that $ is an Emacs Lisp bool-vector value.
746 print (struct buffer *) $ptr
748 output ((struct Lisp_String *) $ptr)->data
752 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
753 Print the name of the buffer.
758 print (struct Lisp_Hash_Table *) $ptr
761 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
766 print (struct Lisp_Cons *) $ptr
771 Print the contents of $, assuming it is an Emacs Lisp cons.
779 Print the contents of the next cell in a list.
780 This assumes that the last thing you printed was a cons cell contents
781 (type struct Lisp_Cons) or a pointer to one.
786 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
789 Print the car of $, assuming it is an Emacs Lisp pair.
795 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
798 Print the cdr of $, assuming it is an Emacs Lisp pair.
803 set $cons = (struct Lisp_Cons *) $ptr
807 while $cons != $nil && $i < 10
811 set $cons = (struct Lisp_Cons *) $ptr
823 Print $ assuming it is a list.
828 print ((struct Lisp_Float *) $ptr)->u.data
831 Print $ assuming it is a lisp floating-point number.
836 print (struct scrollbar *) $ptr
841 Print $ as a scrollbar pointer.
849 if $type == Lisp_Symbol
852 if $type == Lisp_String
855 if $type == Lisp_Cons
858 if $type == Lisp_Float
861 if $type == Lisp_Misc
862 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
863 if $misc == Lisp_Misc_Free
866 if $misc == Lisp_Misc_Boolfwd
869 if $misc == Lisp_Misc_Marker
872 if $misc == Lisp_Misc_Intfwd
875 if $misc == Lisp_Misc_Boolfwd
878 if $misc == Lisp_Misc_Objfwd
881 if $misc == Lisp_Misc_Buffer_Objfwd
884 if $misc == Lisp_Misc_Buffer_Local_Value
887 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
890 if $misc == Lisp_Misc_Overlay
893 if $misc == Lisp_Misc_Kboard_Objfwd
896 # if $misc == Lisp_Misc_Save_Value
900 if $type == Lisp_Vectorlike
901 set $size = ((struct Lisp_Vector *) $ptr)->size
902 if ($size & PVEC_FLAG)
903 set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
904 if $vec == PVEC_NORMAL_VECTOR
907 if $vec == PVEC_PROCESS
910 if $vec == PVEC_FRAME
913 if $vec == PVEC_COMPILED
916 if $vec == PVEC_WINDOW
919 if $vec == PVEC_WINDOW_CONFIGURATION
925 if $vec == PVEC_CHAR_TABLE
928 if $vec == PVEC_BOOL_VECTOR
931 if $vec == PVEC_BUFFER
934 if $vec == PVEC_HASH_TABLE
943 Print $ as a lisp object of any type.
947 set $data = $arg0->data
948 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
953 set $sym = (struct Lisp_Symbol *) $ptr
955 set $sym_name = (struct Lisp_String *) $ptr
959 Print argument as a symbol.
963 set $bt = backtrace_list
965 xgettype (*$bt->function)
966 if $type == Lisp_Symbol
967 xprintsym (*$bt->function)
968 printf " (0x%x)\n", *$bt->args
970 printf "0x%x ", *$bt->function
971 if $type == Lisp_Vectorlike
972 xgetptr (*$bt->function)
973 set $size = ((struct Lisp_Vector *) $ptr)->size
974 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
976 printf "Lisp type %d", $type
984 Print a backtrace of Lisp function calls from backtrace_list.
985 Set a breakpoint at Fsignal and call this to see from where
986 an error was signaled.
990 set debug_print (which_symbols ($arg0))
993 Print symbols which references a given lisp object,
994 either as its symbol value or symbol function.
998 set $bt = byte_stack_list
1000 xgettype ($bt->byte_string)
1001 printf "0x%x => ", $bt->byte_string
1002 which $bt->byte_string
1007 Print a backtrace of the byte code stack.
1010 # Show Lisp backtrace after normal backtrace.
1011 define hookpost-backtrace
1012 set $bt = backtrace_list
1015 echo Lisp Backtrace:\n
1021 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1022 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1025 When starting Emacs a second time in the same gdb session under
1026 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1027 their values. (The same happens on current (2000) versions of GNU/Linux
1029 This function reloads them.
1033 # Flush display (X only)
1038 Flush pending X window display updates to screen.
1039 Works only when an inferior emacs is executing.
1047 # Call xreload if a new Emacs executable is loaded.
1053 set print sevenbit-strings
1055 show environment DISPLAY
1056 show environment TERM
1057 set args -geometry 80x40+0+0
1059 # People get bothered when they see messages about non-existent functions...
1060 xgetptr Vsystem_type
1061 # $ptr is NULL in temacs
1063 set $tem = (struct Lisp_Symbol *) $ptr
1065 set $tem = (struct Lisp_String *) $ptr
1066 set $tem = (char *) $tem->data
1068 # Don't let abort actually run, as it will make stdio stop working and
1069 # therefore the `pr' command above as well.
1070 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1071 # The windows-nt build replaces abort with its own function.
1078 # x_error_quitter is defined only on X. But window-system is set up
1079 # only at run time, during Emacs startup, so we need to defer setting
1080 # the breakpoint. init_sys_modes is the first function called on
1081 # every platform after init_display, where window-system is set.
1082 tbreak init_sys_modes
1085 xgetptr Vwindow_system
1086 set $tem = (struct Lisp_Symbol *) $ptr
1088 set $tem = (struct Lisp_String *) $ptr
1089 set $tem = (char *) $tem->data
1090 # If we are running in synchronous mode, we want a chance to look
1091 # around before Emacs exits. Perhaps we should put the break
1092 # somewhere else instead...
1093 if $tem[0] == 'x' && $tem[1] == '\0'
1094 break x_error_quitter
1098 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe