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

[Ville Voutilainen]

Author: vvoutilainen
Date: Sun May 17 07:36:40 2009
New Revision: 11889

Log:
Remove CompiledFunction, we don't need it.


Removed:
   trunk/abcl/src/org/armedbear/lisp/CompiledFunction.java
Modified:
   trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
   trunk/abcl/src/org/armedbear/lisp/Lisp.java
   trunk/abcl/src/org/armedbear/lisp/Load.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java	Sun May 17 07:36:40 2009
@@ -204,4 +204,35 @@
   {
     return notImplemented();
   }
+
+  // ### load-compiled-function
+  private static final Primitive LOAD_COMPILED_FUNCTION =
+      new Primitive("load-compiled-function", PACKAGE_SYS, true, "pathname")
+  {
+    @Override
+    public LispObject execute(LispObject arg) throws ConditionThrowable
+    {
+      String namestring = null;
+      if (arg instanceof Pathname)
+        namestring = ((Pathname)arg).getNamestring();
+      else if (arg instanceof AbstractString)
+        namestring = arg.getStringValue();
+      if (namestring != null)
+        return loadCompiledFunction(namestring);
+      return error(new LispError("Unable to load " + arg.writeToString()));
+    }
+  };
+
+  // ### varlist
+  private static final Primitive VARLIST =
+      new Primitive("varlist", PACKAGE_SYS, false)
+  {
+    @Override
+    public LispObject execute(LispObject arg) throws ConditionThrowable
+    {
+      if (arg instanceof Closure)
+        return ((Closure)arg).getVariableList();
+      return type_error(arg, Symbol.COMPILED_FUNCTION);
+    }
+  };
 }

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Sun May 17 07:36:40 2009
@@ -2518,7 +2518,7 @@
     loadClass("org.armedbear.lisp.Primitives");
     loadClass("org.armedbear.lisp.SpecialOperators");
     loadClass("org.armedbear.lisp.Extensions");
-    loadClass("org.armedbear.lisp.CompiledFunction");
+    loadClass("org.armedbear.lisp.CompiledClosure");
     loadClass("org.armedbear.lisp.Autoload");
     loadClass("org.armedbear.lisp.AutoloadMacro");
     loadClass("org.armedbear.lisp.cxr");

Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java	Sun May 17 07:36:40 2009
@@ -352,7 +352,7 @@
     // ### *fasl-version*
     // internal symbol
     private static final Symbol _FASL_VERSION_ =
-        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(31));
+        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(32));
 
     // ### *fasl-anonymous-package*
     // internal symbol

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	Sun May 17 07:36:40 2009
@@ -2439,7 +2439,7 @@
             LispObject name = ((CompiledClosure)arg).getLambdaName();
             value3 = name != null ? name : NIL;
           }
-        else if (arg instanceof Closure && !(arg instanceof CompiledFunction))
+        else if (arg instanceof Closure)
           {
             Closure closure = (Closure) arg;
             LispObject expr = closure.getBody();

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun May 17 07:36:40 2009
@@ -241,7 +241,6 @@
 (defconstant +lisp-return-class+ "org/armedbear/lisp/Return")
 (defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
 (defconstant +lisp-compiled-closure-class+ "org/armedbear/lisp/CompiledClosure")
-(defconstant +lisp-compiled-function-class+ "org/armedbear/lisp/CompiledFunction")
 (defconstant +lisp-primitive-class+ "org/armedbear/lisp/Primitive")
 (defconstant +lisp-hash-table-class+ "org/armedbear/lisp/HashTable")
 (defconstant +lisp-eql-hash-table-class+ "org/armedbear/lisp/EqlHashTable")
@@ -1810,15 +1809,7 @@
          (*handlers* nil))
     (setf (method-max-locals constructor) 1)
     (aload 0) ;; this
-    (cond ((equal super +lisp-compiled-function-class+)
-           (emit-constructor-lambda-name lambda-name)
-           (emit-constructor-lambda-list args)
-           (emit-push-nil) ;; body
-           (emit 'aconst_null) ;; environment
-           (emit-invokespecial-init super
-                                    (list +lisp-object+ +lisp-object+
-                                          +lisp-object+ +lisp-environment+)))
-          ((equal super +lisp-primitive-class+)
+    (cond ((equal super +lisp-primitive-class+)
            (emit-constructor-lambda-name lambda-name)
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 2)))
@@ -8207,7 +8198,7 @@
     (setf (class-file-superclass class-file)
           (cond
             ((and *child-p* *closure-variables*) +lisp-compiled-closure-class+)
-            (*hairy-arglist-p* +lisp-compiled-function-class+)
+            (*hairy-arglist-p* +lisp-compiled-closure-class+)
             (t +lisp-primitive-class+)))
 
     (setf (class-file-lambda-list class-file) args)