X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fgdbinit;h=f9a8c7e7a0ddcb3890c55c5550dde556f250d744;hb=f9fdf5a6cb58286f64f6f8bd0bfd2dab9b9b8816;hp=56cc68220852af87761578582882daa71d7280c2;hpb=4c0c5d1d054e60fb9ffa3dd9ec1c1d7bb8eedef0;p=chise%2Fxemacs-chise.git

diff --git a/src/gdbinit b/src/gdbinit
index 56cc682..f9a8c7e 100644
--- a/src/gdbinit
+++ b/src/gdbinit
@@ -32,9 +32,6 @@
 # specified:
 
 # USE_UNION_TYPE
-# USE_MINIMAL_TAGBITS
-# USE_INDEXED_LRECORD_IMPLEMENTATION
-# LRECORD_(SYMBOL|STRING|VECTOR)
 
 # (the above all have configure equivalents)
 
@@ -49,33 +46,23 @@ set print pretty off
 
 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
@@ -94,22 +81,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
@@ -122,9 +109,23 @@ define xtype
   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
 
@@ -136,8 +137,7 @@ or when temacs builds successfully, but xemacs does not.
 end
 
 define update-elc
-  unset env EMACSLOADPATH
-  set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+  environment-to-run-temacs
   run -batch -l ../lisp/update-elc.el
 end
 
@@ -149,8 +149,7 @@ Use this when temacs builds successfully, but xemacs does not.
 end
 
 define dump-temacs
-  unset env EMACSLOADPATH
-  set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+  environment-to-run-temacs
   run -batch -l ../lisp/loadup.el dump
 end
 
@@ -185,6 +184,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
@@ -203,27 +218,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
@@ -421,3 +436,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
+