[armedbear-cvs] r12150 - in branches/0.16.x/abcl: . src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Fri Sep 18 02:31:06 2009
New Revision: 12150

Log:
Backport [svn 12149] guard against null LispStackFrames.

Updated CHANGES to list bugs for unreleased 0.16.1.



Modified:
   branches/0.16.x/abcl/CHANGES
   branches/0.16.x/abcl/src/org/armedbear/lisp/LispObject.java
   branches/0.16.x/abcl/src/org/armedbear/lisp/LispStackFrame.java

Modified: branches/0.16.x/abcl/CHANGES
==============================================================================
--- branches/0.16.x/abcl/CHANGES	(original)
+++ branches/0.16.x/abcl/CHANGES	Fri Sep 18 02:31:06 2009
@@ -1,5 +1,14 @@
+Version 0.16.1
+svn://common-lisp.net/project/armedbear/svn/branches/0.16.x/abcl
+(Unreleased)
+
+Bugs fixed:
+
+  * More careful checking for null args in LispStackFrame
+  * Honor appearance of &allow-other-keys in CLOS MAKE-INSTANCE
+
 Version 0.16.0
-(unreleased)
+(06 Sep, 2009)
 
   Summary of changes:
   * Fixed generated wrapper for path names with spaces (Windows)

Modified: branches/0.16.x/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- branches/0.16.x/abcl/src/org/armedbear/lisp/LispObject.java	(original)
+++ branches/0.16.x/abcl/src/org/armedbear/lisp/LispObject.java	Fri Sep 18 02:31:06 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: branches/0.16.x/abcl/src/org/armedbear/lisp/LispStackFrame.java
==============================================================================
--- branches/0.16.x/abcl/src/org/armedbear/lisp/LispStackFrame.java	(original)
+++ branches/0.16.x/abcl/src/org/armedbear/lisp/LispStackFrame.java	Fri Sep 18 02:31:06 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);
      }
@@ -144,8 +155,16 @@
   {
     LispObject result = Lisp.NIL;
     if (args != null) {
-      for (int i = 0; i < args.length; i++)
-	result = result.push(args[i]);
+        for (int i = 0; i < args.length; 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() {