1 # Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004, 2005
2 # 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.
65 Print the emacs s-expression which is $.
66 Works only when an inferior emacs is executing.
69 # Print out s-expressions
72 set safe_debug_print ($tmp)
75 Print the argument as an emacs s-expression
76 Works only when an inferior emacs is executing.
79 # Print out s-expressions from tool bar
84 set safe_debug_print ($tmp)
87 Print the argument as an emacs s-expression
88 Works only when an inferior emacs is executing.
89 For use on tool bar when debugging in Emacs
90 where the variable name would not otherwise
91 be recorded in the GUD buffer.
94 # Print value of lisp variable
97 set safe_debug_print ( find_symbol_value (intern ($tmp)))
100 Print the value of the lisp variable given as argument.
101 Works only when an inferior emacs is executing.
104 # Print value of lisp variable
109 set safe_debug_print (find_symbol_value (intern ($tmp)))
112 Print the value of the lisp variable given as argument.
113 Works only when an inferior emacs is executing.
114 For use on tool bar when debugging in Emacs
115 where the variable name would not otherwise
116 be recorded in the GUD buffer.
119 # Print out current buffer point and boundaries
121 set $b = current_buffer
123 printf "BUF PT: %d", $b->pt
124 if ($b->pt != $b->pt_byte)
125 printf "[%d]", $b->pt_byte
127 printf " of 1..%d", $t->z
128 if ($t->z != $t->z_byte)
129 printf "[%d]", $t->z_byte
131 if ($b->begv != 1 || $b->zv != $t->z)
132 printf " NARROW=%d..%d", $b->begv, $b->zv
133 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
134 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
137 printf " GAP: %d", $t->gpt
138 if ($t->gpt != $t->gpt_byte)
139 printf "[%d]", $t->gpt_byte
141 printf " SZ=%d\n", $t->gap_size
144 Print point, beg, end, narrow, and gap for current buffer.
147 # Print out iterator given as first arg
150 printf "cur=%d", $it->current.pos.charpos
151 if ($it->current.pos.charpos != $it->current.pos.bytepos)
152 printf "[%d]", $it->current.pos.bytepos
154 printf " start=%d", $it->start.pos.charpos
155 if ($it->start.pos.charpos != $it->start.pos.bytepos)
156 printf "[%d]", $it->start.pos.bytepos
158 printf " end=%d", $it->end_charpos
159 printf " stop=%d", $it->stop_charpos
160 printf " face=%d", $it->face_id
161 if ($it->multibyte_p)
164 if ($it->header_line_p)
167 if ($it->n_overlay_strings > 0)
168 printf " nov=%d", $it->n_overlay_strings
171 printf " sp=%d", $it->sp
173 if ($it->what == IT_CHARACTER)
174 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
175 printf " ch='%c'", $it->c
177 printf " ch=[%d,%d]", $it->c, $it->len
180 if ($it->what == IT_IMAGE)
181 printf " IMAGE=%d", $it->image_id
187 if ($it->method != GET_FROM_BUFFER)
190 if ($it->method == GET_FROM_STRING)
191 printf "[%d]", $it->current.string_pos.charpos
195 if ($it->region_beg_charpos >= 0)
196 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
198 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
199 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
200 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
201 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
202 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
206 Pretty print a display iterator.
207 Take one arg, an iterator object or pointer.
214 Pretty print the display iterator it.
219 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
220 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
221 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
222 printf " vis=%d", $row->visible_height
223 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
225 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
229 if ($row->displays_text_p)
232 if ($row->mode_line_p)
235 if ($row->continued_p)
238 if ($row-> truncated_on_left_p)
241 if ($row-> truncated_on_right_p)
244 if ($row->starts_in_middle_of_char_p)
247 if ($row->ends_in_middle_of_char_p)
250 if ($row->ends_in_newline_from_string_p)
253 if ($row->ends_at_zv_p)
256 if ($row->overlapped_p)
259 if ($row->overlapping_p)
265 Pretty print information about glyph_row.
266 Takes one argument, a row object or pointer.
273 Pretty print information about glyph_row in row.
279 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
282 Pretty print a window cursor
287 pcursorx output_cursor
291 Pretty print the output_cursor
296 xgetint $w->sequence_number
297 if ($w->mini_p != Qnil)
300 printf "Window %d ", $int
302 set $tem = (struct buffer *) $ptr
304 printf "%s", ((struct Lisp_String *) $ptr)->data
307 set $tem = (struct Lisp_Marker *) $ptr
308 printf "start=%d end:", $tem->charpos
309 if ($w->window_end_valid != Qnil)
310 xgetint $w->window_end_pos
311 printf "pos=%d", $int
312 xgetint $w->window_end_vpos
313 printf " vpos=%d", $int
317 printf " vscroll=%d", $w->vscroll
318 if ($w->force_start != Qnil)
319 printf " FORCE_START"
321 if ($w->must_be_updated_p)
328 pcursorx $w->phys_cursor
329 if ($w->phys_cursor_on_p)
335 if ($w->last_cursor_off_p != $w->cursor_off_p)
336 if ($w->last_cursor_off_p)
342 if ($w->cursor_off_p)
350 Pretty print a window structure.
351 Takes one argument, a pointer to a window structure
358 Pretty print window structure w.
366 if $type == Lisp_Misc
369 if $type == Lisp_Vectorlike
375 Print the type of $, assuming it is an Emacs Lisp value.
376 If the first type printed is Lisp_Vector or Lisp_Misc,
377 a second line gives the more precise type.
382 set $size = ((struct Lisp_Vector *) $ptr)->size
383 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
387 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
392 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
396 Print the specific type of $, assuming it is some misc type.
404 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
412 Print the pointer portion of $, assuming it is an Emacs Lisp value.
417 print (struct Lisp_Marker *) $ptr
420 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
425 print (struct Lisp_Overlay *) $ptr
428 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
433 print (struct Lisp_Free *) $ptr
436 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
441 print (struct Lisp_Intfwd *) $ptr
444 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
449 print (struct Lisp_Boolfwd *) $ptr
452 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
457 print (struct Lisp_Objfwd *) $ptr
460 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
465 print (struct Lisp_Buffer_Objfwd *) $ptr
468 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
473 print (struct Lisp_Kboard_Objfwd *) $ptr
476 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
481 print (struct Lisp_Buffer_Local_Value *) $ptr
484 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
490 print (struct Lisp_Symbol *) $ptr
495 Print the name and address of the symbol $.
496 This command assumes that $ is an Emacs Lisp symbol value.
501 print (struct Lisp_String *) $ptr
506 Print the contents and address of the string $.
507 This command assumes that $ is an Emacs Lisp string value.
512 print (struct Lisp_Vector *) $ptr
513 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
517 Print the contents and address of the vector $.
518 This command assumes that $ is an Emacs Lisp vector value.
523 print (struct Lisp_Process *) $ptr
528 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
533 print (struct frame *) $ptr
536 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
541 print (struct Lisp_Vector *) $ptr
542 output ($->contents[0])@($->size & 0xff)
545 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
550 print (struct window *) $ptr
551 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
554 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
555 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
560 print (struct save_window_data *) $ptr
563 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
568 print (struct Lisp_Subr *) $ptr
573 Print the address of the subr which the Lisp_Object $ points to.
578 print (struct Lisp_Char_Table *) $ptr
581 printf " %d extra slots", ($->size & 0x1ff) - 388
585 Print the address of the char-table $, and its purpose.
586 This command assumes that $ is an Emacs Lisp char-table value.
591 print (struct Lisp_Bool_Vector *) $ptr
592 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
596 Print the contents and address of the bool-vector $.
597 This command assumes that $ is an Emacs Lisp bool-vector value.
602 print (struct buffer *) $ptr
604 output ((struct Lisp_String *) $ptr)->data
608 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
609 Print the name of the buffer.
614 print (struct Lisp_Hash_Table *) $ptr
617 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
622 print (struct Lisp_Cons *) $ptr
627 Print the contents of $, assuming it is an Emacs Lisp cons.
635 Print the contents of the next cell in a list.
636 This assumes that the last thing you printed was a cons cell contents
637 (type struct Lisp_Cons) or a pointer to one.
642 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
645 Print the car of $, assuming it is an Emacs Lisp pair.
651 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
654 Print the cdr of $, assuming it is an Emacs Lisp pair.
659 print ((struct Lisp_Float *) $ptr)->u.data
662 Print $ assuming it is a lisp floating-point number.
667 print (struct scrollbar *) $ptr
672 Print $ as a scrollbar pointer.
676 set $data = $arg0->data
677 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
682 set $sym = (struct Lisp_Symbol *) $ptr
684 set $sym_name = (struct Lisp_String *) $ptr
688 Print argument as a symbol.
692 set $bt = backtrace_list
694 xgettype (*$bt->function)
695 if $type == Lisp_Symbol
696 xprintsym (*$bt->function)
699 printf "0x%x ", *$bt->function
700 if $type == Lisp_Vectorlike
701 xgetptr (*$bt->function)
702 set $size = ((struct Lisp_Vector *) $ptr)->size
703 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
705 printf "Lisp type %d", $type
713 Print a backtrace of Lisp function calls from backtrace_list.
714 Set a breakpoint at Fsignal and call this to see from where
715 an error was signaled.
718 # Show Lisp backtrace after normal backtrace.
719 define hookpost-backtrace
720 set $bt = backtrace_list
723 echo Lisp Backtrace:\n
729 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
730 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
733 When starting Emacs a second time in the same gdb session under
734 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
735 their values. (The same happens on current (2000) versions of GNU/Linux
737 This function reloads them.
741 # Flush display (X only)
746 Flush pending X window display updates to screen.
747 Works only when an inferior emacs is executing.
755 # Call xreload if a new Emacs executable is loaded.
761 set print sevenbit-strings
763 show environment DISPLAY
764 show environment TERM
765 set args -geometry 80x40+0+0
767 # People get bothered when they see messages about non-existent functions...
769 echo If you see messages below about functions not being defined,\n
770 echo don\'t worry about them. Nothing is wrong.\n
773 # Don't let abort actually run, as it will make
774 # stdio stop working and therefore the `pr' command above as well.
777 # The MS-Windows build replaces abort with its own function.
780 # If we are running in synchronous mode, we want a chance to look around
781 # before Emacs exits. Perhaps we should put the break somewhere else
783 break x_error_quitter
785 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe