Changeset 12834

Timestamp:

07/29/10 19:38:25 (13 years ago)

Author:

ehuelsmann

Message:

Backport r12805-12833 from trunk.

Location:

branches/generic-class-file/abcl

Files:

• CHANGES (modified) (1 diff)
• build.xml (modified) (1 diff)
• src/org/armedbear/lisp/Condition.java (modified) (2 diffs)
• src/org/armedbear/lisp/DocString.java (copied) (copied from trunk/abcl/src/org/armedbear/lisp/DocString.java)
• src/org/armedbear/lisp/ForwardReferencedClass.java (modified) (1 diff)
• src/org/armedbear/lisp/Function.java (modified) (3 diffs)
• src/org/armedbear/lisp/Java.java (modified) (28 diffs)
• src/org/armedbear/lisp/JavaObject.java (modified) (1 diff)
• src/org/armedbear/lisp/Lisp.java (modified) (2 diffs)
• src/org/armedbear/lisp/LispObject.java (modified) (1 diff)
• src/org/armedbear/lisp/LispThread.java (modified) (17 diffs)
• src/org/armedbear/lisp/Operator.java (modified) (1 diff)
• src/org/armedbear/lisp/Pathname.java (modified) (2 diffs)
• src/org/armedbear/lisp/Primitive.java (modified) (1 diff)
• src/org/armedbear/lisp/Primitives.java (modified) (1 diff)
• src/org/armedbear/lisp/Stream.java (modified) (1 diff)
• src/org/armedbear/lisp/Version.java (modified) (1 diff)
• src/org/armedbear/lisp/asdf.lisp (modified) (9 diffs)
• src/org/armedbear/lisp/autoloads.lisp (modified) (2 diffs)
• src/org/armedbear/lisp/compile-system.lisp (modified) (1 diff)
• src/org/armedbear/lisp/debug.lisp (modified) (1 diff)
• src/org/armedbear/lisp/java-collections.lisp (copied) (copied from trunk/abcl/src/org/armedbear/lisp/java-collections.lisp)
• src/org/armedbear/lisp/java.lisp (modified) (3 diffs)
• src/org/armedbear/lisp/logorc2.java (modified) (1 diff)
• src/org/armedbear/lisp/package_error_package.java (modified) (1 diff)
• src/org/armedbear/lisp/print.lisp (modified) (1 diff)
• src/org/armedbear/lisp/threads.lisp (modified) (2 diffs)
• test/lisp/ansi/package.lisp (modified) (1 diff)
• test/lisp/ansi/parse-ansi-errors.lisp (modified) (1 diff)

branches/generic-class-file/abcl/CHANGES

@@ +1 @@
+Version 0.21
+============
+svn://common-lisp.net/project/armedbear/svn/tags/0.21.0/abcl
+(???, 2010)
+
+
+Features
+--------
+
+* [svn r12818] Update to ASDF 2.004
+
+* [svn r12738-805] Support for custom CLOS slot definitions and custom class options.
+
+* [svn r12756] slot-* functions work on structures too.
+
+* [svn r12774] Improved Java integration: jmake-proxy can implement more than one interface.
+
+* [svn r12773] Improved Java integration: functions to dynamically manipulate the classpath.
+
+* [svn r12755] Improved Java integration: CL:STRING can convert Java strings to Lisp strings.
+
+Fixes
+-----
+
+* [svn 12809-10-20] Various printing fixes.
+
+* [svn 12804] Fixed elimination of unused local functions shadowed by macrolet.
+
+* [svn r12798-803] Fixed pathname serialization across OSes. On Windows pathnames are always printed with forward slashes, but can still be read with backslashes.
+
+* [svn r12740] Make JSR-223 classes compilable with Java 1.5
+
+Other
+-----
+
+* [svn r12754] Changed class file generation and FASL loading to minimize reflection.
+
+* [svn r12734] A minimal Swing GUI Console with a REPL is now included with ABCL.
+
 Version 0.20
 ============
-yet-to-be-tagged
-(???)
+svn://common-lisp.net/project/armedbear/svn/tags/0.20.0/abcl
+(24 May, 2010)
 
 

branches/generic-class-file/abcl/build.xml

@@ -446 +446 @@
 
     <target name="TAGS">
-      <apply executable="etags" parallel="true" verbose="true">
+      <delete file="TAGS"/>
+      <apply executable="etags" parallel="true" verbose="true" maxparallel="300">
+        <arg value="--append"/>
   <arg value="--regex=|[ \t]+//[ \t]+###[ \t]+\([^ \t]+\)|\1|"/>
+  <arg value='--regex=|[ \t]*@DocString([ \t]*name=\"\([^\"]*\)|\1|'/>
   <fileset dir="${src.dir}">
     <patternset refid="abcl.source.java"/>

branches/generic-class-file/abcl/src/org/armedbear/lisp/Condition.java

@@ -105 +105 @@
   public final LispObject getFormatControl()
   {
-    return getInstanceSlotValue(Symbol.FORMAT_CONTROL);
+      return getInstanceSlotValue(Symbol.FORMAT_CONTROL);
   }
 
@@ -136 +136 @@
   public String getMessage()
   {
-    return getFormatControl().toString();
+      LispObject formatControl = getFormatControl();
+      return formatControl != UNBOUND_VALUE ? formatControl.writeToString() : null;
   }
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java

@@ -77 +77 @@
     }
 
-    // ### make-forward-referenced-class
+    @DocString(name="make-forward-referenced=class")
     private static final Primitive MAKE_FORWARD_REFERENCED_CLASS =
         new Primitive("make-forward-referenced-class", PACKAGE_SYS, true)

branches/generic-class-file/abcl/src/org/armedbear/lisp/Function.java

@@ -54 +54 @@
     public Function(String name)
     {
-  this();
+        this(name, (String)null);
+    }
+
+    public Function(String name, String arglist)
+    {
+  this();
+        if(arglist != null)
+            setLambdaList(new SimpleString(arglist));
         if (name != null) {
             Symbol symbol = Symbol.addFunction(name.toUpperCase(), this);
@@ -63 +70 @@
     }
 
+    public Function(Symbol symbol)
+    {
+  this(symbol, null, null);
+    }
+
     public Function(Symbol symbol, String arglist)
+    {
+  this(symbol, arglist, null);
+    }
+
+    public Function(Symbol symbol, String arglist, String docstring)
     {
   this();
@@ -70 +87 @@
             symbol.setBuiltInFunction(true);
         setLambdaName(symbol);
-        setLambdaList(new SimpleString(arglist));
-    }
-
-    public Function(Symbol symbol, String arglist, String docstring)
-    {
-  this();
-        symbol.setSymbolFunction(this);
-        if (cold)
-            symbol.setBuiltInFunction(true);
-        setLambdaName(symbol);
-        setLambdaList(new SimpleString(arglist));
-        if (docstring != null) {
+        if(arglist != null)
+            setLambdaList(new SimpleString(arglist));
+        if (docstring != null)
             symbol.setDocumentation(Symbol.FUNCTION,
                                     new SimpleString(docstring));
-        }
-    }
-
-    public Function(String name, String arglist)
-    {
-        this(name);
-        setLambdaList(new SimpleString(arglist));
     }
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/Java.java

@@ -61 +61 @@
 
     private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
+    @DocString(name="ensure-java-object", args="obj",
+    doc="Ensures OBJ is wrapped in a JAVA-OBJECT, wrapping it if necessary.")
     private static final class pf_ensure_java_object extends Primitive 
     {
         pf_ensure_java_object() 
         {
-            super("ensure-java-object", PACKAGE_JAVA, true, "obj");
+            super("ensure-java-object", PACKAGE_JAVA, true);
         }
 
@@ -74 +76 @@
     };
 
-    // ### register-java-exception exception-name condition-symbol => T
     private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
+    @DocString(name="register-java-exception", // => T
+    args="exception-name condition-symbol",
+    doc="Registers the Java Throwable named by the symbol EXCEPTION-NAME as the condition " +
+        "designated by CONDITION-SYMBOL.  Returns T if successful, NIL if not.")
     private static final class pf_register_java_exception extends Primitive 
     {
         pf_register_java_exception() 
         {
-            super("register-java-exception", PACKAGE_JAVA, true,
-                  "exception-name condition-symbol");
+            super("register-java-exception", PACKAGE_JAVA, true);
         }
 
@@ -99 +103 @@
     };
 
-    // ### unregister-java-exception exception-name => T or NIL
     private static final Primitive UNREGISTER_JAVA_EXCEPTION = new pf_unregister_java_exception();
+    @DocString(name="unregister-java-exception", args="exception-name",
+    doc="Unregisters the Java Throwable EXCEPTION-NAME previously registered" +
+        " by REGISTER-JAVA-EXCEPTION.")
     private static final class pf_unregister_java_exception extends Primitive
     {
         pf_unregister_java_exception() 
         {
-            super("unregister-java-exception", PACKAGE_JAVA, true,
-                  "exception-name");
+            super("unregister-java-exception", PACKAGE_JAVA, true);
         }
 
@@ -130 +135 @@
     }
 
-    // ### jclass name-or-class-ref &optional class-loader => class-ref
     private static final Primitive JCLASS = new pf_jclass();
+    @DocString(name="jclass", args="name-or-class-ref &optional class-loader",
+    doc="Returns a reference to the Java class designated by" +
+        " NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the" +
+        " class is resolved with respect to the given ClassLoader.")
     private static final class pf_jclass extends Primitive 
     {
@@ -137 +145 @@
         pf_jclass() 
         {
-            super(Symbol.JCLASS, "name-or-class-ref &optional class-loader",
-                  "Returns a reference to the Java class designated by NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the class is resolved with respect to the given ClassLoader.");
+            super(Symbol.JCLASS);
         }
 
@@ -154 +161 @@
         }
     };
-
-    // ### jfield - retrieve or modify a field in a Java class or instance.
-    //
-    // Supported argument patterns:
-    //
-    //   Case 1: class-ref  field-name:
-    //               to retrieve the value of a static field.
-    //
-    //   Case 2: class-ref  field-name  instance-ref:
-    //               to retrieve the value of a class field of the instance.
-    //
-    //   Case 3: class-ref  field-name  primitive-value:
-    //               to store primitive-value in a static field.
-    //
-    //   Case 4: class-ref  field-name  instance-ref  value:
-    //               to store value in a class field of the instance.
-    //
-    //   Case 5: class-ref  field-name  nil  value:
-    //               to store value in a static field (when value may be
-    //               confused with an instance-ref).
-    //
-    //   Case 6: field-name  instance:
-    //               to retrieve the value of a field of the instance. The
-    //               class is derived from the instance.
-    //
-    //   Case 7: field-name  instance  value:
-    //               to store value in a field of the instance. The class is
-    //               derived from the instance.
-    //
 
     static final LispObject jfield(Primitive fun, LispObject[] args, boolean translate)
@@ -259 +237 @@
     }
 
-    // ### jfield class-ref-or-field field-or-instance &optional instance value
+
     private static final Primitive JFIELD = new pf_jfield();
+    @DocString(name="jfield",
+    args="class-ref-or-field field-or-instance &optional instance value",
+    doc="Retrieves or modifies a field in a Java class or instance.\n\n"+
+        "Supported argument patterns:\n\n"+
+        "   Case 1: class-ref  field-name:\n"+
+        "      Retrieves the value of a static field.\n\n"+
+        "   Case 2: class-ref  field-name  instance-ref:\n"+
+        "      Retrieves the value of a class field of the instance.\n\n"+
+        "   Case 3: class-ref  field-name  primitive-value:\n"+
+        "      Stores a primitive-value in a static field.\n\n"+
+        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
+        "      Stores value in a class field of the instance.\n\n"+
+        "   Case 5: class-ref  field-name  nil  value:\n"+
+        "      Stores value in a static field (when value may be\n"+
+        "      confused with an instance-ref).\n\n"+
+        "   Case 6: field-name  instance:\n"+
+        "      Retrieves the value of a field of the instance. The\n"+
+        "      class is derived from the instance.\n\n"+
+        "   Case 7: field-name  instance  value:\n"+
+        "      Stores value in a field of the instance. The class is\n"+
+        "      derived from the instance.\n\n"
+        )
     private static final class pf_jfield extends Primitive 
     {
         pf_jfield() 
         {
-            super("jfield", PACKAGE_JAVA, true,
-                  "class-ref-or-field field-or-instance &optional instance value");
+            super("jfield", PACKAGE_JAVA, true);
         }
 
@@ -276 +275 @@
     };
 
-    // ### jfield-raw - retrieve or modify a field in a Java class or instance.
     private static final Primitive JFIELD_RAW = new pf_jfield_raw();
+    @DocString(name="jfield",
+    args="class-ref-or-field field-or-instance &optional instance value",
+    doc="Retrieves or modifies a field in a Java class or instance. Does not\n"+
+        "attempt to coerce its value or the result into a Lisp object.\n\n"+
+        "Supported argument patterns:\n\n"+
+        "   Case 1: class-ref  field-name:\n"+
+        "      Retrieves the value of a static field.\n\n"+
+        "   Case 2: class-ref  field-name  instance-ref:\n"+
+        "      Retrieves the value of a class field of the instance.\n\n"+
+        "   Case 3: class-ref  field-name  primitive-value:\n"+
+        "      Stores a primitive-value in a static field.\n\n"+
+        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
+        "      Stores value in a class field of the instance.\n\n"+
+        "   Case 5: class-ref  field-name  nil  value:\n"+
+        "      Stores value in a static field (when value may be\n"+
+        "      confused with an instance-ref).\n\n"+
+        "   Case 6: field-name  instance:\n"+
+        "      Retrieves the value of a field of the instance. The\n"+
+        "      class is derived from the instance.\n\n"+
+        "   Case 7: field-name  instance  value:\n"+
+        "      Stores value in a field of the instance. The class is\n"+
+        "      derived from the instance.\n\n"
+        )
     private static final class pf_jfield_raw extends Primitive
     {
         pf_jfield_raw() 
         {
-            super("jfield-raw", PACKAGE_JAVA, true,
-                  "class-ref-or-field field-or-instance &optional instance value");
+            super("jfield-raw", PACKAGE_JAVA, true);
         }
 
@@ -293 +313 @@
     };
 
-    // ### jconstructor class-ref &rest parameter-class-refs
     private static final Primitive JCONSTRUCTOR = new pf_jconstructor();
+    @DocString(name="jconstructor", args="class-ref &rest parameter-class-refs",
+    doc="Returns a reference to the Java constructor of CLASS-REF with the" +
+        " given PARAMETER-CLASS-REFS.")
     private static final class pf_jconstructor extends Primitive
     {
         pf_jconstructor() 
         {
-            super("jconstructor", PACKAGE_JAVA, true,
-                  "class-ref &rest parameter-class-refs");
+            super("jconstructor", PACKAGE_JAVA, true);
         }
 
@@ -343 +364 @@
     };
 
-    // ### jmethod class-ref name &rest parameter-class-refs
     private static final Primitive JMETHOD = new pf_jmethod();
+
+    @DocString(name="jmethod", args="class-ref method-name &rest parameter-class-refs",
+    doc="Returns a reference to the Java method METHOD-NAME of CLASS-REF with the" +
+        " given PARAMETER-CLASS-REFS.")
     private static final class pf_jmethod extends Primitive 
     {
         pf_jmethod() 
         {
-            super("jmethod", PACKAGE_JAVA, true,
-                  "class-ref name &rest parameter-class-refs");
+            super("jmethod", PACKAGE_JAVA, true);
         }
 
@@ -471 +494 @@
     }
 
-    // ### jstatic method class &rest args
     private static final Primitive JSTATIC = new pf_jstatic();
+    @DocString(name="jstatic", args="method class &rest args",
+    doc="Invokes the static method METHOD on class CLASS with ARGS.")
     private static final class pf_jstatic extends Primitive 
     {
         pf_jstatic() 
         {
-            super("jstatic", PACKAGE_JAVA, true, "method class &rest args");
+            super("jstatic", PACKAGE_JAVA, true);
         }
 
@@ -487 +511 @@
     };
 
-    // ### jstatic-raw method class &rest args
     private static final Primitive JSTATIC_RAW = new pf_jstatic_raw();
+    @DocString(name="jstatic-raw", args="method class &rest args",
+    doc="Invokes the static method METHOD on class CLASS with ARGS. Does not "+
+        "attempt to coerce the arguments or result into a Lisp object.")
     private static final class pf_jstatic_raw extends Primitive
     {
         pf_jstatic_raw() 
         {
-            super("jstatic-raw", PACKAGE_JAVA, true,
-                  "method class &rest args");
+            super("jstatic-raw", PACKAGE_JAVA, true);
         }
 
@@ -504 +529 @@
     };
 
-    // ### jnew constructor &rest args
     private static final Primitive JNEW = new pf_jnew();
+    @DocString(name="jnew", args="constructor &rest args",
+    doc="Invokes the Java constructor CONSTRUCTOR with the arguments ARGS.")
     private static final class pf_jnew extends Primitive
     {
         pf_jnew()
         {
-            super("jnew", PACKAGE_JAVA, true, "constructor &rest args");
+            super("jnew", PACKAGE_JAVA, true);
         }
 
@@ -524 +550 @@
         constructor = findConstructor(javaClass(classRef), args);
     } else {
-        constructor = (Constructor) JavaObject.getObject(classRef);
+        Object object = JavaObject.getObject(classRef);
+        if(object instanceof Constructor) {
+      constructor = (Constructor) object;
+        } else if(object instanceof Class<?>) {
+      constructor = findConstructor((Class<?>) object, args);
+        } else {
+      return error(new LispError(classRef.writeToString() + " is neither a Constructor nor a Class"));
+        }
     }
                 Class[] argTypes = constructor.getParameterTypes();
@@ -560 +593 @@
     };
 
-    // ### jnew-array element-type &rest dimensions
     private static final Primitive JNEW_ARRAY = new pf_jnew_array();
+    @DocString(name="jnew-array", args="element-type &rest dimensions",
+    doc="Creates a new Java array of type ELEMENT-TYPE, with the given" +
+        " DIMENSIONS.")
     private static final class pf_jnew_array extends Primitive
     {
         pf_jnew_array()
         {
-            super("jnew-array", PACKAGE_JAVA, true,
-                  "element-type &rest dimensions");
+            super("jnew-array", PACKAGE_JAVA, true);
         }
 
@@ -618 +652 @@
     }
 
-    // ### jarray-ref java-array &rest indices
     private static final Primitive JARRAY_REF = new pf_jarray_ref();
+    @DocString(name="jarray-ref", args="java-array &rest indices",
+    doc="Dereferences the Java array JAVA-ARRAY using the given INDICIES, " +
+        "coercing the result into a Lisp object, if possible.")
     private static final class pf_jarray_ref extends Primitive
     {
         pf_jarray_ref()
         {
-            super("jarray-ref", PACKAGE_JAVA, true,
-                  "java-array &rest indices");
+            super("jarray-ref", PACKAGE_JAVA, true);
         }
 
@@ -635 +670 @@
     };
 
-    // ### jarray-ref-raw java-array &rest indices
     private static final Primitive JARRAY_REF_RAW = new pf_jarray_ref_raw();
+    @DocString(name="jarray-ref-raw", args="java-array &rest indices",
+    doc="Dereference the Java array JAVA-ARRAY using the given INDICIES. " +
+        "Does not attempt to coerce the result into a Lisp object.")
     private static final class pf_jarray_ref_raw extends Primitive
     {
         pf_jarray_ref_raw() 
         {
-            super("jarray-ref-raw", PACKAGE_JAVA, true,
-                  "java-array &rest indices");
+            super("jarray-ref-raw", PACKAGE_JAVA, true);
         }
 
@@ -652 +688 @@
     };
 
-    // ### jarray-set java-array new-value &rest indices
     private static final Primitive JARRAY_SET = new pf_jarray_set();
+    @DocString(name="jarray-set", args="java-array new-value &rest indices",
+    doc="Stores NEW-VALUE at the given index in JAVA-ARRAY.")
     private static final class pf_jarray_set extends Primitive
     {
         pf_jarray_set()
         {
-            super("jarray-set", PACKAGE_JAVA, true,
-                  "java-array new-value &rest indices");
+            super("jarray-set", PACKAGE_JAVA, true);
         }
 
@@ -692 +728 @@
     };
 
-    // ### jcall method instance &rest args
     /**  Calls makeLispObject() to convert the result to an appropriate Lisp type. */
     private static final Primitive JCALL = new pf_jcall();
+    @DocString(name="jcall", args="method-ref instance &rest args",
+    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS," +
+        " coercing the result into a Lisp object, if possible.")
     private static final class pf_jcall extends Primitive
     {
         pf_jcall()
         {
-            super(Symbol.JCALL, "method-ref instance &rest args");
+            super(Symbol.JCALL);
         }
 
@@ -709 +747 @@
     };
 
-    // ### jcall-raw method instance &rest args
     /** 
      * Does no type conversion. The result of the call is simply wrapped in a
@@ -715 +752 @@
      */
     private static final Primitive JCALL_RAW = new pf_jcall_raw();
+    @DocString(name="jcall-raw", args="method-ref instance &rest args",
+    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS." +
+        " Does not attempt to coerce the result into a Lisp object.")
     private static final class pf_jcall_raw extends Primitive
     {
         pf_jcall_raw()
         {
-            super(Symbol.JCALL_RAW, "method-ref instance &rest args");
+            super(Symbol.JCALL_RAW);
         }
 
@@ -977 +1017 @@
     }
 
-    // ### make-immediate-object object &optional type
     private static final Primitive MAKE_IMMEDIATE_OBJECT = new pf_make_immediate_object();
+    @DocString(name="make-immediate-object", args="object &optional type",
+    doc="Attempts to coerce a given Lisp object into a java-object of the\n"+
+        "given type.  If type is not provided, works as jobject-lisp-value.\n"+
+        "Currently, type may be :BOOLEAN, treating the object as a truth value,\n"+
+        "or :REF, which returns Java null if NIL is provided.")
     private static final class pf_make_immediate_object extends Primitive
     {
         pf_make_immediate_object()
         {
-            super("make-immediate-object", PACKAGE_JAVA, true,
-                  "object &optional type");
+            super("make-immediate-object", PACKAGE_JAVA, true);
         }
 
@@ -1013 +1056 @@
     };
 
-    // ### java-object-p
     private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
+    @DocString(name="java-object-p", args="object",
+    doc="Returns T if OBJECT is a JAVA-OBJECT.")
     private static final class pf_java_object_p extends Primitive
     {
         pf_java_object_p() 
         {
-            super("java-object-p", PACKAGE_JAVA, true, "object");
+            super("java-object-p", PACKAGE_JAVA, true);
         }
 
@@ -1029 +1073 @@
     };
 
-    // ### jobject-lisp-value java-object
     private static final Primitive JOBJECT_LISP_VALUE = new pf_jobject_lisp_value();
+    @DocString(name="jobject-lisp-value", args="java-object",
+    doc="Attempts to coerce JAVA-OBJECT into a Lisp object.")
     private static final class pf_jobject_lisp_value extends Primitive
     {
@@ -1045 +1090 @@
     };
 
-    // ### jcoerce java-object intended-class
     private static final Primitive JCOERCE = new pf_jcoerce();
+    @DocString(name="jcoerce", args="object intended-class",
+    doc="Attempts to coerce OBJECT into a JavaObject of class INTENDED-CLASS." +
+        "  Raises a TYPE-ERROR if no conversion is possible.")
     private static final class pf_jcoerce extends Primitive
     {
         pf_jcoerce()
         {
-            super("jcoerce", PACKAGE_JAVA, true, "java-object intended-class");
+            super("jcoerce", PACKAGE_JAVA, true);
         }
 
@@ -1067 +1114 @@
     };
 
-    // ### %jget-property-value java-object property-name
     private static final Primitive JGET_PROPERTY_VALUE = new pf__jget_property_value();
+    @DocString(name="%jget-propety-value", args="java-object property-name",
+    doc="Gets a JavaBeans property on JAVA-OBJECT.\n" +
+        "SYSTEM-INTERNAL: Use jproperty-value instead.")
     private static final class pf__jget_property_value extends Primitive
     {
@@ -1096 +1145 @@
     };
     
-    // ### %jset-property-value java-object property-name value 
     private static final Primitive JSET_PROPERTY_VALUE = new pf__jset_property_value();
+    @DocString(name="%jset-propety-value", args="java-object property-name value",
+    doc="Sets a JavaBean property on JAVA-OBJECT.\n" +
+        "SYSTEM-INTERNAL: Use (setf jproperty-value) instead.")
     private static final class pf__jset_property_value extends Primitive
     {
@@ -1132 +1183 @@
     };
 
-
-    // ### jrun-exception-protected closure
     private static final Primitive JRUN_EXCEPTION_PROTECTED = new pf_jrun_exception_protection();
+    @DocString(name="jrun-exception-protected", args="closure",
+    doc="Invokes the function CLOSURE and returns the result.  "+
+        "Signals an error if stack or heap exhaustion occurs.")
     private static final class pf_jrun_exception_protection extends Primitive
     {
         pf_jrun_exception_protection()
         {
-            super("jrun-exception-protected", PACKAGE_JAVA, true,
-                  "closure");
+            super("jrun-exception-protected", PACKAGE_JAVA, true);
         }
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/JavaObject.java

@@ -98 +98 @@
         if (type == BuiltInClass.JAVA_OBJECT)
             return T;
-  if(type.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
+  LispObject cls = NIL;
+  if(type instanceof Symbol) {
+      cls = LispClass.findClass(type, false);
+  }
+  if(cls == NIL) {
+      cls = type;
+  }
+  if(cls.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
       if(obj != null) {
-    Class c = (Class) JAVA_CLASS_JCLASS.execute(type).javaInstance();
+    Class c = (Class) JAVA_CLASS_JCLASS.execute(cls).javaInstance();
     return c.isAssignableFrom(obj.getClass()) ? T : NIL;
       } else {
     return T;
       }
+  } else if(cls == BuiltInClass.SEQUENCE) {
+      //This information is replicated here from java.lisp; it is a very
+      //specific case, not worth implementing CPL traversal in typep
+      if(java.util.List.class.isInstance(obj) ||
+         java.util.Set.class.isInstance(obj)) {
+    return T;
+      }
   }
         return super.typep(type);
     }
-
 
     @Override

branches/generic-class-file/abcl/src/org/armedbear/lisp/Lisp.java

@@ -90 +90 @@
 
 
-  // ### nil
+  @DocString(name="nil")
   public static final LispObject NIL = Nil.NIL;
 
@@ -262 +262 @@
   }
 
-  // ### interactive-eval
+  @DocString(name="interactive-eval")
   private static final Primitive INTERACTIVE_EVAL =
     new Primitive("interactive-eval", PACKAGE_SYS, true)

branches/generic-class-file/abcl/src/org/armedbear/lisp/LispObject.java

@@ -658 +658 @@
           return ((Cons)entry).cdr;
       }
+    if(docType == Symbol.FUNCTION && this instanceof Symbol) {
+        Object fn = ((Symbol)this).getSymbolFunction();
+        if(fn instanceof Function) {
+            DocString ds = fn.getClass().getAnnotation(DocString.class);
+            if(ds != null) {
+                String arglist = ds.args();
+                String docstring = ds.doc();
+                if(arglist.length() != 0)
+                    ((Function)fn).setLambdaList(new SimpleString(arglist));
+                if(docstring.length() != 0) {
+                    SimpleString doc = new SimpleString(docstring);
+                    ((Symbol)this).setDocumentation(Symbol.FUNCTION, doc);
+                    return doc;
+                }
+            }
+        }
+    }
     return NIL;
   }

branches/generic-class-file/abcl/src/org/armedbear/lisp/LispThread.java

@@ -861 +861 @@
     }
 
-    // ### make-thread
+    @DocString(name="make-thread", args="function &optional &key name")
     private static final Primitive MAKE_THREAD =
         new Primitive("make-thread", PACKAGE_THREADS, true, "function &optional &key name")
@@ -887 +887 @@
     };
 
-    // ### threadp
+    @DocString(name="threadp", args="object",
+    doc="Boolean predicate testing if OBJECT is a thread.")
     private static final Primitive THREADP =
-        new Primitive("threadp", PACKAGE_THREADS, true, "object",
-          "Boolean predicate as whether OBJECT is a thread.")
+        new Primitive("threadp", PACKAGE_THREADS, true)
     {
         @Override
@@ -899 +899 @@
     };
 
-    // ### thread-alive-p
+    @DocString(name="thread-alive-p", args="thread",
+    doc="Returns T if THREAD is alive.")
     private static final Primitive THREAD_ALIVE_P =
         new Primitive("thread-alive-p", PACKAGE_THREADS, true, "thread",
@@ -918 +919 @@
     };
 
-    // ### thread-name
+    @DocString(name="thread-name", args="thread",
+    doc="Return the name of THREAD, if it has one.")
     private static final Primitive THREAD_NAME =
-        new Primitive("thread-name", PACKAGE_THREADS, true, "thread",
-          "Return the name of THREAD if it has one.")
+        new Primitive("thread-name", PACKAGE_THREADS, true)
     {
         @Override
@@ -973 +974 @@
     }
 
-    // ### sleep
-    private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true, "seconds",
-               "Causes the invoking thread to sleep for SECONDS seconds.\nSECONDS may be a value between 0 1and 1.")
+    @DocString(name="sleep", args="seconds",
+    doc="Causes the invoking thread to sleep for SECONDS seconds.\n"+
+        "SECONDS may be a value between 0 1and 1.")
+    private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true)
     {
         @Override
@@ -991 +993 @@
     };
 
-    // ### mapcar-threads
+    @DocString(name="mapcar-threads", args= "function",
+    doc="Applies FUNCTION to all existing threads.")
     private static final Primitive MAPCAR_THREADS =
-        new Primitive("mapcar-threads", PACKAGE_THREADS, true, "function",
-          "Applies FUNCTION to all existing threads.")
+        new Primitive("mapcar-threads", PACKAGE_THREADS, true)
     {
         @Override
@@ -1012 +1014 @@
     };
 
-    // ### destroy-thread
+    @DocString(name="destroy-thread", args="thread", doc="Mark THREAD as destroyed")
     private static final Primitive DESTROY_THREAD =
-        new Primitive("destroy-thread", PACKAGE_THREADS, true, "thread", 
-          "Mark THREAD as destroyed.")
+        new Primitive("destroy-thread", PACKAGE_THREADS, true)
     {
         @Override
@@ -1032 +1033 @@
     };
 
-    // ### interrupt-thread thread function &rest args => T
-    // Interrupts thread and forces it to apply function to args. When the
-    // function returns, the thread's original computation continues. If
-    // multiple interrupts are queued for a thread, they are all run, but the
-    // order is not guaranteed.
+    // => T
+    @DocString(name="interrupt-thread", args="thread function &rest args",
+    doc="Interrupts thread and forces it to apply function to args. When the\n"+
+        "function returns, the thread's original computation continues. If\n"+
+        "multiple interrupts are queued for a thread, they are all run, but the\n"+
+        "order is not guaranteed.")
     private static final Primitive INTERRUPT_THREAD =
         new Primitive("interrupt-thread", PACKAGE_THREADS, true,
@@ -1063 +1065 @@
     };
 
-    // ### current-thread
+    @DocString(name="current-thread",
+    doc="Returns a reference to invoking thread.")
     private static final Primitive CURRENT_THREAD =
-        new Primitive("current-thread", PACKAGE_THREADS, true, "",
-          "Returns a reference to invoking thread.")
+        new Primitive("current-thread", PACKAGE_THREADS, true)
     {
         @Override
@@ -1075 +1077 @@
     };
 
-    // ### backtrace
+    @DocString(name="backtrace",
+               doc="Returns a backtrace of the invoking thread.")
     private static final Primitive BACKTRACE =
-        new Primitive("backtrace", PACKAGE_SYS, true, "",
-          "Returns a backtrace of the invoking thread.")
+        new Primitive("backtrace", PACKAGE_SYS, true)
     {
         @Override
@@ -1090 +1092 @@
         }
     };
-    // ### frame-to-string
+    @DocString(name="frame-to-string", args="frame")
     private static final Primitive FRAME_TO_STRING =
-        new Primitive("frame-to-string", PACKAGE_SYS, true, "frame")
+        new Primitive("frame-to-string", PACKAGE_SYS, true)
     {
         @Override
@@ -1105 +1107 @@
     };
 
-    // ### frame-to-list
+    @DocString(name="frame-to-list", args="frame")
     private static final Primitive FRAME_TO_LIST =
-        new Primitive("frame-to-list", PACKAGE_SYS, true, "frame")
+        new Primitive("frame-to-list", PACKAGE_SYS, true)
     {
         @Override
@@ -1121 +1123 @@
 
 
-    static {
-        //FIXME: this block has been added for pre-0.16 compatibility
-        // and can be removed the latest at release 0.22
-        PACKAGE_EXT.export(intern("MAKE-THREAD", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("THREADP", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("THREAD-ALIVE-P", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("THREAD-NAME", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("MAPCAR-THREADS", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("DESTROY-THREAD", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("INTERRUPT-THREAD", PACKAGE_THREADS));
-        PACKAGE_EXT.export(intern("CURRENT-THREAD", PACKAGE_THREADS));
-    }
-
-    // ### use-fast-calls
+    @DocString(name="use-fast-calls")
     private static final Primitive USE_FAST_CALLS =
         new Primitive("use-fast-calls", PACKAGE_SYS, true)
@@ -1146 +1135 @@
     };
 
-    // ### synchronized-on
+    @DocString(name="synchronized-on", args="form &body body")
     private static final SpecialOperator SYNCHRONIZED_ON =
         new SpecialOperator("synchronized-on", PACKAGE_THREADS, true,
@@ -1165 +1154 @@
     };
 
-    // ### object-wait
+    @DocString(name="object-wait", args="object &optional timeout")
     private static final Primitive OBJECT_WAIT =
-        new Primitive("object-wait", PACKAGE_THREADS, true,
-                      "object &optional timeout")
+        new Primitive("object-wait", PACKAGE_THREADS, true)
     {
         @Override
@@ -1203 +1191 @@
     };
 
-    // ### object-notify
+    @DocString(name="object-notify", args="object")
     private static final Primitive OBJECT_NOTIFY =
         new Primitive("object-notify", PACKAGE_THREADS, true,
@@ -1222 +1210 @@
     };
 
-    // ### object-notify-all
+    @DocString(name="object-notify-all", args="object")
     private static final Primitive OBJECT_NOTIFY_ALL =
-        new Primitive("object-notify-all", PACKAGE_THREADS, true,
-                      "object")
+        new Primitive("object-notify-all", PACKAGE_THREADS, true)
     {
         @Override

branches/generic-class-file/abcl/src/org/armedbear/lisp/Operator.java

@@ -54 +54 @@
     public final LispObject getLambdaList()
     {
+        if(lambdaList == null) {
+            DocString ds = getClass().getAnnotation(DocString.class);
+            if(ds != null)
+                lambdaList = new SimpleString(ds.args());
+        }
         return lambdaList;
     }

branches/generic-class-file/abcl/src/org/armedbear/lisp/Pathname.java

@@ -861 +861 @@
         }
         StringBuilder sb = new StringBuilder();
+
         if (useNamestring) {
             if (printReadably || printEscape) {
@@ -878 +879 @@
                 sb.append('"');
             }
-        } else {
-            final SpecialBindingsMark mark = thread.markSpecialBindings();
-            thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
-            try {
-                final boolean ANSI_COMPATIBLE = true;
-                final String SPACE = " ";
-                if (ANSI_COMPATIBLE) {
-                    sb.append("#P(\"");
-                } else {
-                    sb.append("#P(");
-
-                }
-                if (host != NIL) {
-                    sb.append(":HOST ");
-                    sb.append(host.writeToString());
-                    sb.append(SPACE);
-                }
-                if (device != NIL) {
-                    sb.append(":DEVICE ");
-                    sb.append(device.writeToString());
-                    sb.append(SPACE);
-                }
-                if (directory != NIL) {
-                    sb.append(":DIRECTORY ");
-                    sb.append(directory.writeToString());
-                    sb.append(SPACE);
-                }
-                if (name != NIL) {
-                    sb.append(":NAME ");
-                    sb.append(name.writeToString());
-                    sb.append(SPACE);
-                }
-                if (type != NIL) {
-                    sb.append(":TYPE ");
-                    sb.append(type.writeToString());
-                    sb.append(SPACE);
-                }
-                if (version != NIL) {
-                    sb.append(":VERSION ");
-                    sb.append(version.writeToString());
-                    sb.append(SPACE);
-                }
-                if (sb.charAt(sb.length() - 1) == ' ') { // XXX
-                    sb.setLength(sb.length() - 1);
-                }
-                if (ANSI_COMPATIBLE) {
-                    sb.append(')' + "\"");
-                } else {
-                    sb.append(')');
-                }
-            } finally {
-                thread.resetSpecialBindings(mark);
-            }
-        }
-        return sb.toString();
+            return sb.toString();
+        } 
+
+        sb.append("PATHNAME (with no namestring) ");
+        if (host != NIL) {
+            sb.append(":HOST ");
+            sb.append(host.writeToString());
+            sb.append(" ");
+        }
+        if (device != NIL) {
+            sb.append(":DEVICE ");
+            sb.append(device.writeToString());
+            sb.append(" ");
+        }
+        if (directory != NIL) {
+            sb.append(":DIRECTORY ");
+            sb.append(directory.writeToString());
+            sb.append(" ");
+        }
+        if (name != NIL) {
+            sb.append(":NAME ");
+            sb.append(name.writeToString());
+            sb.append(" ");
+        }
+        if (type != NIL) {
+            sb.append(":TYPE ");
+            sb.append(type.writeToString());
+            sb.append(" ");
+        }
+        if (version != NIL) {
+            sb.append(":VERSION ");
+            sb.append(version.writeToString());
+            sb.append(" ");
+        }
+        if (sb.charAt(sb.length() - 1) == ' ') { 
+            sb.setLength(sb.length() - 1);
+        }
+
+        return unreadableString(sb.toString());
     }
     // A logical host is represented as the string that names it.

branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitive.java

@@ -46 +46 @@
     }
 
+    public Primitive(Symbol symbol)
+    {
+        super(symbol);
+    }
+
     public Primitive(Symbol symbol, String arglist)
     {

branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitives.java

@@ -891 +891 @@
             else
                 out = second;
-            checkStream(out)._writeString(first.writeToString());
+            String output = first.writeToString();
+            if (Symbol.PRINT_READABLY.symbolValue(LispThread.currentThread()) != NIL
+                && output.contains("#<")) {
+                LispObject args = NIL;
+                args = args.push(first);
+                args = args.push(Keyword.OBJECT);
+                args = args.nreverse();
+                return error(new PrintNotReadable(args));
+            }
+            checkStream(out)._writeString(output);
             return first;
         }

branches/generic-class-file/abcl/src/org/armedbear/lisp/Stream.java

@@ -535 +535 @@
         LispObject obj = read(true, NIL, false,
                               LispThread.currentThread(), rta);
-        if (obj instanceof AbstractString)
+        if (obj instanceof AbstractString) {
             return Pathname.parseNamestring((AbstractString)obj);
+        }
         if (obj.listp())
             return Pathname.makePathname(obj);
-        return error(new TypeError("#p requires a string or list argument."));
+        return error(new TypeError("#p requires a string argument."));
     }
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/Version.java

@@ -42 +42 @@
   public static String getVersion()
   {
-    return "0.21.0-dev";
+    return "0.22.0-dev";
   }
-  
+
   public static void main(String args[]) {
     System.out.println(Version.getVersion());

branches/generic-class-file/abcl/src/org/armedbear/lisp/asdf.lisp

@@ -71 +71 @@
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
-          (subseq "VERSION:2.003" (1+ (length "VERSION")))) ; NB: same as 2.105.
+          (subseq "VERSION:2.004" (1+ (length "VERSION")))) ; NB: same as 2.111.
          (existing-asdf (find-package :asdf))
          (vername '#:*asdf-version*)
@@ -728 +728 @@
 #+sbcl (defun get-uid () (sb-unix:unix-getuid))
 #+cmu (defun get-uid () (unix:unix-getuid))
-#+ecl (ffi:clines "#include <sys/types.h>" "#include <unistd.h>")
-#+ecl (defun get-uid () (ffi:c-inline () () :int "getuid()" :one-liner t))
+#+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601)
+         '(ffi:clines "#include <sys/types.h>" "#include <unistd.h>"))
+#+ecl (defun get-uid ()
+        #.(cl:if (cl:< ext:+ecl-version-number+ 100601)
+            '(ffi:c-inline () () :int "getuid()" :one-liner t)
+            '(ext::getuid)))
 #+allegro (defun get-uid () (excl.osi:getuid))
 #-(or cmu sbcl clisp allegro ecl)
@@ -1073 +1077 @@
 (defun system-registered-p (name)
   (gethash (coerce-name name) *defined-systems*))
+
+(defun clear-system (name)
+  "Clear the entry for a system in the database of systems previously loaded.
+Note that this does NOT in any way cause the code of the system to be unloaded."
+  ;; There is no "unload" operation in Common Lisp, and a general such operation
+  ;; cannot be portably written, considering how much CL relies on side-effects
+  ;; of global data structures.
+  ;; Note that this does a setf gethash instead of a remhash
+  ;; this way there remains a hint in the *defined-systems* table
+  ;; that the system was loaded at some point.
+  (setf (gethash (coerce-name name) *defined-systems*) nil))
 
 (defun map-systems (fn)
@@ -2396 +2411 @@
     :java-1.4 :java-1.5 :java-1.6 :java-1.7))
 
+
 (defun lisp-version-string ()
   (let ((s (lisp-implementation-version)))
@@ -2411 +2427 @@
                        (:+ics ""))
                       (if (member :64bit *features*) "-64bit" ""))
+    #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
     #+clisp (subseq s 0 (position #\space s))
     #+clozure (format nil "~d.~d-fasl~d"
@@ -2425 +2442 @@
     #+lispworks (format nil "~A~@[~A~]" s
                         (when (member :lispworks-64bit *features*) "-64bit"))
-    ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; fasl-f-v is redundant
-    #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
+    ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; f-f-v redundant w/ version
     #+(or cormanlisp mcl sbcl scl) s
     #-(or allegro armedbear clisp clozure cmu cormanlisp digitool
@@ -2511 +2527 @@
            ;;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
         ,(try (getenv "ALLUSERSPROFILE") "Application Data/common-lisp/config/"))))
-    (list #p"/etc/"))))
+    (list #p"/etc/common-lisp/"))))
 (defun in-first-directory (dirs x)
   (loop :for dir :in dirs
@@ -2958 +2974 @@
 
 (defun delete-file-if-exists (x)
-  (when (probe-file x)
+  (when (and x (probe-file x))
     (delete-file x)))
 
@@ -3355 +3371 @@
   (setf (source-registry) (compute-source-registry parameter)))
 
-;; checks an initial variable to see whether the state is initialized
+;; Checks an initial variable to see whether the state is initialized
 ;; or cleared. In the former case, return current configuration; in
 ;; the latter, initialize.  ASDF will call this function at the start
-;; of (asdf:find-system).
-(defun ensure-source-registry ()
+;; of (asdf:find-system) to make sure the source registry is initialized.
+;; However, it will do so *without* a parameter, at which point it
+;; will be too late to provide a parameter to this function, though
+;; you may override the configuration explicitly by calling
+;; initialize-source-registry directly with your parameter.
+(defun ensure-source-registry (&optional parameter)
   (if (source-registry-initialized-p)
       (source-registry)
-      (initialize-source-registry)))
+      (initialize-source-registry parameter)))
 
 (defun sysdef-source-registry-search (system)

branches/generic-class-file/abcl/src/org/armedbear/lisp/autoloads.lisp

@@ -346 +346 @@
 (export '(make-mutex get-mutex release-mutex with-mutex))
 
-(progn
-  ;; block to be removed at 0.22
-  ;; It exists solely for pre-0.17 compatibility
-  ;; FIXME 0.22
-  (in-package "EXTENSIONS")
-  (export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
-  (export '(make-thread-lock thread-lock thread-unlock with-thread-lock))
-  (export '(with-mutex make-mutex get-mutex release-mutex)))
-
-;; end of 0.22 block
 
 (in-package "EXTENSIONS")
@@ -429 +419 @@
 (in-package "COMMON-LISP")
 
+(sys::autoload '(documentation) "clos")
+
 (sys::autoload '(write print prin1 princ pprint write-to-string
             prin1-to-string princ-to-string write-char

branches/generic-class-file/abcl/src/org/armedbear/lisp/compile-system.lisp

@@ -188 +188 @@
                            ;;"j.lisp"
                            "java.lisp"
+                           "java-collections.lisp"
                            "known-functions.lisp"
                            "known-symbols.lisp"

branches/generic-class-file/abcl/src/org/armedbear/lisp/debug.lisp

@@ -86 +86 @@
     (fresh-line *debug-io*)
     (with-standard-io-syntax
-      (let ((*print-structure* nil))
+      (let ((*print-structure* nil)
+      (*print-readably* nil))
         (when (and *load-truename* (streamp *load-stream*))
           (simple-format *debug-io*

branches/generic-class-file/abcl/src/org/armedbear/lisp/java.lisp

@@ -149 +149 @@
         method implementation)))))
     lisp-this))
+
+(defun jequal (obj1 obj2)
+  "Compares obj1 with obj2 using java.lang.Object.equals()"
+  (jcall (jmethod "java.lang.Object" "equals" "java.lang.Object")
+   obj1 obj2))
 
 (defun jobject-class (obj)
@@ -364 +369 @@
              :java-class +java-lang-object+)))
 
+(defun jclass-additional-superclasses (jclass)
+  "Extension point to put additional CLOS classes on the CPL of a CLOS Java class."
+  (let ((supers nil))
+    (when (jclass-interface-p jclass)
+      (push (find-class 'java-object) supers))
+    (when (jequal jclass (jclass "java.util.List"))
+      (push (find-class 'sequence) supers))
+    supers))
+
 (defun ensure-java-class (jclass)
   (let ((class (%find-java-class jclass)))
@@ -379 +393 @@
                  (list (jclass-superclass jclass))
                  (jclass-interfaces jclass))))))
-       (if (jclass-interface-p jclass)
-           (append supers (list (find-class 'java-object)))
-           supers))
+       (append supers (jclass-additional-superclasses jclass)))
      :java-class jclass)))))
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/logorc2.java

@@ -38 +38 @@
 import java.math.BigInteger;
 
-// ### logorc2
 // logorc2 integer-1 integer-2 => result-integer
 // or integer-1 with complement of integer-2
+@DocString(name="logorc2", args="integer-1 integer-2")
 public final class logorc2 extends Primitive
 {

branches/generic-class-file/abcl/src/org/armedbear/lisp/package_error_package.java

@@ -36 +36 @@
 import static org.armedbear.lisp.Lisp.*;
 
-// ### package-error-package
+@DocString(name="package-error-package")
 public final class package_error_package extends Primitive
 {

branches/generic-class-file/abcl/src/org/armedbear/lisp/print.lisp

@@ -281 +281 @@
 
 (defun %print-object (object stream)
+  (when (and *print-readably* 
+             (typep object 'string)
+             (search "#<" object))
+    (error 'print-not-readable :object object))
   (if *print-pretty*
       (xp::output-pretty-object object stream)

branches/generic-class-file/abcl/src/org/armedbear/lisp/threads.lisp

@@ -1 +1 @@
 ;;; threads.lisp
 ;;;
-;;; Copyright (C) 2009 Erik Huelsmann <ehuelsmann@common-lisp.net>
+;;; Copyright (C) 2009-2010 Erik Huelsmann <ehuelsmann@common-lisp.net>
 ;;;
 ;;; $Id$
@@ -143 +143 @@
           ,@body))))
 
-(defun thread-lock (lock)
-  "Deprecated; due for removal in 0.22"
-  (declare (ignore lock)))
-(defun thread-unlock (lock)
-  "Deprecated; due for removal in 0.22"
-  (declare (ignore lock)))

branches/generic-class-file/abcl/test/lisp/ansi/package.lisp

@@ -33 +33 @@
     (format t "Invoking ABCL hosted on ~A ~A.~%" 
       (software-type) (software-version))
-    (if (find :unix *features*)
-        (run-shell-command "cd ~A; make clean" ansi-tests-directory)
-        ;; XXX -- what to invoke on win32?  Untested:
-        (run-shell-command 
-         (format nil "~A~%~A"
-           (format nil "cd ~A" *ansi-tests-directory*)
-           (format nil "erase *.cls *.abcl"))))
+          ;; Do what 'make clean' would do from the GCL ANSI tests,
+          ;; so we don't have to hunt for 'make' on win32.
+          (mapcar #'delete-file
+                  (append (directory (format nil "~A/*.cls" *default-pathname-defaults*))
+                          (directory (format nil "~A/*.abcl" *default-pathname-defaults*))
+                          (directory (format nil "~A/scratch/*" *default-pathname-defaults*))
+                          (mapcar (lambda(x) (format nil "~A/~A" *default-pathname-defaults* x))
+                                  '("scratch/"
+                                    "scratch.txt" "foo.txt" "foo.lsp"
+                                    "foo.dat" 
+                                    "tmp.txt" "tmp.dat" "tmp2.dat"
+                                    "temp.dat" "out.class" 
+                                    "file-that-was-renamed.txt"
+                                    "compile-file-test-lp.lsp"
+                                    "compile-file-test-lp.out" 
+                                    "ldtest.lsp"))))
     (time (load boot-file))
     (format t "<--- ~A ends.~%" message))

branches/generic-class-file/abcl/test/lisp/ansi/parse-ansi-errors.lisp

@@ -75 +75 @@
 
 (defvar *default-database-file* 
-  (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
+  (if (find :asdf2 *features*)
+      (asdf:system-relative-pathname :ansi-compiled "test/lisp/ansi/ansi-test-failures")
+      (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
 
 (defun parse (&optional (file *default-database-file*))