-# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004
-# Free Software Foundation, Inc.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
+# 2004, 2005, 2006 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
# However, C-z works just as well in that case.
handle 2 noprint pass
+# Make it work like SIGINT normally does.
+handle SIGTSTP nopass
+
# Don't pass SIGALRM to Emacs. This makes problems when
# debugging.
handle SIGALRM ignore
end
# Set up something to print out s-expressions.
+# We save and restore print_output_debug_flag to prevent the w32 port
+# from calling OutputDebugString, which causes GDB to display each
+# character twice (yuk!).
define pr
+ set $output_debug = print_output_debug_flag
+ set print_output_debug_flag = 0
set debug_print ($)
+ set print_output_debug_flag = $output_debug
end
document pr
Print the emacs s-expression which is $.
# Print out s-expressions
define pp
set $tmp = $arg0
- set debug_print ($tmp)
+ set $output_debug = print_output_debug_flag
+ set print_output_debug_flag = 0
+ set safe_debug_print ($tmp)
+ set print_output_debug_flag = $output_debug
end
document pp
Print the argument as an emacs s-expression
# Print out s-expressions from tool bar
define pp1
set $tmp = $arg0
- echo $arg0
- printf " = "
- set debug_print ($tmp)
+ set $output_debug = print_output_debug_flag
+ set print_output_debug_flag = 0
+ set safe_debug_print ($tmp)
+ set print_output_debug_flag = $output_debug
end
document pp1
-Print the argument as an emacs s-expression
+Print the argument as an emacs s-expression.
Works only when an inferior emacs is executing.
For use on tool bar when debugging in Emacs
where the variable name would not otherwise
be recorded in the GUD buffer.
end
+# Print value of lisp variable
+define pv
+ set $tmp = "$arg0"
+ set $output_debug = print_output_debug_flag
+ set print_output_debug_flag = 0
+ set safe_debug_print ( find_symbol_value (intern ($tmp)))
+ set print_output_debug_flag = $output_debug
+end
+document pv
+Print the value of the lisp variable given as argument.
+Works only when an inferior emacs is executing.
+end
+
+# Print value of lisp variable
+define pv1
+ set $tmp = "$arg0"
+ set $output_debug = print_output_debug_flag
+ set print_output_debug_flag = 0
+ set safe_debug_print (find_symbol_value (intern ($tmp)))
+ set print_output_debug_flag = $output_debug
+end
+document pv1
+Print the value of the lisp variable given as argument.
+Works only when an inferior emacs is executing.
+For use when debugging in Emacs where the variable
+name would not otherwise be recorded in the GUD buffer.
+end
+
# Print out current buffer point and boundaries
define ppt
set $b = current_buffer
printf " HL"
end
if ($it->n_overlay_strings > 0)
- printf " nov=%d"
+ printf " nov=%d", $it->n_overlay_strings
end
if ($it->sp != 0)
printf " sp=%d", $it->sp
printf " ch=[%d,%d]", $it->c, $it->len
end
else
- if ($it->what == IT_IMAGE)
- printf " IMAGE=%d", $it->image_id
- else
- printf " "
- output $it->what
- end
+ printf " "
+ output $it->what
end
if ($it->method != GET_FROM_BUFFER)
printf " next="
if ($it->method == GET_FROM_STRING)
printf "[%d]", $it->current.string_pos.charpos
end
+ if ($it->method == GET_FROM_IMAGE)
+ printf "[%d]", $it->image_id
+ end
+ if ($it->method == GET_FROM_COMPOSITION)
+ printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
+ end
end
printf "\n"
if ($it->region_beg_charpos >= 0)
printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
+ printf " w=%d", $it->pixel_width
printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
printf "\n"
+ set $i = 0
+ while ($i < $it->sp)
+ set $e = $it->stack[$i]
+ printf "stack[%d]: ", $i
+ output $e->method
+ printf "[%d]", $e->position.charpos
+ printf "\n"
+ set $i = $i + 1
+ end
end
document pitx
Pretty print a display iterator.
Pretty print window structure w.
end
+define pgx
+ set $g = $arg0
+ if ($g->type == CHAR_GLYPH)
+ if ($g->u.ch >= ' ' && $g->u.ch < 127)
+ printf "CHAR[%c]", $g->u.ch
+ else
+ printf "CHAR[0x%x]", $g->u.ch
+ end
+ end
+ if ($g->type == COMPOSITE_GLYPH)
+ printf "COMP[%d]", $g->u.cmp_id
+ end
+ if ($g->type == IMAGE_GLYPH)
+ printf "IMAGE[%d]", $g->u.img_id
+ end
+ if ($g->type == STRETCH_GLYPH)
+ printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
+ end
+ xgettype ($g->object)
+ if ($type == Lisp_String)
+ printf " str=%x[%d]", $g->object, $g->charpos
+ else
+ printf " pos=%d", $g->charpos
+ end
+ printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
+ if ($g->face_id != DEFAULT_FACE_ID)
+ printf " face=%d", $g->face_id
+ end
+ if ($g->voffset)
+ printf " vof=%d", $g->voffset
+ end
+ if ($g->multibyte_p)
+ printf " MB"
+ end
+ if ($g->padding_p)
+ printf " PAD"
+ end
+ if ($g->glyph_not_available_p)
+ printf " N/A"
+ end
+ if ($g->overlaps_vertically_p)
+ printf " OVL"
+ end
+ if ($g->left_box_line_p)
+ printf " ["
+ end
+ if ($g->right_box_line_p)
+ printf " ]"
+ end
+ if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
+ printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
+ end
+ printf "\n"
+end
+document pgx
+Pretty print a glyph structure.
+Takes one argument, a pointer to a glyph structure
+end
+
+define pg
+ set $pgidx = 0
+ pgx glyph
+end
+document pg
+Pretty print glyph structure glyph.
+end
+
+define pgi
+ set $pgidx = $arg0
+ pgx (&glyph[$pgidx])
+end
+document pgi
+Pretty print glyph structure glyph[I].
+Takes one argument, a integer I.
+end
+
+define pgn
+ set $pgidx = $pgidx + 1
+ pgx (&glyph[$pgidx])
+end
+document pgn
+Pretty print next glyph structure.
+end
+
+define pgrowx
+ set $row = $arg0
+ set $area = 0
+ set $xofs = $row->x
+ while ($area < 3)
+ set $used = $row->used[$area]
+ if ($used > 0)
+ set $gl0 = $row->glyphs[$area]
+ set $pgidx = 0
+ printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
+ while ($pgidx < $used)
+ printf "%3d %4d: ", $pgidx, $xofs
+ pgx $gl0[$pgidx]
+ set $xofs = $xofs + $gl0[$pgidx]->pixel_width
+ set $pgidx = $pgidx + 1
+ end
+ end
+ set $area = $area + 1
+ end
+end
+document pgrowx
+Pretty print all glyphs in a row structure.
+Takes one argument, a pointer to a row structure.
+end
+
+define pgrow
+ pgrowx row
+end
+document pgrow
+Pretty print all glyphs in row structure row.
+end
define xtype
xgettype $
define xframe
xgetptr $
print (struct frame *) $ptr
+ xgetptr $->name
+ set $ptr = (struct Lisp_String *) $ptr
+ xprintstr $ptr
+ echo \n
end
document xframe
Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
define xwindow
xgetptr $
print (struct window *) $ptr
- printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
+ set $window = (struct window *) $ptr
+ xgetint $window->total_cols
+ set $width=$int
+ xgetint $window->total_lines
+ set $height=$int
+ xgetint $window->left_col
+ set $left=$int
+ xgetint $window->top_line
+ set $top=$int
+ printf "%dx%d+%d+%d\n", $width, $height, $left, $top
end
document xwindow
Print $ as a window pointer, assuming it is an Emacs Lisp window value.
end
define nextcons
- p $.cdr
+ p $.u.cdr
xcons
end
document nextcons
define xcdr
xgetptr $
xgettype $
- print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0)
+ print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
end
document xcdr
Print the cdr of $, assuming it is an Emacs Lisp pair.
end
+define xlist
+ xgetptr $
+ set $cons = (struct Lisp_Cons *) $ptr
+ xgetptr Qnil
+ set $nil = $ptr
+ set $i = 0
+ while $cons != $nil && $i < 10
+ p/x $cons->car
+ xpr
+ xgetptr $cons->u.cdr
+ set $cons = (struct Lisp_Cons *) $ptr
+ set $i = $i + 1
+ printf "---\n"
+ end
+ if $cons == $nil
+ printf "nil\n"
+ else
+ printf "...\n"
+ p $ptr
+ end
+end
+document xlist
+Print $ assuming it is a list.
+end
+
define xfloat
xgetptr $
- print ((struct Lisp_Float *) $ptr)->data
+ print ((struct Lisp_Float *) $ptr)->u.data
end
document xfloat
Print $ assuming it is a lisp floating-point number.
Print $ as a scrollbar pointer.
end
+define xpr
+ xtype
+ if $type == Lisp_Int
+ xint
+ end
+ if $type == Lisp_Symbol
+ xsymbol
+ end
+ if $type == Lisp_String
+ xstring
+ end
+ if $type == Lisp_Cons
+ xcons
+ end
+ if $type == Lisp_Float
+ xfloat
+ end
+ if $type == Lisp_Misc
+ set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
+ if $misc == Lisp_Misc_Free
+ xmiscfree
+ end
+ if $misc == Lisp_Misc_Boolfwd
+ xboolfwd
+ end
+ if $misc == Lisp_Misc_Marker
+ xmarker
+ end
+ if $misc == Lisp_Misc_Intfwd
+ xintfwd
+ end
+ if $misc == Lisp_Misc_Boolfwd
+ xboolfwd
+ end
+ if $misc == Lisp_Misc_Objfwd
+ xobjfwd
+ end
+ if $misc == Lisp_Misc_Buffer_Objfwd
+ xbufobjfwd
+ end
+ if $misc == Lisp_Misc_Buffer_Local_Value
+ xbuflocal
+ end
+# if $misc == Lisp_Misc_Some_Buffer_Local_Value
+# xvalue
+# end
+ if $misc == Lisp_Misc_Overlay
+ xoverlay
+ end
+ if $misc == Lisp_Misc_Kboard_Objfwd
+ xkbobjfwd
+ end
+# if $misc == Lisp_Misc_Save_Value
+# xsavevalue
+# end
+ end
+ if $type == Lisp_Vectorlike
+ set $size = ((struct Lisp_Vector *) $ptr)->size
+ if ($size & PVEC_FLAG)
+ set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
+ if $vec == PVEC_NORMAL_VECTOR
+ xvector
+ end
+ if $vec == PVEC_PROCESS
+ xprocess
+ end
+ if $vec == PVEC_FRAME
+ xframe
+ end
+ if $vec == PVEC_COMPILED
+ xcompiled
+ end
+ if $vec == PVEC_WINDOW
+ xwindow
+ end
+ if $vec == PVEC_WINDOW_CONFIGURATION
+ xwinconfig
+ end
+ if $vec == PVEC_SUBR
+ xsubr
+ end
+ if $vec == PVEC_CHAR_TABLE
+ xchartable
+ end
+ if $vec == PVEC_BOOL_VECTOR
+ xboolvector
+ end
+ if $vec == PVEC_BUFFER
+ xbuffer
+ end
+ if $vec == PVEC_HASH_TABLE
+ xhashtable
+ end
+ else
+ xvector
+ end
+ end
+end
+document xpr
+Print $ as a lisp object of any type.
+end
+
define xprintstr
set $data = $arg0->data
output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
xgettype (*$bt->function)
if $type == Lisp_Symbol
xprintsym (*$bt->function)
- echo \n
+ printf " (0x%x)\n", *$bt->args
else
printf "0x%x ", *$bt->function
if $type == Lisp_Vectorlike
an error was signaled.
end
+define which
+ set debug_print (which_symbols ($arg0))
+end
+document which
+ Print symbols which references a given lisp object,
+ either as its symbol value or symbol function.
+end
+
+define xbytecode
+ set $bt = byte_stack_list
+ while $bt
+ xgettype ($bt->byte_string)
+ printf "0x%x => ", $bt->byte_string
+ which $bt->byte_string
+ set $bt = $bt->next
+ end
+end
+document xbytecode
+ Print a backtrace of the byte code stack.
+end
+
+# Show Lisp backtrace after normal backtrace.
+define hookpost-backtrace
+ set $bt = backtrace_list
+ if $bt
+ echo \n
+ echo Lisp Backtrace:\n
+ xbacktrace
+ end
+end
+
define xreload
set $tagmask = (((long)1 << gdb_gctypebits) - 1)
set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
show environment TERM
set args -geometry 80x40+0+0
-# Don't let abort actually run, as it will make
-# stdio stop working and therefore the `pr' command above as well.
-break abort
-
-# If we are running in synchronous mode, we want a chance to look around
-# before Emacs exits. Perhaps we should put the break somewhere else
-# instead...
-break x_error_quitter
+# People get bothered when they see messages about non-existent functions...
+xgetptr Vsystem_type
+# $ptr is NULL in temacs
+if ($ptr != 0)
+ set $tem = (struct Lisp_Symbol *) $ptr
+ xgetptr $tem->xname
+ set $tem = (struct Lisp_String *) $ptr
+ set $tem = (char *) $tem->data
+
+ # Don't let abort actually run, as it will make stdio stop working and
+ # therefore the `pr' command above as well.
+ if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
+ # The windows-nt build replaces abort with its own function.
+ break w32_abort
+ else
+ break abort
+ end
+end
+# x_error_quitter is defined only on X. But window-system is set up
+# only at run time, during Emacs startup, so we need to defer setting
+# the breakpoint. init_sys_modes is the first function called on
+# every platform after init_display, where window-system is set.
+tbreak init_sys_modes
+commands
+ silent
+ xgetptr Vwindow_system
+ set $tem = (struct Lisp_Symbol *) $ptr
+ xgetptr $tem->xname
+ set $tem = (struct Lisp_String *) $ptr
+ set $tem = (char *) $tem->data
+ # If we are running in synchronous mode, we want a chance to look
+ # around before Emacs exits. Perhaps we should put the break
+ # somewhere else instead...
+ if $tem[0] == 'x' && $tem[1] == '\0'
+ break x_error_quitter
+ end
+ continue
+end
# arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe