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
193 if ($it->what == IT_IMAGE)
194 printf " IMAGE=%d", $it->image_id
200 if ($it->method != GET_FROM_BUFFER)
203 if ($it->method == GET_FROM_STRING)
204 printf "[%d]", $it->current.string_pos.charpos
208 if ($it->region_beg_charpos >= 0)
209 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
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
220 Pretty print a display iterator.
221 Take one arg, an iterator object or pointer.
228 Pretty print the display iterator it.
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]
239 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
243 if ($row->displays_text_p)
246 if ($row->mode_line_p)
249 if ($row->continued_p)
252 if ($row-> truncated_on_left_p)
255 if ($row-> truncated_on_right_p)
258 if ($row->starts_in_middle_of_char_p)
261 if ($row->ends_in_middle_of_char_p)
264 if ($row->ends_in_newline_from_string_p)
267 if ($row->ends_at_zv_p)
270 if ($row->overlapped_p)
273 if ($row->overlapping_p)
279 Pretty print information about glyph_row.
280 Takes one argument, a row object or pointer.
287 Pretty print information about glyph_row in row.
293 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
296 Pretty print a window cursor
301 pcursorx output_cursor
305 Pretty print the output_cursor
310 xgetint $w->sequence_number
311 if ($w->mini_p != Qnil)
314 printf "Window %d ", $int
316 set $tem = (struct buffer *) $ptr
318 printf "%s", ((struct Lisp_String *) $ptr)->data
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
331 printf " vscroll=%d", $w->vscroll
332 if ($w->force_start != Qnil)
333 printf " FORCE_START"
335 if ($w->must_be_updated_p)
342 pcursorx $w->phys_cursor
343 if ($w->phys_cursor_on_p)
349 if ($w->last_cursor_off_p != $w->cursor_off_p)
350 if ($w->last_cursor_off_p)
356 if ($w->cursor_off_p)
364 Pretty print a window structure.
365 Takes one argument, a pointer to a window structure
372 Pretty print window structure w.
380 if $type == Lisp_Misc
383 if $type == Lisp_Vectorlike
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.
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
401 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
406 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
410 Print the specific type of $, assuming it is some misc type.
418 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
426 Print the pointer portion of $, assuming it is an Emacs Lisp value.
431 print (struct Lisp_Marker *) $ptr
434 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
439 print (struct Lisp_Overlay *) $ptr
442 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
447 print (struct Lisp_Free *) $ptr
450 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
455 print (struct Lisp_Intfwd *) $ptr
458 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
463 print (struct Lisp_Boolfwd *) $ptr
466 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
471 print (struct Lisp_Objfwd *) $ptr
474 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
479 print (struct Lisp_Buffer_Objfwd *) $ptr
482 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
487 print (struct Lisp_Kboard_Objfwd *) $ptr
490 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
495 print (struct Lisp_Buffer_Local_Value *) $ptr
498 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
504 print (struct Lisp_Symbol *) $ptr
509 Print the name and address of the symbol $.
510 This command assumes that $ is an Emacs Lisp symbol value.
515 print (struct Lisp_String *) $ptr
520 Print the contents and address of the string $.
521 This command assumes that $ is an Emacs Lisp string value.
526 print (struct Lisp_Vector *) $ptr
527 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
531 Print the contents and address of the vector $.
532 This command assumes that $ is an Emacs Lisp vector value.
537 print (struct Lisp_Process *) $ptr
542 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
547 print (struct frame *) $ptr
549 set $ptr = (struct Lisp_String *) $ptr
554 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
559 print (struct Lisp_Vector *) $ptr
560 output ($->contents[0])@($->size & 0xff)
563 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
568 print (struct window *) $ptr
569 set $window = (struct window *) $ptr
570 xgetint $window->total_cols
572 xgetint $window->total_lines
574 xgetint $window->left_col
576 xgetint $window->top_line
578 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
581 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
582 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
587 print (struct save_window_data *) $ptr
590 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
595 print (struct Lisp_Subr *) $ptr
600 Print the address of the subr which the Lisp_Object $ points to.
605 print (struct Lisp_Char_Table *) $ptr
608 printf " %d extra slots", ($->size & 0x1ff) - 388
612 Print the address of the char-table $, and its purpose.
613 This command assumes that $ is an Emacs Lisp char-table value.
618 print (struct Lisp_Bool_Vector *) $ptr
619 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
623 Print the contents and address of the bool-vector $.
624 This command assumes that $ is an Emacs Lisp bool-vector value.
629 print (struct buffer *) $ptr
631 output ((struct Lisp_String *) $ptr)->data
635 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
636 Print the name of the buffer.
641 print (struct Lisp_Hash_Table *) $ptr
644 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
649 print (struct Lisp_Cons *) $ptr
654 Print the contents of $, assuming it is an Emacs Lisp cons.
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.
669 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
672 Print the car of $, assuming it is an Emacs Lisp pair.
678 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
681 Print the cdr of $, assuming it is an Emacs Lisp pair.
686 set $cons = (struct Lisp_Cons *) $ptr
690 while $cons != $nil && $i < 10
694 set $cons = (struct Lisp_Cons *) $ptr
706 Print $ assuming it is a list.
711 print ((struct Lisp_Float *) $ptr)->u.data
714 Print $ assuming it is a lisp floating-point number.
719 print (struct scrollbar *) $ptr
724 Print $ as a scrollbar pointer.
732 if $type == Lisp_Symbol
735 if $type == Lisp_String
738 if $type == Lisp_Cons
741 if $type == Lisp_Float
744 if $type == Lisp_Misc
745 set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
746 if $misc == Lisp_Misc_Free
749 if $misc == Lisp_Misc_Boolfwd
752 if $misc == Lisp_Misc_Marker
755 if $misc == Lisp_Misc_Intfwd
758 if $misc == Lisp_Misc_Boolfwd
761 if $misc == Lisp_Misc_Objfwd
764 if $misc == Lisp_Misc_Buffer_Objfwd
767 if $misc == Lisp_Misc_Buffer_Local_Value
770 # if $misc == Lisp_Misc_Some_Buffer_Local_Value
773 if $misc == Lisp_Misc_Overlay
776 if $misc == Lisp_Misc_Kboard_Objfwd
779 # if $misc == Lisp_Misc_Save_Value
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
790 if $vec == PVEC_PROCESS
793 if $vec == PVEC_FRAME
796 if $vec == PVEC_COMPILED
799 if $vec == PVEC_WINDOW
802 if $vec == PVEC_WINDOW_CONFIGURATION
808 if $vec == PVEC_CHAR_TABLE
811 if $vec == PVEC_BOOL_VECTOR
814 if $vec == PVEC_BUFFER
817 if $vec == PVEC_HASH_TABLE
826 Print $ as a lisp object of any type.
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)
836 set $sym = (struct Lisp_Symbol *) $ptr
838 set $sym_name = (struct Lisp_String *) $ptr
842 Print argument as a symbol.
846 set $bt = backtrace_list
848 xgettype (*$bt->function)
849 if $type == Lisp_Symbol
850 xprintsym (*$bt->function)
851 printf " (0x%x)\n", *$bt->args
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
859 printf "Lisp type %d", $type
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.
873 set debug_print (which_symbols ($arg0))
876 Print symbols which references a given lisp object,
877 either as its symbol value or symbol function.
881 set $bt = byte_stack_list
883 xgettype ($bt->byte_string)
884 printf "0x%x => ", $bt->byte_string
885 which $bt->byte_string
890 Print a backtrace of the byte code stack.
893 # Show Lisp backtrace after normal backtrace.
894 define hookpost-backtrace
895 set $bt = backtrace_list
898 echo Lisp Backtrace:\n
904 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
905 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
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
912 This function reloads them.
916 # Flush display (X only)
921 Flush pending X window display updates to screen.
922 Works only when an inferior emacs is executing.
930 # Call xreload if a new Emacs executable is loaded.
936 set print sevenbit-strings
938 show environment DISPLAY
939 show environment TERM
940 set args -geometry 80x40+0+0
942 # People get bothered when they see messages about non-existent functions...
944 # $ptr is NULL in temacs
946 set $tem = (struct Lisp_Symbol *) $ptr
948 set $tem = (struct Lisp_String *) $ptr
949 set $tem = (char *) $tem->data
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.
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
968 xgetptr Vwindow_system
969 set $tem = (struct Lisp_Symbol *) $ptr
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
981 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe