diff src/dbxrc @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents cc15677e0335
children 6719134a07c2
line wrap: on
line diff
--- a/src/dbxrc	Mon Aug 13 11:06:08 2007 +0200
+++ b/src/dbxrc	Mon Aug 13 11:07:10 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:
-# 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.
@@ -76,9 +76,17 @@
 
 # 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 -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 $dbg_USE_MINIMAL_TAGBITS = 1; then
     if test $[(int)($obj & 1)] = 1; then
       # It's an int
@@ -91,13 +99,22 @@
       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]" = 1; then
+      val=$[(int)($obj & $dbg_valmask)]
+    elif test "$[$type == Lisp_Type_Char]" = 1; 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 = $dbg_Lisp_Type_Record; then
@@ -126,6 +143,7 @@
   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"
   else
     echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
   fi
@@ -227,7 +245,7 @@
   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
@@ -248,12 +266,12 @@
     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
@@ -294,6 +312,8 @@
     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
@@ -307,6 +327,7 @@
 }
 
 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