From 3382775155d78c879ebb61316fb42ba6cd4ba798 Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 17 May 1999 09:42:32 +0000 Subject: [PATCH] XEmacs 21.2.13 --- src/dbxrc | 104 ++++++++++++++++++++++++++++++++++++++++++----------------- src/gdbinit | 91 ++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 147 insertions(+), 48 deletions(-) diff --git a/src/dbxrc b/src/dbxrc index bb2b78b..a757115 100644 --- a/src/dbxrc +++ b/src/dbxrc @@ -58,10 +58,23 @@ function ldp { # 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_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 xemacs_initted=yes - #printvar dbg_valbits dbg_valmask } function printvar { @@ -91,10 +104,10 @@ function decode_object { if test $[(int)($obj & 1)] = 1; then # It's an int val=$[(long)(((unsigned long long)$obj) >> 1)] - type=$dbg_Lisp_Type_Int + type=$Lisp_Type_Int else type=$[(int)(((void*)$obj) & $dbg_typemask)] - if test $type = $dbg_Lisp_Type_Char; then + if test $type = $Lisp_Type_Char; then val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] else # It's a record pointer @@ -105,9 +118,9 @@ function decode_object { else # not dbg_USE_MINIMAL_TAGBITS type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))] - if test "$[$type == Lisp_Type_Int]" = 1; then + if test "$type" = $Lisp_Type_Int; then val=$[(int)($obj & $dbg_valmask)] - elif test "$[$type == Lisp_Type_Char]" = 1; then + elif test "$type" = $Lisp_Type_Char; then val=$[(int)($obj & $dbg_valmask)] else val=$[(void*)($obj & $dbg_valmask)] @@ -117,7 +130,7 @@ function decode_object { #printvar val type obj 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])] @@ -127,7 +140,7 @@ function decode_object { else imp="0xdeadbeef" fi - #printvar obj val type imp + # printvar obj val type imp } function xint { @@ -137,18 +150,28 @@ 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" - elif test $type = null_pointer; then echo "$type" + 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. @@ -157,8 +180,7 @@ or when temacs builds successfully, but xemacs does not. end function run-temacs { - unset EMACSLOADPATH - export EMACSBOOTSTRAPLOADPATH=../lisp/:.. + environment-to-run-temacs run -batch -l ../lisp/loadup.el run-temacs -q } @@ -170,15 +192,13 @@ Use this when temacs builds successfully, but xemacs does not. 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 } @@ -206,22 +226,22 @@ end 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 @@ -337,3 +357,27 @@ function dp_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 +} diff --git a/src/gdbinit b/src/gdbinit index 60cadae..0259597 100644 --- a/src/gdbinit +++ b/src/gdbinit @@ -53,10 +53,10 @@ define decode_object if $obj & 1 # It's an int set $val = $obj >> 1 - set $type = dbg_Lisp_Type_Int + set $type = Lisp_Type_Int else set $type = $obj & dbg_typemask - if $type == dbg_Lisp_Type_Char + if $type == Lisp_Type_Char set $val = ($obj & dbg_valmask) >> dbg_gctypebits else # It's a record pointer @@ -69,7 +69,7 @@ define decode_object 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] @@ -94,22 +94,22 @@ 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 @@ -133,8 +133,8 @@ end define environment-to-run-temacs unset env EMACSLOADPATH - set env EMACSBOOTSTRAPLOADPATH = ../lisp/:.. - set env EMACSBOOTSTRAPMODULEPATH = ../lisp/ + set env EMACSBOOTSTRAPLOADPATH=../lisp/:.. + set env EMACSBOOTSTRAPMODULEPATH=../modules/:.. end define run-temacs @@ -197,6 +197,22 @@ Print the current Lisp stack trace. 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 @@ -215,27 +231,27 @@ 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 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 @@ -433,3 +449,42 @@ document pobj 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 + -- 1.7.10.4