Changeset 13162

Timestamp:

01/20/11 13:51:23 (12 years ago)

Author:

ehuelsmann

Message:

Merge r13135: go back to reflection based method instantiation.

Location:

branches/0.24.x/abcl/src/org/armedbear/lisp

Files:

• FaslClassLoader.java (modified) (3 diffs)
• Package.java (modified) (2 diffs)
• compile-file.lisp (modified) (3 diffs)

branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java

@@ -40 +40 @@
 public class FaslClassLoader extends JavaClassLoader {
 
-    private final LispObject[] functions;
     private String baseName;
     private LispObject loader; //The function used to load FASL functions by number
     private final JavaObject boxedThis = new JavaObject(this);
     
-    public FaslClassLoader(int functionCount, String baseName, boolean useLoaderFunction) {
-  functions = new LispObject[functionCount];
+    public FaslClassLoader(String baseName) {
   this.baseName = baseName;
-  if(useLoaderFunction) {
-      try {
-    this.loader = (LispObject) loadClass(baseName + "_0").newInstance();
-      } catch(Exception e) {
-    //e.printStackTrace();
-    Debug.trace("useLoaderFunction = true but couldn't fully init FASL loader ("+baseName+"), will fall back to reflection!");
       }
-  }
-    }
 
     @Override
@@ -120 +110 @@
       //Function name is fnIndex + 1
       LispObject o = (LispObject) loadClass(baseName + "_" + (fnNumber + 1)).newInstance();
-      functions[fnNumber] = o;
       return o;
   } catch(Exception e) {
-      e.printStackTrace();
       if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
-      throw new RuntimeException(e);
+            Debug.trace(e);
+            return error(new LispError("Compiled function can't be loaded: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue()));
   }
     }
     
-    public LispObject getFunction(int fnNumber) {
-  if(fnNumber >= functions.length) {
-      return error(new LispError("Compiled function not found: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue()));
-  }
-  LispObject o = functions[fnNumber];
-  if(o == null) {
-      if(loader != null) {
-    loader.execute(boxedThis, Fixnum.getInstance(fnNumber));
-    return functions[fnNumber];
-      } else { //Fallback to reflection
-    return loadFunction(fnNumber);
-      }
-  } else {
-      return o;
-  }
-    }
-
-    public LispObject putFunction(int fnNumber, LispObject fn) {
-  functions[fnNumber] = fn;
-  return fn;
-    }
-
     private static final Primitive MAKE_FASL_CLASS_LOADER = new pf_make_fasl_class_loader();
     private static final class pf_make_fasl_class_loader extends Primitive {
   pf_make_fasl_class_loader() {
-            super("make-fasl-class-loader", PACKAGE_SYS, false, "function-count base-name");
+            super("make-fasl-class-loader", PACKAGE_SYS, false, "base-name");
         }
 
         @Override
-        public LispObject execute(LispObject functionCount, LispObject baseName) {
-            return execute(functionCount, baseName, T);
+        public LispObject execute(LispObject baseName) {
+            return new FaslClassLoader(baseName.getStringValue()).boxedThis;
         }
 
-        @Override
-        public LispObject execute(LispObject functionCount, LispObject baseName, LispObject init) {
-            return new FaslClassLoader(functionCount.intValue(), baseName.getStringValue(), init != NIL).boxedThis;
-        }
     };
 
@@ -177 +140 @@
         public LispObject execute(LispObject loader, LispObject fnNumber) {
             FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class);
-      return l.getFunction(fnNumber.intValue());
+      return l.loadFunction(fnNumber.intValue());
         }
     };

branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java

@@ -162 +162 @@
     {
         if (name != null) {
+            if(useList instanceof Cons) {
             LispObject usedPackages = useList;
             while (usedPackages != NIL) {
@@ -167 +168 @@
                 unusePackage(pkg);
                 usedPackages = usedPackages.cdr();
+            }
             }
 

branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -370 +370 @@
     (let ((*load-truename* *output-file-pathname*)
     (*fasl-loader* (make-fasl-class-loader
-        *class-number*
-        (concatenate 'string "org.armedbear.lisp." (base-classname))
-        nil)))
+                          (concatenate 'string "org.armedbear.lisp." (base-classname)))))
       (eval form))))
 
@@ -612 +610 @@
 
               (when (> *class-number* 0)
-                (generate-loader-function)
                 (write (list 'setq '*fasl-loader*
                              `(sys::make-fasl-class-loader
-                               ,*class-number*
                                ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out))
               (%stream-terpri out))
@@ -662 +658 @@
     (values (truename output-file) warnings-p failure-p)))
 
-(defmacro ncase (expr min max &rest clauses)
-  "A CASE where all test clauses are numbers ranging from a minimum to a maximum."
-  ;;Expr is subject to multiple evaluation, but since we only use ncase for
-  ;;fn-index below, let's ignore it.
-  (let* ((half (floor (/ (- max min) 2)))
-   (middle (+ min half)))
-    (if (> (- max min) 10)
-  `(if (< ,expr ,middle)
-       (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))
-       (ncase ,expr ,middle ,max ,@(subseq clauses half)))
-  `(case ,expr ,@clauses))))
-
-(defconstant +fasl-classloader+
-  (jvm::make-jvm-class-name "org.armedbear.lisp.FaslClassLoader"))
-
-(defun generate-loader-function ()
-  (let* ((basename (base-classname))
-   (expr `(lambda (fasl-loader fn-index)
-                  (declare (type (integer 0 256000) fn-index))
-                  (identity fasl-loader) ;;to avoid unused arg
-                  (jvm::with-inline-code ()
-                    (jvm::emit 'jvm::aload 1)
-                    (jvm::emit-invokevirtual jvm::+lisp-object+ "javaInstance"
-                                             nil jvm::+java-object+)
-                    (jvm::emit-checkcast +fasl-classloader+)
-                    (jvm::emit 'jvm::iload 2))
-      (ncase fn-index 0 ,(1- *class-number*)
-        ,@(loop
-       :for i :from 1 :to *class-number*
-       :collect
-       (let* ((class (%format nil "org/armedbear/lisp/~A_~A"
-                                                basename i))
-                                (class-name (jvm::make-jvm-class-name class)))
-                           `(,(1- i)
-                              (jvm::with-inline-code ()
-                                (jvm::emit-new ,class-name)
-                                (jvm::emit 'jvm::dup)
-                                (jvm::emit-invokespecial-init ,class-name '())
-                                (jvm::emit-invokevirtual +fasl-classloader+
-                                                         "putFunction"
-                                                         (list :int jvm::+lisp-object+) jvm::+lisp-object+)
-        (jvm::emit 'jvm::pop))
-            t))))))
-   (classname (fasl-loader-classname))
-   (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
-             *output-file-pathname*))))
-    (jvm::with-saved-compiler-policy
-  (jvm::with-file-compilation
-      (with-open-file
-    (f classfile
-       :direction :output
-       :element-type '(unsigned-byte 8)
-       :if-exists :supersede)
-        (jvm:compile-defun nil expr *compile-file-environment*
-         classfile f nil))))))
-
 (defun compile-file-if-needed (input-file &rest allargs &key force-compile
                                &allow-other-keys)