Mercurial > hg > xemacs-beta
diff src/dbxrc @ 371:cc15677e0335 r21-2b1
Import from CVS: tag r21-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:03:08 +0200 |
parents | fbbf69b4e8a7 |
children | 8626e4521993 |
line wrap: on
line diff
--- a/src/dbxrc Mon Aug 13 11:01:58 2007 +0200 +++ b/src/dbxrc Mon Aug 13 11:03:08 2007 +0200 @@ -23,7 +23,7 @@ # 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: -# if test -r ./dbxrc; then . ./dbxrc; fi +# test -r ./dbxrc && . ./dbxrc # Some functions defined here require a running process, but most # don't. Considerable effort has been expended to this end. @@ -58,23 +58,10 @@ # A bug in dbx prevents string variables from having values beginning with `-'!! function XEmacsInit { - function ToInt { eval "$1=\$[(int) $1]"; } - ToInt dbg_USE_MINIMAL_TAGBITS - ToInt dbg_USE_UNION_TYPE - ToInt dbg_USE_INDEXED_LRECORD_IMPLEMENTATION - 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 + 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"') xemacs_initted=yes + #printvar dbg_valbits dbg_valmask } function printvar { @@ -89,48 +76,31 @@ # Various dbx bugs cause ugliness in following code function decode_object { - 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 + 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=$Lisp_Type_Int + type=$dbg_Lisp_Type_Int else type=$[(int)(((void*)$obj) & $dbg_typemask)] - if test $type = $Lisp_Type_Char; then + 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] - if test "$val" = "(nil)"; then type=null_pointer; fi 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))] - if test "$type" = $Lisp_Type_Int; then - val=$[(int)($obj & $dbg_valmask)] - elif test "$type" = $Lisp_Type_Char; then - val=$[(int)($obj & $dbg_valmask)] - else - val=$[(void*)($obj & $dbg_valmask)] - if test "$val" = "(nil)"; then type=null_pointer; fi - fi - #val=$[(void*)($obj & $dbg_valmask)] - #printvar val type obj fi - if test $type = $Lisp_Type_Record; then + if test $type = $dbg_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])] @@ -140,7 +110,7 @@ else imp="0xdeadbeef" fi - # printvar obj val type imp + #printvar obj val type imp } function xint { @@ -150,28 +120,17 @@ function xtype { decode_object "$*" - 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" + 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" 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. @@ -180,7 +139,8 @@ end function run-temacs { - environment-to-run-temacs + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. run -batch -l ../lisp/loadup.el run-temacs -q } @@ -192,13 +152,15 @@ end function update-elc { - environment-to-run-temacs + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. run -batch -l ../lisp/update-elc.el } function dump-temacs { - environment-to-run-temacs + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. run -batch -l ../lisp/loadup.el dump } @@ -226,22 +188,22 @@ function pobj { decode_object $1 - if test $type = $Lisp_Type_Int; then + if test $type = $dbg_Lisp_Type_Int; then print -f"Integer: %d" $val - elif test $type = $Lisp_Type_Char; then - if test $[$val > 32 && $val < 128] = 1; then + elif test $type = $dbg_Lisp_Type_Char; then + if $val < 128; then print -f"Char: %c" $val else print -f"Char: %d" $val fi - elif test $type = $Lisp_Type_String || lrecord_type_p string; then + elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then pstruct Lisp_String - elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then + elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then pstruct Lisp_Cons - elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then + elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then pstruct Lisp_Symbol echo "Symbol name: $[(char *)($xstruct->name->_data)]" - elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then + elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then pstruct Lisp_Vector echo "Vector of length $[$xstruct->size]" elif lrecord_type_p bit_vector; then @@ -265,7 +227,7 @@ elif lrecord_type_p console; then pstruct console elif lrecord_type_p database; then - pstruct Lisp_Database + pstruct database elif lrecord_type_p device; then pstruct device elif lrecord_type_p event; then @@ -287,11 +249,11 @@ elif lrecord_type_p glyph; then pstruct Lisp_Glyph elif lrecord_type_p hashtable; then - pstruct Lisp_Hash_Table + pstruct hashtable elif lrecord_type_p image_instance; then pstruct Lisp_Image_Instance elif lrecord_type_p keymap; then - pstruct Lisp_Keymap + pstruct keymap elif lrecord_type_p lcrecord_list; then pstruct lcrecord_list elif lrecord_type_p lstream; then @@ -332,8 +294,6 @@ 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 @@ -347,7 +307,6 @@ } 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 @@ -357,27 +316,3 @@ 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 -}