diff src/gdbinit @ 337:fbbf69b4e8a7 r21-0-66

Import from CVS: tag r21-0-66
author cvs
date Mon, 13 Aug 2007 10:51:02 +0200
parents e11d67e05968
children 30d2cfa1092a
line wrap: on
line diff
--- a/src/gdbinit	Mon Aug 13 10:50:41 2007 +0200
+++ b/src/gdbinit	Mon Aug 13 10:51:02 2007 +0200
@@ -53,10 +53,10 @@
     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 @@
     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 @@
 
 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 +122,23 @@
   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 +150,7 @@
 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 +162,7 @@
 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 +197,22 @@
 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 +231,27 @@
 
 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
@@ -259,7 +287,7 @@
     pstruct console
   else
   if $imp == lrecord_database
-    pstruct database
+    pstruct Lisp_Database
   else
   if $imp == lrecord_device
     pstruct device
@@ -292,13 +320,13 @@
     pstruct Lisp_Glyph
   else
   if $imp == lrecord_hashtable
-    pstruct hashtable
+    pstruct Lisp_Hash_Table
   else
   if $imp == lrecord_image_instance
     pstruct Lisp_Image_Instance
   else
   if $imp == lrecord_keymap
-    pstruct keymap
+    pstruct Lisp_Keymap
   else
   if $imp == lrecord_lcrecord_list
     pstruct lcrecord_list
@@ -378,6 +406,7 @@
   end
   end
   end
+  # Repeat after me... gdb sux, gdb sux, gdb sux...
   end
   end
   end
@@ -396,6 +425,7 @@
   end
   end
   end
+  # Are we having fun yet??
   end
   end
   end
@@ -419,3 +449,42 @@
 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
+