1 # Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004
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 # Don't pass SIGALRM to Emacs. This makes problems when
38 # $valmask and $tagmask are mask values set up by the xreload macro below.
40 # Use $bugfix so that the value isn't a constant.
41 # Using a constant runs into GDB bugs sometimes.
44 set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
49 set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
54 set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
57 # Set up something to print out s-expressions.
62 Print the emacs s-expression which is $.
63 Works only when an inferior emacs is executing.
66 # Print out s-expressions
69 set safe_debug_print ($tmp)
72 Print the argument as an emacs s-expression
73 Works only when an inferior emacs is executing.
76 # Print out s-expressions from tool bar
81 set safe_debug_print ($tmp)
84 Print the argument as an emacs s-expression
85 Works only when an inferior emacs is executing.
86 For use on tool bar when debugging in Emacs
87 where the variable name would not otherwise
88 be recorded in the GUD buffer.
91 # Print value of lisp variable
94 set safe_debug_print ( find_symbol_value (intern ($tmp)))
97 Print the value of the lisp variable given as argument.
98 Works only when an inferior emacs is executing.
101 # Print value of lisp variable
106 set safe_debug_print (find_symbol_value (intern ($tmp)))
109 Print the value of the lisp variable given as argument.
110 Works only when an inferior emacs is executing.
111 For use on tool bar when debugging in Emacs
112 where the variable name would not otherwise
113 be recorded in the GUD buffer.
116 # Print out current buffer point and boundaries
118 set $b = current_buffer
120 printf "BUF PT: %d", $b->pt
121 if ($b->pt != $b->pt_byte)
122 printf "[%d]", $b->pt_byte
124 printf " of 1..%d", $t->z
125 if ($t->z != $t->z_byte)
126 printf "[%d]", $t->z_byte
128 if ($b->begv != 1 || $b->zv != $t->z)
129 printf " NARROW=%d..%d", $b->begv, $b->zv
130 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
131 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
134 printf " GAP: %d", $t->gpt
135 if ($t->gpt != $t->gpt_byte)
136 printf "[%d]", $t->gpt_byte
138 printf " SZ=%d\n", $t->gap_size
141 Print point, beg, end, narrow, and gap for current buffer.
144 # Print out iterator given as first arg
147 printf "cur=%d", $it->current.pos.charpos
148 if ($it->current.pos.charpos != $it->current.pos.bytepos)
149 printf "[%d]", $it->current.pos.bytepos
151 printf " start=%d", $it->start.pos.charpos
152 if ($it->start.pos.charpos != $it->start.pos.bytepos)
153 printf "[%d]", $it->start.pos.bytepos
155 printf " end=%d", $it->end_charpos
156 printf " stop=%d", $it->stop_charpos
157 printf " face=%d", $it->face_id
158 if ($it->multibyte_p)
161 if ($it->header_line_p)
164 if ($it->n_overlay_strings > 0)
168 printf " sp=%d", $it->sp
170 if ($it->what == IT_CHARACTER)
171 if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
172 printf " ch='%c'", $it->c
174 printf " ch=[%d,%d]", $it->c, $it->len
177 if ($it->what == IT_IMAGE)
178 printf " IMAGE=%d", $it->image_id
184 if ($it->method != GET_FROM_BUFFER)
187 if ($it->method == GET_FROM_STRING)
188 printf "[%d]", $it->current.string_pos.charpos
192 if ($it->region_beg_charpos >= 0)
193 printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
195 printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
196 printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
197 printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
198 printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
199 printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
203 Pretty print a display iterator.
204 Take one arg, an iterator object or pointer.
211 Pretty print the display iterator it.
216 printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
217 printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
218 printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
219 printf " vis=%d", $row->visible_height
220 printf " L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
222 printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
226 if ($row->displays_text_p)
229 if ($row->mode_line_p)
232 if ($row->continued_p)
235 if ($row-> truncated_on_left_p)
238 if ($row-> truncated_on_right_p)
241 if ($row->starts_in_middle_of_char_p)
244 if ($row->ends_in_middle_of_char_p)
247 if ($row->ends_in_newline_from_string_p)
250 if ($row->ends_at_zv_p)
253 if ($row->overlapped_p)
256 if ($row->overlapping_p)
262 Pretty print information about glyph_row.
263 Takes one argument, a row object or pointer.
270 Pretty print information about glyph_row in row.
276 printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
279 Pretty print a window cursor
284 pcursorx output_cursor
288 Pretty print the output_cursor
293 xgetint $w->sequence_number
294 if ($w->mini_p != Qnil)
297 printf "Window %d ", $int
299 set $tem = (struct buffer *) $ptr
301 printf "%s", ((struct Lisp_String *) $ptr)->data
304 set $tem = (struct Lisp_Marker *) $ptr
305 printf "start=%d end:", $tem->charpos
306 if ($w->window_end_valid != Qnil)
307 xgetint $w->window_end_pos
308 printf "pos=%d", $int
309 xgetint $w->window_end_vpos
310 printf " vpos=%d", $int
314 printf " vscroll=%d", $w->vscroll
315 if ($w->force_start != Qnil)
316 printf " FORCE_START"
318 if ($w->must_be_updated_p)
325 pcursorx $w->phys_cursor
326 if ($w->phys_cursor_on_p)
332 if ($w->last_cursor_off_p != $w->cursor_off_p)
333 if ($w->last_cursor_off_p)
339 if ($w->cursor_off_p)
347 Pretty print a window structure.
348 Takes one argument, a pointer to a window structure
355 Pretty print window structure w.
363 if $type == Lisp_Misc
366 if $type == Lisp_Vectorlike
372 Print the type of $, assuming it is an Emacs Lisp value.
373 If the first type printed is Lisp_Vector or Lisp_Misc,
374 a second line gives the more precise type.
379 set $size = ((struct Lisp_Vector *) $ptr)->size
380 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
384 Print the size or vector subtype of $, assuming it is a vector or pseudovector.
389 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
393 Print the specific type of $, assuming it is some misc type.
401 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
409 Print the pointer portion of $, assuming it is an Emacs Lisp value.
414 print (struct Lisp_Marker *) $ptr
417 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
422 print (struct Lisp_Overlay *) $ptr
425 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
430 print (struct Lisp_Free *) $ptr
433 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
438 print (struct Lisp_Intfwd *) $ptr
441 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
446 print (struct Lisp_Boolfwd *) $ptr
449 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
454 print (struct Lisp_Objfwd *) $ptr
457 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
462 print (struct Lisp_Buffer_Objfwd *) $ptr
465 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
470 print (struct Lisp_Kboard_Objfwd *) $ptr
473 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
478 print (struct Lisp_Buffer_Local_Value *) $ptr
481 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
487 print (struct Lisp_Symbol *) $ptr
492 Print the name and address of the symbol $.
493 This command assumes that $ is an Emacs Lisp symbol value.
498 print (struct Lisp_String *) $ptr
503 Print the contents and address of the string $.
504 This command assumes that $ is an Emacs Lisp string value.
509 print (struct Lisp_Vector *) $ptr
510 output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
514 Print the contents and address of the vector $.
515 This command assumes that $ is an Emacs Lisp vector value.
520 print (struct Lisp_Process *) $ptr
525 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
530 print (struct frame *) $ptr
533 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
538 print (struct Lisp_Vector *) $ptr
539 output ($->contents[0])@($->size & 0xff)
542 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
547 print (struct window *) $ptr
548 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
551 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
552 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
557 print (struct save_window_data *) $ptr
560 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
565 print (struct Lisp_Subr *) $ptr
570 Print the address of the subr which the Lisp_Object $ points to.
575 print (struct Lisp_Char_Table *) $ptr
578 printf " %d extra slots", ($->size & 0x1ff) - 388
582 Print the address of the char-table $, and its purpose.
583 This command assumes that $ is an Emacs Lisp char-table value.
588 print (struct Lisp_Bool_Vector *) $ptr
589 output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
593 Print the contents and address of the bool-vector $.
594 This command assumes that $ is an Emacs Lisp bool-vector value.
599 print (struct buffer *) $ptr
601 output ((struct Lisp_String *) $ptr)->data
605 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
606 Print the name of the buffer.
611 print (struct Lisp_Hash_Table *) $ptr
614 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
619 print (struct Lisp_Cons *) $ptr
624 Print the contents of $, assuming it is an Emacs Lisp cons.
632 Print the contents of the next cell in a list.
633 This assumes that the last thing you printed was a cons cell contents
634 (type struct Lisp_Cons) or a pointer to one.
639 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
642 Print the car of $, assuming it is an Emacs Lisp pair.
648 print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0)
651 Print the cdr of $, assuming it is an Emacs Lisp pair.
656 print ((struct Lisp_Float *) $ptr)->data
659 Print $ assuming it is a lisp floating-point number.
664 print (struct scrollbar *) $ptr
669 Print $ as a scrollbar pointer.
673 set $data = $arg0->data
674 output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
679 set $sym = (struct Lisp_Symbol *) $ptr
681 set $sym_name = (struct Lisp_String *) $ptr
685 Print argument as a symbol.
689 set $bt = backtrace_list
691 xgettype (*$bt->function)
692 if $type == Lisp_Symbol
693 xprintsym (*$bt->function)
696 printf "0x%x ", *$bt->function
697 if $type == Lisp_Vectorlike
698 xgetptr (*$bt->function)
699 set $size = ((struct Lisp_Vector *) $ptr)->size
700 output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
702 printf "Lisp type %d", $type
710 Print a backtrace of Lisp function calls from backtrace_list.
711 Set a breakpoint at Fsignal and call this to see from where
712 an error was signaled.
716 set $tagmask = (((long)1 << gdb_gctypebits) - 1)
717 set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
720 When starting Emacs a second time in the same gdb session under
721 FreeBSD 2.2.5, gdb 4.13, $valmask have lost
722 their values. (The same happens on current (2000) versions of GNU/Linux
724 This function reloads them.
728 # Flush display (X only)
733 Flush pending X window display updates to screen.
734 Works only when an inferior emacs is executing.
742 # Call xreload if a new Emacs executable is loaded.
748 set print sevenbit-strings
750 show environment DISPLAY
751 show environment TERM
752 set args -geometry 80x40+0+0
754 # Don't let abort actually run, as it will make
755 # stdio stop working and therefore the `pr' command above as well.
758 # If we are running in synchronous mode, we want a chance to look around
759 # before Emacs exits. Perhaps we should put the break somewhere else
761 break x_error_quitter
763 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe