# You can use this file to debug XEmacs using Sun WorkShop's dbx.
# Add the contents of this file to $HOME/.dbxrc or
# Source the contents of this file with something like:
-# test -r ./dbxrc && . ./dbxrc
+# if test -r ./dbxrc; then . ./dbxrc; fi
# Some functions defined here require a running process, but most
# don't. Considerable effort has been expended to this end.
# A bug in dbx prevents string variables from having values beginning with `-'!!
function XEmacsInit {
- eval $(echo $(whatis -t `alloc.c`dbg_constants) | \
- perl -e 'print "@{[map {s/=(-\d+)/sprintf(q[=0x%x],$1)/oge; /\w+=[0-9a-fx]+/og} <>]}\n"')
+ function ToInt { eval "$1=\$[(int) $1]"; }
+ ToInt dbg_USE_UNION_TYPE
+ ToInt Lisp_Type_Int
+ ToInt Lisp_Type_Char
+ ToInt Lisp_Type_Cons
+ ToInt Lisp_Type_String
+ ToInt Lisp_Type_Vector
+ ToInt Lisp_Type_Symbol
+ ToInt Lisp_Type_Record
+ ToInt dbg_valbits
+ ToInt dbg_gctypebits
+ function ToLong { eval "$1=\$[(unsigned long) $1]"; }
+ ToLong dbg_valmask
+ ToLong dbg_typemask
xemacs_initted=yes
- #printvar dbg_valbits dbg_valmask
}
function printvar {
# Various dbx bugs cause ugliness in following code
function decode_object {
- test -z "$xemacs_initted" && XEmacsInit
- obj=$[*(void**)(&$1)]
- test "$obj" = "(nil)" && obj="0x0"
- if test $dbg_USE_MINIMAL_TAGBITS = 1; then
- if test $[(int)($obj & 1)] = 1; then
- # It's an int
- val=$[(long)(((unsigned long long)$obj) >> 1)]
- type=$dbg_Lisp_Type_Int
+ if test -z "$xemacs_initted"; then XEmacsInit; fi;
+ if test $dbg_USE_UNION_TYPE = 1; then
+ # Repeat after me... dbx sux, dbx sux, dbx sux...
+ # Allow both `pobj Qnil' and `pobj 0x82746834' to work
+ case $(whatis $1) in
+ *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
+ *) obj="$[(unsigned long)($1)]";;
+ esac
+ else
+ obj="$[(unsigned long)($1)]";
+ fi
+ if test $[(int)($obj & 1)] = 1; then
+ # It's an int
+ val=$[(long)(((unsigned long long)$obj) >> 1)]
+ type=$Lisp_Type_Int
+ else
+ type=$[(int)(((void*)$obj) & $dbg_typemask)]
+ if test $type = $Lisp_Type_Char; then
+ val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
else
- type=$[(int)(((void*)$obj) & $dbg_typemask)]
- if test $type = $dbg_Lisp_Type_Char; then
- val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
- else
- # It's a record pointer
- val=$[(void*)$obj]
- fi
+ # It's a record pointer
+ val=$[(void*)$obj]
+ if test "$val" = "(nil)"; then type=null_pointer; fi
fi
- else
- # not dbg_USE_MINIMAL_TAGBITS
- val=$[(void*)($obj & $dbg_valmask)]
- test "$val" = "(nil)" && val="0x0"
- type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
fi
- if test $type = $dbg_Lisp_Type_Record; then
+ if test $type = $Lisp_Type_Record; then
typeset lheader="((struct lrecord_header *) $val)"
- if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
- imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
- else
- imp=$[(void*)($lheader->implementation)]
- fi
+ imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
else
imp="0xdeadbeef"
fi
- #printvar obj val type imp
+ # printvar obj val type imp
}
function xint {
function xtype {
decode_object "$*"
- if test $type = $dbg_Lisp_Type_Int; then echo "int"
- elif test $type = $dbg_Lisp_Type_Char; then echo "char"
- elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
- elif test $type = $dbg_Lisp_Type_String; then echo "string"
- elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
- elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
+ if test $type = $Lisp_Type_Int; then echo "int"
+ elif test $type = $Lisp_Type_Char; then echo "char"
+ elif test $type = $Lisp_Type_Symbol; then echo "symbol"
+ elif test $type = $Lisp_Type_String; then echo "string"
+ elif test $type = $Lisp_Type_Vector; then echo "vector"
+ elif test $type = $Lisp_Type_Cons; then echo "cons"
+ elif test $type = null_pointer; then echo "null_pointer"
else
echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
fi
}
+function lisp-shadows {
+ run -batch -vanilla -f list-load-path-shadows
+}
+
+function environment-to-run-temacs {
+ unset EMACSLOADPATH
+ export EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ export EMACSBOOTSTRAPMODULEPATH=../modules/:..
+}
+
document run-temacs << 'end'
Usage: run-temacs
Run temacs interactively, like xemacs.
end
function run-temacs {
- unset EMACSLOADPATH
- export EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ environment-to-run-temacs
run -batch -l ../lisp/loadup.el run-temacs -q
}
end
function update-elc {
- unset EMACSLOADPATH
- export EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ environment-to-run-temacs
run -batch -l ../lisp/update-elc.el
}
function dump-temacs {
- unset EMACSLOADPATH
- export EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ environment-to-run-temacs
run -batch -l ../lisp/loadup.el dump
}
function pobj {
decode_object $1
- if test $type = $dbg_Lisp_Type_Int; then
+ if test $type = $Lisp_Type_Int; then
print -f"Integer: %d" $val
- elif test $type = $dbg_Lisp_Type_Char; then
- if $val < 128; then
+ elif test $type = $Lisp_Type_Char; then
+ if test $[$val > 32 && $val < 128] = 1; then
print -f"Char: %c" $val
else
print -f"Char: %d" $val
fi
- elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
+ elif test $type = $Lisp_Type_String || lrecord_type_p string; then
pstruct Lisp_String
- elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then
+ elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
pstruct Lisp_Cons
- elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
+ elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
pstruct Lisp_Symbol
- echo "Symbol name: $[(char *)($xstruct->name->_data)]"
- elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
+ echo "Symbol name: $[(char *)($xstruct->name->data)]"
+ elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
pstruct Lisp_Vector
echo "Vector of length $[$xstruct->size]"
elif lrecord_type_p bit_vector; then
elif lrecord_type_p console; then
pstruct console
elif lrecord_type_p database; then
- pstruct database
+ pstruct Lisp_Database
elif lrecord_type_p device; then
pstruct device
elif lrecord_type_p event; then
pstruct frame
elif lrecord_type_p glyph; then
pstruct Lisp_Glyph
- elif lrecord_type_p hashtable; then
- pstruct hashtable
+ elif lrecord_type_p hash_table; then
+ pstruct Lisp_Hash_Table
elif lrecord_type_p image_instance; then
pstruct Lisp_Image_Instance
elif lrecord_type_p keymap; then
- pstruct keymap
+ pstruct Lisp_Keymap
elif lrecord_type_p lcrecord_list; then
pstruct lcrecord_list
elif lrecord_type_p lstream; then
pstruct window
elif lrecord_type_p window_configuration; then
pstruct window_config
+ elif test "$type" = "null_pointer"; then
+ echo "Lisp Object is a null pointer!!"
else
echo "Unknown Lisp Object type"
print $1
}
dbxenv suppress_startup_message 4.0
+dbxenv mt_watchpoints on
function dp_core {
print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
function print_shell {
print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
}
+
+# -------------------------------------------------------------
+# functions to test the debugging support itself.
+# If you change this file, make sure the following still work...
+# -------------------------------------------------------------
+function test_xtype {
+ function doit { echo -n "$1: "; xtype "$1"; }
+ test_various_objects
+}
+
+function test_pobj {
+ function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
+ test_various_objects
+}
+
+function test_various_objects {
+ doit Vemacs_major_version
+ doit Vhelp_char
+ doit Qnil
+ doit Qunbound
+ doit Vobarray
+ doit Vall_weak_lists
+ doit Vxemacs_codename
+}
projects / chise / xemacs-chise.git- / blobdiff