Changeset 13162
- Timestamp:
- 01/20/11 13:51:23 (12 years ago)
- Location:
- branches/0.24.x/abcl/src/org/armedbear/lisp
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java
r13007 r13162 40 40 public class FaslClassLoader extends JavaClassLoader { 41 41 42 private final LispObject[] functions;43 42 private String baseName; 44 43 private LispObject loader; //The function used to load FASL functions by number 45 44 private final JavaObject boxedThis = new JavaObject(this); 46 45 47 public FaslClassLoader(int functionCount, String baseName, boolean useLoaderFunction) { 48 functions = new LispObject[functionCount]; 46 public FaslClassLoader(String baseName) { 49 47 this.baseName = baseName; 50 if(useLoaderFunction) {51 try {52 this.loader = (LispObject) loadClass(baseName + "_0").newInstance();53 } catch(Exception e) {54 //e.printStackTrace();55 Debug.trace("useLoaderFunction = true but couldn't fully init FASL loader ("+baseName+"), will fall back to reflection!");56 48 } 57 }58 }59 49 60 50 @Override … … 120 110 //Function name is fnIndex + 1 121 111 LispObject o = (LispObject) loadClass(baseName + "_" + (fnNumber + 1)).newInstance(); 122 functions[fnNumber] = o;123 112 return o; 124 113 } catch(Exception e) { 125 e.printStackTrace();126 114 if(e instanceof ControlTransfer) { throw (ControlTransfer) e; } 127 throw new RuntimeException(e); 115 Debug.trace(e); 116 return error(new LispError("Compiled function can't be loaded: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue())); 128 117 } 129 118 } 130 119 131 public LispObject getFunction(int fnNumber) {132 if(fnNumber >= functions.length) {133 return error(new LispError("Compiled function not found: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue()));134 }135 LispObject o = functions[fnNumber];136 if(o == null) {137 if(loader != null) {138 loader.execute(boxedThis, Fixnum.getInstance(fnNumber));139 return functions[fnNumber];140 } else { //Fallback to reflection141 return loadFunction(fnNumber);142 }143 } else {144 return o;145 }146 }147 148 public LispObject putFunction(int fnNumber, LispObject fn) {149 functions[fnNumber] = fn;150 return fn;151 }152 153 120 private static final Primitive MAKE_FASL_CLASS_LOADER = new pf_make_fasl_class_loader(); 154 121 private static final class pf_make_fasl_class_loader extends Primitive { 155 122 pf_make_fasl_class_loader() { 156 super("make-fasl-class-loader", PACKAGE_SYS, false, " function-countbase-name");123 super("make-fasl-class-loader", PACKAGE_SYS, false, "base-name"); 157 124 } 158 125 159 126 @Override 160 public LispObject execute(LispObject functionCount, LispObjectbaseName) {161 return execute(functionCount, baseName, T);127 public LispObject execute(LispObject baseName) { 128 return new FaslClassLoader(baseName.getStringValue()).boxedThis; 162 129 } 163 130 164 @Override165 public LispObject execute(LispObject functionCount, LispObject baseName, LispObject init) {166 return new FaslClassLoader(functionCount.intValue(), baseName.getStringValue(), init != NIL).boxedThis;167 }168 131 }; 169 132 … … 177 140 public LispObject execute(LispObject loader, LispObject fnNumber) { 178 141 FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class); 179 return l. getFunction(fnNumber.intValue());142 return l.loadFunction(fnNumber.intValue()); 180 143 } 181 144 }; -
branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java
r13133 r13162 162 162 { 163 163 if (name != null) { 164 if(useList instanceof Cons) { 164 165 LispObject usedPackages = useList; 165 166 while (usedPackages != NIL) { … … 167 168 unusePackage(pkg); 168 169 usedPackages = usedPackages.cdr(); 170 } 169 171 } 170 172 -
branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp
r13046 r13162 370 370 (let ((*load-truename* *output-file-pathname*) 371 371 (*fasl-loader* (make-fasl-class-loader 372 *class-number* 373 (concatenate 'string "org.armedbear.lisp." (base-classname)) 374 nil))) 372 (concatenate 'string "org.armedbear.lisp." (base-classname))))) 375 373 (eval form)))) 376 374 … … 612 610 613 611 (when (> *class-number* 0) 614 (generate-loader-function)615 612 (write (list 'setq '*fasl-loader* 616 613 `(sys::make-fasl-class-loader 617 ,*class-number*618 614 ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out)) 619 615 (%stream-terpri out)) … … 662 658 (values (truename output-file) warnings-p failure-p))) 663 659 664 (defmacro ncase (expr min max &rest clauses)665 "A CASE where all test clauses are numbers ranging from a minimum to a maximum."666 ;;Expr is subject to multiple evaluation, but since we only use ncase for667 ;;fn-index below, let's ignore it.668 (let* ((half (floor (/ (- max min) 2)))669 (middle (+ min half)))670 (if (> (- max min) 10)671 `(if (< ,expr ,middle)672 (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))673 (ncase ,expr ,middle ,max ,@(subseq clauses half)))674 `(case ,expr ,@clauses))))675 676 (defconstant +fasl-classloader+677 (jvm::make-jvm-class-name "org.armedbear.lisp.FaslClassLoader"))678 679 (defun generate-loader-function ()680 (let* ((basename (base-classname))681 (expr `(lambda (fasl-loader fn-index)682 (declare (type (integer 0 256000) fn-index))683 (identity fasl-loader) ;;to avoid unused arg684 (jvm::with-inline-code ()685 (jvm::emit 'jvm::aload 1)686 (jvm::emit-invokevirtual jvm::+lisp-object+ "javaInstance"687 nil jvm::+java-object+)688 (jvm::emit-checkcast +fasl-classloader+)689 (jvm::emit 'jvm::iload 2))690 (ncase fn-index 0 ,(1- *class-number*)691 ,@(loop692 :for i :from 1 :to *class-number*693 :collect694 (let* ((class (%format nil "org/armedbear/lisp/~A_~A"695 basename i))696 (class-name (jvm::make-jvm-class-name class)))697 `(,(1- i)698 (jvm::with-inline-code ()699 (jvm::emit-new ,class-name)700 (jvm::emit 'jvm::dup)701 (jvm::emit-invokespecial-init ,class-name '())702 (jvm::emit-invokevirtual +fasl-classloader+703 "putFunction"704 (list :int jvm::+lisp-object+) jvm::+lisp-object+)705 (jvm::emit 'jvm::pop))706 t))))))707 (classname (fasl-loader-classname))708 (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")709 *output-file-pathname*))))710 (jvm::with-saved-compiler-policy711 (jvm::with-file-compilation712 (with-open-file713 (f classfile714 :direction :output715 :element-type '(unsigned-byte 8)716 :if-exists :supersede)717 (jvm:compile-defun nil expr *compile-file-environment*718 classfile f nil))))))719 720 660 (defun compile-file-if-needed (input-file &rest allargs &key force-compile 721 661 &allow-other-keys)
Note: See TracChangeset
for help on using the changeset viewer.