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

[Erik Huelsmann]

Author: ehuelsmann
Date: Thu Nov  5 17:45:52 2009
New Revision: 12253

Log:
Make ConditionThrowable abstract: it's the parent of
  non-local ControlTransfer "events", but has no meaning by itself.

Modified:
   trunk/abcl/src/org/armedbear/lisp/ConditionThrowable.java
   trunk/abcl/src/org/armedbear/lisp/Interpreter.java
   trunk/abcl/src/org/armedbear/lisp/Java.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java

Modified: trunk/abcl/src/org/armedbear/lisp/ConditionThrowable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ConditionThrowable.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/ConditionThrowable.java	Thu Nov  5 17:45:52 2009
@@ -33,10 +33,8 @@
 
 package org.armedbear.lisp;
 
-public class ConditionThrowable extends Throwable
+abstract public class ConditionThrowable extends RuntimeException
 {
-    public Condition condition;
-
     public ConditionThrowable()
     {
     }
@@ -50,18 +48,10 @@
 	return this;
     }
 
-    public ConditionThrowable(Condition condition)
-    {
-        this.condition = condition;
-    }
-
     public ConditionThrowable(String message)
     {
         super(message);
     }
 
-    public LispObject getCondition() throws ConditionThrowable
-    {
-        return condition != null ? condition : new Condition();
-    }
+    public abstract LispObject getCondition() throws ConditionThrowable;
 }

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Thu Nov  5 17:45:52 2009
@@ -457,12 +457,25 @@
         System.err.println("Interpreter.finalize");
     }
 
+    public static final class UnhandledCondition extends Error
+    {
+        LispObject condition;
+
+        UnhandledCondition(LispObject condition) {
+            this.condition = condition;
+        }
+
+        public LispObject getCondition() {
+            return condition;
+        }
+    };
+
     private static final Primitive _DEBUGGER_HOOK_FUNCTION =
         new Primitive("%debugger-hook-function", PACKAGE_SYS, false)
     {
         @Override
         public LispObject execute(LispObject first, LispObject second)
-            throws ConditionThrowable
+            throws ConditionThrowable, UnhandledCondition
         {
             final Condition condition = (Condition) first;
             if (interpreter == null) {
@@ -495,8 +508,7 @@
                     thread.lastSpecialBinding = lastSpecialBinding;
                 }
             }
-            // ### FIXME conditionthrowable
-            throw new ConditionThrowable(condition);
+            throw new UnhandledCondition(condition);
         }
     };
 
@@ -512,6 +524,14 @@
     }
 
     // For j.
+    /** Runs its input string through the lisp reader and evaluates the result.
+     *
+     * @param s A string with a valid Common Lisp expression
+     * @return The result of the evaluation
+     * @throws org.armedbear.lisp.ConditionThrowable
+     * @exception UnhandledCondition in case the an error occurs which
+     *      should be passed to the Lisp debugger
+     */
     public static LispObject evaluate(String s) throws ConditionThrowable
     {
         if (!initialized)

Modified: trunk/abcl/src/org/armedbear/lisp/Java.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Java.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Java.java	Thu Nov  5 17:45:52 2009
@@ -761,10 +761,7 @@
 				    return NIL;
 				}
 			} catch (Exception e) {
-				ConditionThrowable t = new ConditionThrowable("Exception reading property");
-				t.initCause(e);
-                // ### FIXME conditionthrowable -> error()
-				throw t;
+                return error(new JavaException(e));
 			}
         }
     };
@@ -794,10 +791,7 @@
 		pd.getWriteMethod().invoke(obj, jValue);
 		return value;
 	    } catch (Exception e) {
-            // ### FIXME conditionthrowable -> error()
-		ConditionThrowable t = new ConditionThrowable("Exception writing property " + propertyName.writeToString() + " in object " + obj + " to " + value.writeToString());
-		t.initCause(e);
-		throw t;
+            return error(new JavaException(e));
 	    }
         }
     };
@@ -810,8 +804,9 @@
         		return pd;
         	}
         }
-        // ### FIXME conditionthrowable -> error()
-		throw new ConditionThrowable("Property " + prop + " not found in " + obj);
+        error(new LispError("Property " + prop + " not found in " + obj));
+
+        return null; // not reached
     }
     
     private static Class classForName(String className) throws ConditionThrowable

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Thu Nov  5 17:45:52 2009
@@ -1490,6 +1490,12 @@
     };
 
   // ### signal
+  /** Placeholder function, to be replaced by the function
+   * defined in signal.lisp
+   *
+   * Calling this function is an error: we're not set up for
+   * signalling yet.
+   */
   private static final Primitive SIGNAL =
     new Primitive(Symbol.SIGNAL, "datum &rest arguments")
     {
@@ -1497,10 +1503,10 @@
       public LispObject execute(LispObject[] args) throws ConditionThrowable
       {
         if (args.length < 1)
-          throw new ConditionThrowable(new WrongNumberOfArgumentsException(this));
+          return error(new WrongNumberOfArgumentsException(this));
         if (args[0] instanceof Condition)
-          throw new ConditionThrowable((Condition)args[0]);
-        throw new ConditionThrowable(new SimpleCondition());
+          return error((Condition)args[0]);
+        return error(new SimpleCondition());
       }
     };
 

Modified: trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/ThreadDestroyed.java	Thu Nov  5 17:45:52 2009
@@ -43,4 +43,10 @@
     {
         super(message);
     }
+
+    @Override
+    public LispObject getCondition() throws ConditionThrowable
+    {
+        return new ControlError("Thread destroyed.");
+    }
 }