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
93 set $output_debug = print_output_debug_flag
94 set print_output_debug_flag = 0
95 set safe_debug_print ($tmp)
96 set print_output_debug_flag = $output_debug
99 Print the argument as an emacs s-expression
100 Works only when an inferior emacs is executing.
101 For use on tool bar when debugging in Emacs
102 where the variable name would not otherwise
103 be recorded in the GUD buffer.
106 # Print value of lisp variable
109 set $output_debug = print_output_debug_flag
110 set print_output_debug_flag = 0
111 set safe_debug_print ( find_symbol_value (intern ($tmp)))
112 set print_output_debug_flag = $output_debug
115 Print the value of the lisp variable given as argument.
116 Works only when an inferior emacs is executing.
119 # 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 on tool bar when debugging in Emacs
133 where the variable name would not otherwise
134 be recorded in the GUD buffer.
137 # Print out current buffer point and boundaries
139 set $b = current_buffer
141 printf "BUF PT: %d", $b->pt
142 if ($b->pt != $b->pt_byte)
143 printf "[%d]", $b->pt_byte
145 printf " of 1..%d", $t->z
146 if ($t->z != $t->z_byte)
147 printf "[%d]", $t->z_byte
149 if ($b->begv != 1 || $b->zv != $t->z)
150 printf " NARROW=%d..%d", $b->begv, $b->zv
151 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
152 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
155 printf " GAP: %d", $t->gpt
156 if ($t->gpt != $t->gpt_byte)
157 printf "[%d]", $t->gpt_byte
159 printf " SZ=%d\n", $t->gap_size
162 Print 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 " start=%d", $it->start.pos.charpos
173 if ($it->start.pos.charpos != $it->start.pos.bytepos)
174 printf "[%d]", $it->start.pos.bytepos
176 printf " end=%d", $it->end_charpos
177 printf " stop=%d", $it->stop_charpos
178 printf " face=%d", $it->face_id
179 if ($it->multibyte_p)
182 if ($it->header_line_p)
185 if ($it->n_overlay_strings > 0)
186 printf " nov=%d", $it->n_overlay_strings
189 printf " sp=%d", $it->sp
191 if ($it->what == IT_CHARACTER)
192 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
193 printf " ch='%c'", $it->c
195 printf " ch=[%d,%d]", $it->c, $it->len
198 if ($it->what == IT_IMAGE)
199 printf " IMAGE=%d", $it->image_id
205 if ($it->method != GET_FROM_BUFFER)
208 if ($it->method == GET_FROM_STRING)
209 printf "[%d]", $it->current.string_pos.charpos
213 if ($it->region_beg_charpos >= 0)
214 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
216 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
217 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
218 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
219 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
220 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
224 Pretty print a display iterator.
225 Take one arg, an iterator object or pointer.
232 Pretty print the display iterator it.
237 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
238 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
239 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
240 printf " vis=%d", $row->visible_height
241 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
243 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
247 if ($row->displays_text_p)
250 if ($row->mode_line_p)
253 if ($row->continued_p)
256 if ($row-> truncated_on_left_p)
259 if ($row-> truncated_on_right_p)
262 if ($row->starts_in_middle_of_char_p)
265 if ($row->ends_in_middle_of_char_p)
268 if ($row->ends_in_newline_from_string_p)
271 if ($row->ends_at_zv_p)
274 if ($row->overlapped_p)
277 if ($row->overlapping_p)
283 Pretty print information about glyph_row.
284 Takes one argument, a row object or pointer.
291 Pretty print information about glyph_row in row.
297 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
300 Pretty print a window cursor
305 pcursorx output_cursor
309 Pretty print the output_cursor
314 xgetint $w->sequence_number
315 if ($w->mini_p != Qnil)
318 printf "Window %d ", $int
320 set $tem = (struct buffer *) $ptr
322 printf "%s", ((struct Lisp_String *) $ptr)->data
325 set $tem = (struct Lisp_Marker *) $ptr
326 printf "start=%d end:", $tem->charpos
327 if ($w->window_end_valid != Qnil)
328 xgetint $w->window_end_pos
329 printf "pos=%d", $int
330 xgetint $w->window_end_vpos
331 printf " vpos=%d", $int
335 printf " vscroll=%d", $w->vscroll
336 if ($w->force_start != Qnil)
337 printf " FORCE_START"
339 if ($w->must_be_updated_p)
346 pcursorx $w->phys_cursor
347 if ($w->phys_cursor_on_p)
353 if ($w->last_cursor_off_p != $w->cursor_off_p)
354 if ($w->last_cursor_off_p)
360 if ($w->cursor_off_p)
368 Pretty print a window structure.
369 Takes one argument, a pointer to a window structure
376 Pretty print window structure w.
384 if $type == Lisp_Misc
387 if $type == Lisp_Vectorlike
393 Print the type of $, assuming it is an Emacs Lisp value.
394 If the first type printed is Lisp_Vector or Lisp_Misc,
395 a second line gives the more precise type.
400 set $size = ((struct Lisp_Vector *) $ptr)->size
401 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
405 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
410 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
414 Print the specific type of $, assuming it is some misc type.
422 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
430 Print the pointer portion of $, assuming it is an Emacs Lisp value.
435 print (struct Lisp_Marker *) $ptr
438 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
443 print (struct Lisp_Overlay *) $ptr
446 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
451 print (struct Lisp_Free *) $ptr
454 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
459 print (struct Lisp_Intfwd *) $ptr
462 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
467 print (struct Lisp_Boolfwd *) $ptr
470 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
475 print (struct Lisp_Objfwd *) $ptr
478 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
483 print (struct Lisp_Buffer_Objfwd *) $ptr
486 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
491 print (struct Lisp_Kboard_Objfwd *) $ptr
494 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
499 print (struct Lisp_Buffer_Local_Value *) $ptr
502 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
508 print (struct Lisp_Symbol *) $ptr
513 Print the name and address of the symbol $.
514 This command assumes that $ is an Emacs Lisp symbol value.
519 print (struct Lisp_String *) $ptr
524 Print the contents and address of the string $.
525 This command assumes that $ is an Emacs Lisp string value.
530 print (struct Lisp_Vector *) $ptr
531 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
535 Print the contents and address of the vector $.
536 This command assumes that $ is an Emacs Lisp vector value.
541 print (struct Lisp_Process *) $ptr
546 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
551 print (struct frame *) $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 print ((struct Lisp_Float *) $ptr)->u.data
689 Print $ assuming it is a lisp floating-point number.
694 print (struct scrollbar *) $ptr
699 Print $ as a scrollbar pointer.
703 set $data = $arg0->data
704 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
709 set $sym = (struct Lisp_Symbol *) $ptr
711 set $sym_name = (struct Lisp_String *) $ptr
715 Print argument as a symbol.
719 set $bt = backtrace_list
721 xgettype (*$bt->function)
722 if $type == Lisp_Symbol
723 xprintsym (*$bt->function)
726 printf "0x%x ", *$bt->function
727 if $type == Lisp_Vectorlike
728 xgetptr (*$bt->function)
729 set $size = ((struct Lisp_Vector *) $ptr)->size
730 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
732 printf "Lisp type %d", $type
740 Print a backtrace of Lisp function calls from backtrace_list.
741 Set a breakpoint at Fsignal and call this to see from where
742 an error was signaled.
745 # Show Lisp backtrace after normal backtrace.
746 define hookpost-backtrace
747 set $bt = backtrace_list
750 echo Lisp Backtrace:\n
756 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
757 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
760 When starting Emacs a second time in the same gdb session under
761 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
762 their values. (The same happens on current (2000) versions of GNU/Linux
764 This function reloads them.
768 # Flush display (X only)
773 Flush pending X window display updates to screen.
774 Works only when an inferior emacs is executing.
782 # Call xreload if a new Emacs executable is loaded.
788 set print sevenbit-strings
790 show environment DISPLAY
791 show environment TERM
792 set args -geometry 80x40+0+0
794 # People get bothered when they see messages about non-existent functions...
796 # $ptr is NULL in temacs
798 set $tem = (struct Lisp_Symbol *) $ptr
800 set $tem = (struct Lisp_String *) $ptr
801 set $tem = (char *) $tem->data
803 # Don't let abort actually run, as it will make stdio stop working and
804 # therefore the `pr' command above as well.
805 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
806 # The windows-nt build replaces abort with its own function.
813 # x_error_quitter is defined only on X. But window-system is set up
814 # only at run time, during Emacs startup, so we need to defer setting
815 # the breakpoint. init_sys_modes is the first function called on
816 # every platform after init_display, where window-system is set.
817 tbreak init_sys_modes
820 xgetptr Vwindow_system
821 set $tem = (struct Lisp_Symbol *) $ptr
823 set $tem = (struct Lisp_String *) $ptr
824 set $tem = (char *) $tem->data
825 # If we are running in synchronous mode, we want a chance to look
826 # around before Emacs exits. Perhaps we should put the break
827 # somewhere else instead...
828 if $tem[0] == 'x' && $tem[1] == '\0'
829 break x_error_quitter
833 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe