[armedbear-cvs] r12149 - trunk/abcl/src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Fri Sep 18 02:22:41 2009
New Revision: 12149

Log:
Guard against null pointers in LispStackFrame (Tobias Rittweiler).

Explicity create an UnavailableArgument object to fill LispStackFrame
objects which have null args members.



Modified:
   trunk/abcl/src/org/armedbear/lisp/LispObject.java
   trunk/abcl/src/org/armedbear/lisp/LispStackFrame.java

Modified: trunk/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispObject.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/LispObject.java	Fri Sep 18 02:22:41 2009
@@ -632,24 +632,30 @@
     return toString();
   }
 
-  public String unreadableString(String s)
+  public String unreadableString(String s) {
+     return unreadableString(s, true);
+  }
+  public String unreadableString(Symbol sym) throws ConditionThrowable {
+     return unreadableString(sym, true);
+  }
+
+  public String unreadableString(String s, boolean identity)
   {
     FastStringBuffer sb = new FastStringBuffer("#<");
     sb.append(s);
-    sb.append(" {");
-    sb.append(Integer.toHexString(System.identityHashCode(this)).toUpperCase());
-    sb.append("}>");
+    if (identity) {
+      sb.append(" {");
+      sb.append(Integer.toHexString(System.identityHashCode(this)).toUpperCase());
+      sb.append("}");
+    }
+    sb.append(">");
     return sb.toString();
   }
 
-  public String unreadableString(Symbol symbol) throws ConditionThrowable
+  public String unreadableString(Symbol symbol, boolean identity) 
+    throws ConditionThrowable
   {
-    FastStringBuffer sb = new FastStringBuffer("#<");
-    sb.append(symbol.writeToString());
-    sb.append(" {");
-    sb.append(Integer.toHexString(System.identityHashCode(this)).toUpperCase());
-    sb.append("}>");
-    return sb.toString();
+    return unreadableString(symbol.writeToString(), identity);
   }
 
   // Special operator

Modified: trunk/abcl/src/org/armedbear/lisp/LispStackFrame.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispStackFrame.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/LispStackFrame.java	Fri Sep 18 02:22:41 2009
@@ -42,6 +42,17 @@
   private final LispObject third;
   private final LispObject[] args;
 
+  private final class UnavailableArgument extends LispObject 
+  {
+    public UnavailableArgument () { }
+    @Override
+    public String writeToString() { 
+      return unreadableString("unavailable arg", false); 
+    }
+  }
+
+  private final LispObject UNAVAILABLE_ARG = new UnavailableArgument();
+
   public LispStackFrame(LispObject operator)
   {
     this.operator = operator;
@@ -108,8 +119,8 @@
      try {
        result =  unreadableString(LISP_STACK_FRAME + " " 
 				  + toLispString().getStringValue());
-     } catch (ConditionThrowable t) {
-       Debug.trace("Implementation error: ");
+     } catch (Throwable t) {
+       Debug.trace("Serious printing error: ");
        Debug.trace(t);
        result = unreadableString(LISP_STACK_FRAME);
      }
@@ -145,7 +156,15 @@
     LispObject result = Lisp.NIL;
     if (args != null) {
       for (int i = 0; i < args.length; i++)
-	result = result.push(args[i]);
+        // `args' come here from LispThread.execute. I don't know
+        // how it comes that some callers pass NULL ptrs around but
+        // we better do not create conses with their CAR being NULL;
+        // it'll horribly break printing such a cons; and probably
+        // other bad things may happen, too. --TCR, 2009-09-17.
+        if (args[i] == null)
+          result = result.push(UNAVAILABLE_ARG);
+        else
+          result = result.push(args[i]);
     } else {
       do {
 	if (first != null)
@@ -168,7 +187,15 @@
   public SimpleString toLispString() 
     throws ConditionThrowable 
   {
-    return new SimpleString(toLispList().writeToString());
+    String result;
+    try {
+      result = this.toLispList().writeToString();
+    } catch (Throwable t) {
+      Debug.trace("Serious printing error: ");
+      Debug.trace(t);
+      result = unreadableString("LISP-STACK-FRAME");
+    }
+    return new SimpleString(result);
   }
 
   public LispObject getOperator() {