# specified:
# USE_UNION_TYPE
-# USE_MINIMAL_TAGBITS
-# USE_INDEXED_LRECORD_IMPLEMENTATION
-# LRECORD_(SYMBOL|STRING|VECTOR)
# (the above all have configure equivalents)
define decode_object
set $obj = (unsigned long) $arg0
- if dbg_USE_MINIMAL_TAGBITS
- if $obj & 1
- # It's an int
- set $val = $obj >> 1
- set $type = dbg_Lisp_Type_Int
+ if $obj & 1
+ # It's an int
+ set $val = $obj >> 1
+ set $type = Lisp_Type_Int
+ else
+ set $type = $obj & dbg_typemask
+ if $type == Lisp_Type_Char
+ set $val = ($obj & dbg_valmask) >> dbg_gctypebits
else
- set $type = $obj & dbg_typemask
- if $type == dbg_Lisp_Type_Char
- set $val = ($obj & dbg_valmask) >> dbg_gctypebits
- else
- # It's a record pointer
- set $val = $obj
- end
+ # It's a record pointer
+ set $val = $obj
end
- else
- # not dbg_USE_MINIMAL_TAGBITS
- set $val = $obj & dbg_valmask
- set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1)
end
- if $type == dbg_Lisp_Type_Record
+ if $type == Lisp_Type_Record
set $lheader = (struct lrecord_header *) $val
- if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
- set $imp = lrecord_implementations_table[$lheader->type]
- else
- set $imp = $lheader->implementation
- end
+ set $imp = lrecord_implementations_table[$lheader->type]
else
set $imp = -1
end
define xtype
decode_object $arg0
- if $type == dbg_Lisp_Type_Int
+ if $type == Lisp_Type_Int
echo int\n
else
- if $type == dbg_Lisp_Type_Char
+ if $type == Lisp_Type_Char
echo char\n
else
- if $type == dbg_Lisp_Type_Symbol
+ if $type == Lisp_Type_Symbol
echo symbol\n
else
- if $type == dbg_Lisp_Type_String
+ if $type == Lisp_Type_String
echo string\n
else
- if $type == dbg_Lisp_Type_Vector
+ if $type == Lisp_Type_Vector
echo vector\n
else
- if $type == dbg_Lisp_Type_Cons
+ if $type == Lisp_Type_Cons
echo cons\n
else
printf "record type: %s\n", $imp->name
end
end
-define run-temacs
+define lisp-shadows
+ run -batch -vanilla -f list-load-path-shadows
+end
+
+document lisp-shadows
+Usage: lisp-shadows
+Run xemacs to check for lisp shadows
+end
+
+define environment-to-run-temacs
unset env EMACSLOADPATH
- set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+ set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
+end
+
+define run-temacs
+ environment-to-run-temacs
run -batch -l ../lisp/loadup.el run-temacs -q
end
end
define update-elc
- unset env EMACSLOADPATH
- set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+ environment-to-run-temacs
run -batch -l ../lisp/update-elc.el
end
end
define dump-temacs
- unset env EMACSLOADPATH
- set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+ environment-to-run-temacs
run -batch -l ../lisp/loadup.el dump
end
Requires a running xemacs process.
end
+
+define leval
+ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
+end
+
+document leval
+Usage: leval "SEXP"
+Eval a lisp expression.
+Requires a running xemacs process.
+
+Example:
+(gdb) leval "(+ 1 2)"
+Lisp ==> 3
+end
+
+
define wtype
print $arg0->core.widget_class->core_class.class_name
end
define pobj
decode_object $arg0
- if $type == dbg_Lisp_Type_Int
+ if $type == Lisp_Type_Int
printf "Integer: %d\n", $val
else
- if $type == dbg_Lisp_Type_Char
- if $val < 128
+ if $type == Lisp_Type_Char
+ if $val > 32 && $val < 128
printf "Char: %c\n", $val
else
printf "Char: %d\n", $val
end
else
- if $type == dbg_Lisp_Type_String || $imp == lrecord_string
+ if $type == Lisp_Type_String || $imp == &lrecord_string
pstruct Lisp_String
else
- if $type == dbg_Lisp_Type_Cons || $imp == lrecord_cons
+ if $type == Lisp_Type_Cons || $imp == &lrecord_cons
pstruct Lisp_Cons
else
- if $type == dbg_Lisp_Type_Symbol || $imp == lrecord_symbol
+ if $type == Lisp_Type_Symbol || $imp == &lrecord_symbol
pstruct Lisp_Symbol
- printf "Symbol name: %s\n", $xstruct->name->_data
+ printf "Symbol name: %s\n", $xstruct->name->data
else
- if $type == dbg_Lisp_Type_Vector || $imp == lrecord_vector
+ if $type == Lisp_Type_Vector || $imp == &lrecord_vector
pstruct Lisp_Vector
printf "Vector of length %d\n", $xstruct->size
- #print *($xstruct->_data) @ $xstruct->size
+ #print *($xstruct->data) @ $xstruct->size
else
- if $imp == lrecord_bit_vector
+ if $imp == &lrecord_bit_vector
pstruct Lisp_Bit_Vector
else
- if $imp == lrecord_buffer
+ if $imp == &lrecord_buffer
pstruct buffer
else
- if $imp == lrecord_char_table
+ if $imp == &lrecord_char_table
pstruct Lisp_Char_Table
else
- if $imp == lrecord_char_table_entry
+ if $imp == &lrecord_char_table_entry
pstruct Lisp_Char_Table_Entry
else
- if $imp == lrecord_charset
+ if $imp == &lrecord_charset
pstruct Lisp_Charset
else
- if $imp == lrecord_coding_system
+ if $imp == &lrecord_coding_system
pstruct Lisp_Coding_System
else
- if $imp == lrecord_color_instance
+ if $imp == &lrecord_color_instance
pstruct Lisp_Color_Instance
else
- if $imp == lrecord_command_builder
+ if $imp == &lrecord_command_builder
pstruct command_builder
else
- if $imp == lrecord_compiled_function
+ if $imp == &lrecord_compiled_function
pstruct Lisp_Compiled_Function
else
- if $imp == lrecord_console
+ if $imp == &lrecord_console
pstruct console
else
- if $imp == lrecord_database
- pstruct database
+ if $imp == &lrecord_database
+ pstruct Lisp_Database
else
- if $imp == lrecord_device
+ if $imp == &lrecord_device
pstruct device
else
- if $imp == lrecord_event
+ if $imp == &lrecord_event
pstruct Lisp_Event
else
- if $imp == lrecord_extent
+ if $imp == &lrecord_extent
pstruct extent
else
- if $imp == lrecord_extent_auxiliary
+ if $imp == &lrecord_extent_auxiliary
pstruct extent_auxiliary
else
- if $imp == lrecord_extent_info
+ if $imp == &lrecord_extent_info
pstruct extent_info
else
- if $imp == lrecord_face
+ if $imp == &lrecord_face
pstruct Lisp_Face
else
- if $imp == lrecord_float
+ if $imp == &lrecord_float
pstruct Lisp_Float
else
- if $imp == lrecord_font_instance
+ if $imp == &lrecord_font_instance
pstruct Lisp_Font_Instance
else
- if $imp == lrecord_frame
+ if $imp == &lrecord_frame
pstruct frame
else
- if $imp == lrecord_glyph
+ if $imp == &lrecord_glyph
pstruct Lisp_Glyph
else
- if $imp == lrecord_hashtable
- pstruct hashtable
+ if $imp == &lrecord_hash_table
+ pstruct Lisp_Hash_Table
else
- if $imp == lrecord_image_instance
+ if $imp == &lrecord_image_instance
pstruct Lisp_Image_Instance
else
- if $imp == lrecord_keymap
- pstruct keymap
+ if $imp == &lrecord_keymap
+ pstruct Lisp_Keymap
else
- if $imp == lrecord_lcrecord_list
+ if $imp == &lrecord_lcrecord_list
pstruct lcrecord_list
else
- if $imp == lrecord_lstream
+ if $imp == &lrecord_lstream
pstruct lstream
else
- if $imp == lrecord_marker
+ if $imp == &lrecord_marker
pstruct Lisp_Marker
else
- if $imp == lrecord_opaque
+ if $imp == &lrecord_opaque
pstruct Lisp_Opaque
else
- if $imp == lrecord_opaque_list
+ if $imp == &lrecord_opaque_list
pstruct Lisp_Opaque_List
else
- if $imp == lrecord_popup_data
+ if $imp == &lrecord_popup_data
pstruct popup_data
else
- if $imp == lrecord_process
+ if $imp == &lrecord_process
pstruct Lisp_Process
else
- if $imp == lrecord_range_table
+ if $imp == &lrecord_range_table
pstruct Lisp_Range_Table
else
- if $imp == lrecord_specifier
+ if $imp == &lrecord_specifier
pstruct Lisp_Specifier
else
- if $imp == lrecord_subr
+ if $imp == &lrecord_subr
pstruct Lisp_Subr
else
- if $imp == lrecord_symbol_value_buffer_local
+ if $imp == &lrecord_symbol_value_buffer_local
pstruct symbol_value_buffer_local
else
- if $imp == lrecord_symbol_value_forward
+ if $imp == &lrecord_symbol_value_forward
pstruct symbol_value_forward
else
- if $imp == lrecord_symbol_value_lisp_magic
+ if $imp == &lrecord_symbol_value_lisp_magic
pstruct symbol_value_lisp_magic
else
- if $imp == lrecord_symbol_value_varalias
+ if $imp == &lrecord_symbol_value_varalias
pstruct symbol_value_varalias
else
- if $imp == lrecord_toolbar_button
+ if $imp == &lrecord_toolbar_button
pstruct toolbar_button
else
- if $imp == lrecord_tooltalk_message
+ if $imp == &lrecord_tooltalk_message
pstruct Lisp_Tooltalk_Message
else
- if $imp == lrecord_tooltalk_pattern
+ if $imp == &lrecord_tooltalk_pattern
pstruct Lisp_Tooltalk_Pattern
else
- if $imp == lrecord_weak_list
+ if $imp == &lrecord_weak_list
pstruct weak_list
else
- if $imp == lrecord_window
+ if $imp == &lrecord_window
pstruct window
else
- if $imp == lrecord_window_configuration
+ if $imp == &lrecord_window_configuration
pstruct window_config
else
echo Unknown Lisp Object type\n
end
end
end
+ # Repeat after me... gdb sux, gdb sux, gdb sux...
end
end
end
end
end
end
+ # Are we having fun yet??
end
end
end
Usage: pobj lisp_object
Print the internal C structure of a underlying Lisp Object.
end
+
+# -------------------------------------------------------------
+# functions to test the debugging support itself.
+# If you change this file, make sure the following still work...
+# -------------------------------------------------------------
+define test_xtype
+ printf "Vemacs_major_version: "
+ xtype Vemacs_major_version
+ printf "Vhelp_char: "
+ xtype Vhelp_char
+ printf "Qnil: "
+ xtype Qnil
+ printf "Qunbound: "
+ xtype Qunbound
+ printf "Vobarray: "
+ xtype Vobarray
+ printf "Vall_weak_lists: "
+ xtype Vall_weak_lists
+ printf "Vxemacs_codename: "
+ xtype Vxemacs_codename
+end
+
+define test_pobj
+ printf "Vemacs_major_version: "
+ pobj Vemacs_major_version
+ printf "Vhelp_char: "
+ pobj Vhelp_char
+ printf "Qnil: "
+ pobj Qnil
+ printf "Qunbound: "
+ pobj Qunbound
+ printf "Vobarray: "
+ pobj Vobarray
+ printf "Vall_weak_lists: "
+ pobj Vall_weak_lists
+ printf "Vxemacs_codename: "
+ pobj Vxemacs_codename
+end
+