# some useful commands for debugging emacs with gdb 4.* or better
# used on machines without NO_UNION_TYPE defined (only the Alpha now?)

set print union off
set print pretty off

define temacs
run -batch -l loadup.el run-temacs -q
end

echo \n>>> Use the `temacs' command to run temacs\n\n

# if you use Purify, do this:
# set env PURIFYOPTIONS -pointer-mask=0x0fffffff

# was frob, but p1 is short for prin1
define p1
#call = Fprin1 ($tem, Qexternal_debugging_output)
# compensate for GDB struct-passing bug
set debug_temp = $
call debug_print (&debug_temp)
printf "\n"
end

define lbt
# "&" to compensate for GDB struct-passing bug
# but I've removed the &'s because it doesn't work with my GDB,
# and not having them works fine.
call Fbacktrace (Qexternal_debugging_output, Qt)
end


set $vector_length_mask = ~(1<<31)

define xtype
# this is really xgctype, as we mask off the mark bit
output (enum Lisp_Type) ($.gu.type)
echo \n
end

define xint
print ((int)($.s.val << 4))>>4
end

define xmarkbit
print $.gu.markbit
end

define xrecord
print (struct lrecord_header *) $.gu.val
output *($->implementation)
echo \n
end

define xbitvec
print (struct Lisp_Bit_Vector *) ($.gu.val)
end

define xbuffer
print (struct buffer *) ($.gu.val)
end

define xbytecode
print (struct Lisp_Bytecode *) ($.gu.val)
end

define xcharset
print (struct Lisp_Charset *) ($.gu.val)
end

define xchartab
print (struct Lisp_Char_Table *) ($.gu.val)
end

define xchartabentry
print (struct Lisp_Char_Table_Entry *) ($.gu.val)
end

define xcodesys
print (struct Lisp_Coding_System *) ($.gu.val)
end

define xcolorinst
print (struct Lisp_Color_Instance *) ($.gu.val)
end

define xcons
print (struct Lisp_Cons *) ($.gu.val)
end

define xcursor
print (struct Lisp_Cursor *) ($.gu.val)
end

define xdevice
print (struct device *) ($.gu.val)
end

define xevent
print (struct Lisp_Event *) ($.gu.val)
end

define xextent
print (struct extent *) ($.gu.val)
end

define xextentaux
print (struct extent_auxiliary *) ($.gu.val)
end

define xextentinfo
print (struct extent_info *) ($.gu.val)
end

define xfloat
print (struct Lisp_Float *) ($.gu.val)
output (double) $->data.d
echo \n
end

define xfontinst
print (struct Lisp_Font_Instance *) ($.gu.val)
end

define xframe
print (struct frame *) ($.gu.val)
end

define xglyph
print (struct Lisp_Glyph *) ($.gu.val)
end

define xhashtable
print (struct hashtable_struct *) ($.gu.val)
end

define ximageinst
print (struct Lisp_Image_Instance *) ($.gu.val)
end

define xkeymap
print (struct keymap *) ($.gu.val)
end

define xlstream
print (struct lstream *) ($.gu.val)
end

define xmarker
print (struct Lisp_Marker *) ($.gu.val)
end

define xmenubardata
print (struct menubar_data *) ($.gu.val)
end

define xopaque
print (struct Lisp_Opaque *) ($.gu.val)
end

define xprocess
print (struct Lisp_Process *) ($.gu.val)
end

define xrangetab
print (struct Lisp_Range_Table *) ($.gu.val)
end

define xspec
print (struct Lisp_Specifier *) ($.gu.val)
end

define xstring
print (struct Lisp_String *) ($.gu.val)
output (char *) $->_data
echo \n
end

define xsubr
print (struct Lisp_Subr *) ($.gu.val)
end

define xsubwindow
print (struct Lisp_Subwindow *) ($.gu.val)
end

define xtoolbarbutton
print (struct toolbar_button *) ($.gu.val)
end

define xtoolbardata
print (struct toolbar_data *) ($.gu.val)
end

define xtooltalkmess
print (struct Lisp_Tooltalk_Message *) ($.gu.val)
end

define xtooltalkpatt
print (struct Lisp_Tooltalk_Pattern *) ($.gu.val)
end

define xvector
print (struct Lisp_Vector *) ($.gu.val)
end

define xwindow
print (struct window *) ($.gu.val)
end

define xwindowconfig
print (struct window_config *) ($.gu.val)
end

define nilp
print $ == Qnil
end

define car
set $tem = ((struct Lisp_Cons *) $.gu.val)->car
end

define cdr
set $tem = ((struct Lisp_Cons *) $.gu.val)->cdr
end

define string-length
print ((struct Lisp_String *) $.gu.val)->_size & $vector_length_mask
end

define string-contents
print (char *) ((struct Lisp_String *) $.gu.val)->_data
end

define vector-length
print ((struct Lisp_Vector *) $.gu.val)->size & $vector_length_mask
end

define vector-contents
set $tem = (struct Lisp_Vector *) $.gu.val
print *($tem->contents) @ ($tem->size & $vector_length_mask)
set $ = $tem->contents
end

define symbol-name
set $tem = ((struct Lisp_Symbol *) $.gu.val)->name
# output *($tem->_data) @ ($tem->_size & $vector_length_mask)
output ($tem->_data) 
echo \n
set $type = Lisp_String
echo \n
end

define xsymbol
symbol-name
end

define symbol-value
set $tem = ((struct Lisp_Symbol *) $.gu.val)->value
end

define symbol-function
set $tem = ((struct Lisp_Symbol *) $.gu.val)->function
end

define symbol-plist
set $tem = ((struct Lisp_Symbol *) $.gu.val)->plist
end

define wtype
p $->core.widget_class->core_class.class_name
end

define xtname
print XrmQuarkToString(((Object)($))->object.xrm_name)
end

# 
# GDB, with the losing command-line parser that it has,
# cannot handle nested blocks.
# 
define breaks

br Fsignal
# command
# bt 3
# p sig
# xsymbol
# end

br Fkill_emacs
# command
# bt 3
# end

br assertion_failed
# command
# bt 3
# end

end