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 " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
215 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
219 Pretty print a display iterator.
220 Take one arg, an iterator object or pointer.
227 Pretty print the display iterator it.
232 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
233 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
234 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
235 printf " vis=%d", $row->visible_height
236 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
238 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
242 if ($row->displays_text_p)
245 if ($row->mode_line_p)
248 if ($row->continued_p)
251 if ($row-> truncated_on_left_p)
254 if ($row-> truncated_on_right_p)
257 if ($row->starts_in_middle_of_char_p)
260 if ($row->ends_in_middle_of_char_p)
263 if ($row->ends_in_newline_from_string_p)
266 if ($row->ends_at_zv_p)
269 if ($row->overlapped_p)
272 if ($row->overlapping_p)
278 Pretty print information about glyph_row.
279 Takes one argument, a row object or pointer.
286 Pretty print information about glyph_row in row.
292 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
295 Pretty print a window cursor
300 pcursorx output_cursor
304 Pretty print the output_cursor
309 xgetint $w->sequence_number
310 if ($w->mini_p != Qnil)
313 printf "Window %d ", $int
315 set $tem = (struct buffer *) $ptr
317 printf "%s", ((struct Lisp_String *) $ptr)->data
320 set $tem = (struct Lisp_Marker *) $ptr
321 printf "start=%d end:", $tem->charpos
322 if ($w->window_end_valid != Qnil)
323 xgetint $w->window_end_pos
324 printf "pos=%d", $int
325 xgetint $w->window_end_vpos
326 printf " vpos=%d", $int
330 printf " vscroll=%d", $w->vscroll
331 if ($w->force_start != Qnil)
332 printf " FORCE_START"
334 if ($w->must_be_updated_p)
341 pcursorx $w->phys_cursor
342 if ($w->phys_cursor_on_p)
348 if ($w->last_cursor_off_p != $w->cursor_off_p)
349 if ($w->last_cursor_off_p)
355 if ($w->cursor_off_p)
363 Pretty print a window structure.
364 Takes one argument, a pointer to a window structure
371 Pretty print window structure w.
379 if $type == Lisp_Misc
382 if $type == Lisp_Vectorlike
388 Print the type of $, assuming it is an Emacs Lisp value.
389 If the first type printed is Lisp_Vector or Lisp_Misc,
390 a second line gives the more precise type.
395 set $size = ((struct Lisp_Vector *) $ptr)->size
396 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
400 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
405 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
409 Print the specific type of $, assuming it is some misc type.
417 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
425 Print the pointer portion of $, assuming it is an Emacs Lisp value.
430 print (struct Lisp_Marker *) $ptr
433 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
438 print (struct Lisp_Overlay *) $ptr
441 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
446 print (struct Lisp_Free *) $ptr
449 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
454 print (struct Lisp_Intfwd *) $ptr
457 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
462 print (struct Lisp_Boolfwd *) $ptr
465 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
470 print (struct Lisp_Objfwd *) $ptr
473 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
478 print (struct Lisp_Buffer_Objfwd *) $ptr
481 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
486 print (struct Lisp_Kboard_Objfwd *) $ptr
489 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
494 print (struct Lisp_Buffer_Local_Value *) $ptr
497 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
503 print (struct Lisp_Symbol *) $ptr
508 Print the name and address of the symbol $.
509 This command assumes that $ is an Emacs Lisp symbol value.
514 print (struct Lisp_String *) $ptr
519 Print the contents and address of the string $.
520 This command assumes that $ is an Emacs Lisp string value.
525 print (struct Lisp_Vector *) $ptr
526 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
530 Print the contents and address of the vector $.
531 This command assumes that $ is an Emacs Lisp vector value.
536 print (struct Lisp_Process *) $ptr
541 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
546 print (struct frame *) $ptr
549 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
554 print (struct Lisp_Vector *) $ptr
555 output ($->contents[0])@($->size & 0xff)
558 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
563 print (struct window *) $ptr
564 set $window = (struct window *) $ptr
565 xgetint $window->total_cols
567 xgetint $window->total_lines
569 xgetint $window->left_col
571 xgetint $window->top_line
573 printf "%dx%d+%d+%d\n", $width, $height, $left, $top
576 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
577 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
582 print (struct save_window_data *) $ptr
585 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
590 print (struct Lisp_Subr *) $ptr
595 Print the address of the subr which the Lisp_Object $ points to.
600 print (struct Lisp_Char_Table *) $ptr
603 printf " %d extra slots", ($->size & 0x1ff) - 388
607 Print the address of the char-table $, and its purpose.
608 This command assumes that $ is an Emacs Lisp char-table value.
613 print (struct Lisp_Bool_Vector *) $ptr
614 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
618 Print the contents and address of the bool-vector $.
619 This command assumes that $ is an Emacs Lisp bool-vector value.
624 print (struct buffer *) $ptr
626 output ((struct Lisp_String *) $ptr)->data
630 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
631 Print the name of the buffer.
636 print (struct Lisp_Hash_Table *) $ptr
639 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
644 print (struct Lisp_Cons *) $ptr
649 Print the contents of $, assuming it is an Emacs Lisp cons.
657 Print the contents of the next cell in a list.
658 This assumes that the last thing you printed was a cons cell contents
659 (type struct Lisp_Cons) or a pointer to one.
664 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
667 Print the car of $, assuming it is an Emacs Lisp pair.
673 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
676 Print the cdr of $, assuming it is an Emacs Lisp pair.
681 print ((struct Lisp_Float *) $ptr)->u.data
684 Print $ assuming it is a lisp floating-point number.
689 print (struct scrollbar *) $ptr
694 Print $ as a scrollbar pointer.
698 set $data = $arg0->data
699 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
704 set $sym = (struct Lisp_Symbol *) $ptr
706 set $sym_name = (struct Lisp_String *) $ptr
710 Print argument as a symbol.
714 set $bt = backtrace_list
716 xgettype (*$bt->function)
717 if $type == Lisp_Symbol
718 xprintsym (*$bt->function)
721 printf "0x%x ", *$bt->function
722 if $type == Lisp_Vectorlike
723 xgetptr (*$bt->function)
724 set $size = ((struct Lisp_Vector *) $ptr)->size
725 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
727 printf "Lisp type %d", $type
735 Print a backtrace of Lisp function calls from backtrace_list.
736 Set a breakpoint at Fsignal and call this to see from where
737 an error was signaled.
740 # Show Lisp backtrace after normal backtrace.
741 define hookpost-backtrace
742 set $bt = backtrace_list
745 echo Lisp Backtrace:\n
751 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
752 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
755 When starting Emacs a second time in the same gdb session under
756 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
757 their values. (The same happens on current (2000) versions of GNU/Linux
759 This function reloads them.
763 # Flush display (X only)
768 Flush pending X window display updates to screen.
769 Works only when an inferior emacs is executing.
777 # Call xreload if a new Emacs executable is loaded.
783 set print sevenbit-strings
785 show environment DISPLAY
786 show environment TERM
787 #set args -geometry 80x40+0+0
789 # People get bothered when they see messages about non-existent functions...
791 # $ptr is NULL in temacs
793 set $tem = (struct Lisp_Symbol *) $ptr
795 set $tem = (struct Lisp_String *) $ptr
796 set $tem = (char *) $tem->data
798 # Don't let abort actually run, as it will make stdio stop working and
799 # therefore the `pr' command above as well.
800 if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
801 # The windows-nt build replaces abort with its own function.
808 # x_error_quitter is defined only on X. But window-system is set up
809 # only at run time, during Emacs startup, so we need to defer setting
810 # the breakpoint. init_sys_modes is the first function called on
811 # every platform after init_display, where window-system is set.
812 tbreak init_sys_modes
815 xgetptr Vinitial_window_system
816 set $tem = (struct Lisp_Symbol *) $ptr
818 set $tem = (struct Lisp_String *) $ptr
819 set $tem = (char *) $tem->data
820 # If we are running in synchronous mode, we want a chance to look
821 # around before Emacs exits. Perhaps we should put the break
822 # somewhere else instead...
823 if $tem[0] == 'x' && $tem[1] == '\0'
824 break x_error_quitter
828 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe