[armedbear-cvs] r13162 - branches/0.24.x/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Thu Jan 20 13:51:24 UTC 2011
Author: ehuelsmann
Date: Thu Jan 20 08:51:23 2011
New Revision: 13162
Log:
Merge r13135: go back to reflection based method instantiation.
Modified:
branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java
branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java
branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp
Modified: branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java
==============================================================================
--- branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java (original)
+++ branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java Thu Jan 20 08:51:23 2011
@@ -39,23 +39,13 @@
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
protected Class<?> loadClass(String name, boolean resolve)
@@ -119,52 +109,25 @@
try {
//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;
- }
};
private static final Primitive GET_FASL_FUNCTION = new pf_get_fasl_function();
@@ -176,7 +139,7 @@
@Override
public LispObject execute(LispObject loader, LispObject fnNumber) {
FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class);
- return l.getFunction(fnNumber.intValue());
+ return l.loadFunction(fnNumber.intValue());
}
};
Modified: branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java
==============================================================================
--- branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java (original)
+++ branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java Thu Jan 20 08:51:23 2011
@@ -161,12 +161,14 @@
public final synchronized boolean delete()
{
if (name != null) {
+ if(useList instanceof Cons) {
LispObject usedPackages = useList;
while (usedPackages != NIL) {
Package pkg = (Package) usedPackages.car();
unusePackage(pkg);
usedPackages = usedPackages.cdr();
}
+ }
Packages.deletePackage(this);
Modified: branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp (original)
+++ branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp Thu Jan 20 08:51:23 2011
@@ -369,9 +369,7 @@
(when compile-time-too
(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))))
(declaim (ftype (function (t) t) convert-ensure-method))
@@ -611,10 +609,8 @@
(%stream-terpri out)
(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))
@@ -661,62 +657,6 @@
(namestring output-file) elapsed))))
(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 , at 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)
(setf input-file (truename input-file))
More information about the armedbear-cvs
mailing list