Changeset 13135 for trunk/abcl/src/org


Ignore:
Timestamp:
01/12/11 22:16:01 (11 years ago)
Author:
astalla
Message:

Revert to a reflection-based loading scheme for top-level compiled functions. Fix NPE in Package.java.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java

    r13007 r13135  
    4040public class FaslClassLoader extends JavaClassLoader {
    4141
    42     private final LispObject[] functions;
    4342    private String baseName;
    4443    private LispObject loader; //The function used to load FASL functions by number
    4544    private final JavaObject boxedThis = new JavaObject(this);
    46    
    47     public FaslClassLoader(int functionCount, String baseName, boolean useLoaderFunction) {
    48   functions = new LispObject[functionCount];
    49   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       }
    57   }
     45
     46    public FaslClassLoader(String baseName) {
     47        this.baseName = baseName;
    5848    }
    5949
     
    9181    @Override
    9282    protected Class<?> findClass(String name) throws ClassNotFoundException {
    93   try {
    94       byte[] b = getFunctionClassBytes(name);
    95       return defineClass(name, b, 0, b.length);
    96   } catch(Throwable e) { //TODO handle this better, readFunctionBytes uses Debug.assert() but should return null
    97       e.printStackTrace();
    98       if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
    99       throw new ClassNotFoundException("Function class not found: " + name, e);
    100   }
     83        try {
     84            byte[] b = getFunctionClassBytes(name);
     85            return defineClass(name, b, 0, b.length);
     86        } catch(Throwable e) { //TODO handle this better, readFunctionBytes uses Debug.assert() but should return null
     87            e.printStackTrace();
     88            if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
     89            throw new ClassNotFoundException("Function class not found: " + name, e);
     90        }
    10191    }
    10292
    10393    public byte[] getFunctionClassBytes(String name) {
    104   Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
    105   return readFunctionBytes(pathname);
     94        Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
     95        return readFunctionBytes(pathname);
    10696    }
    10797   
    10898    public byte[] getFunctionClassBytes(Class<?> functionClass) {
    109   return getFunctionClassBytes(functionClass.getName());
     99        return getFunctionClassBytes(functionClass.getName());
    110100    }
    111101
    112102    public byte[] getFunctionClassBytes(Function f) {
    113   byte[] b = getFunctionClassBytes(f.getClass());
    114   f.setClassBytes(b);
    115   return b;
     103        byte[] b = getFunctionClassBytes(f.getClass());
     104        f.setClassBytes(b);
     105        return b;
    116106    }
    117107
    118108    public LispObject loadFunction(int fnNumber) {
    119   try {
    120       //Function name is fnIndex + 1
    121       LispObject o = (LispObject) loadClass(baseName + "_" + (fnNumber + 1)).newInstance();
    122       functions[fnNumber] = o;
    123       return o;
    124   } catch(Exception e) {
    125       e.printStackTrace();
    126       if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
    127       throw new RuntimeException(e);
    128   }
    129     }
    130    
    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 reflection
    141     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;
     109        try {
     110            //Function name is fnIndex + 1
     111            LispObject o = (LispObject) loadClass(baseName + "_" + (fnNumber + 1)).newInstance();
     112            return o;
     113        } catch(Exception e) {
     114            if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
     115            Debug.trace(e);
     116            return error(new LispError("Compiled function can't be loaded: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue()));
     117        }
    151118    }
    152119
    153120    private static final Primitive MAKE_FASL_CLASS_LOADER = new pf_make_fasl_class_loader();
    154121    private static final class pf_make_fasl_class_loader extends Primitive {
    155   pf_make_fasl_class_loader() {
    156             super("make-fasl-class-loader", PACKAGE_SYS, false, "function-count base-name");
     122        pf_make_fasl_class_loader() {
     123            super("make-fasl-class-loader", PACKAGE_SYS, false, "base-name");
    157124        }
    158125
    159126        @Override
    160         public LispObject execute(LispObject functionCount, LispObject baseName) {
    161             return execute(functionCount, baseName, T);
     127        public LispObject execute(LispObject baseName) {
     128            return new FaslClassLoader(baseName.getStringValue()).boxedThis;
    162129        }
    163130
    164         @Override
    165         public LispObject execute(LispObject functionCount, LispObject baseName, LispObject init) {
    166             return new FaslClassLoader(functionCount.intValue(), baseName.getStringValue(), init != NIL).boxedThis;
    167         }
    168131    };
    169132
     
    177140        public LispObject execute(LispObject loader, LispObject fnNumber) {
    178141            FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class);
    179       return l.getFunction(fnNumber.intValue());
     142      return l.loadFunction(fnNumber.intValue());
    180143        }
    181144    };
  • trunk/abcl/src/org/armedbear/lisp/Package.java

    r13132 r13135  
    162162    {
    163163        if (name != null) {
    164             LispObject usedPackages = useList;
    165             while (usedPackages != NIL) {
    166                 Package pkg = (Package) usedPackages.car();
    167                 unusePackage(pkg);
    168                 usedPackages = usedPackages.cdr();
     164            if(useList instanceof Cons) {
     165                LispObject usedPackages = useList;
     166                while (usedPackages != NIL) {
     167                    Package pkg = (Package) usedPackages.car();
     168                    unusePackage(pkg);
     169                    usedPackages = usedPackages.cdr();
     170                }
    169171            }
    170172
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r13046 r13135  
    369369  (when compile-time-too
    370370    (let ((*load-truename* *output-file-pathname*)
    371     (*fasl-loader* (make-fasl-class-loader
    372         *class-number*
    373         (concatenate 'string "org.armedbear.lisp." (base-classname))
    374         nil)))
     371          (*fasl-loader* (make-fasl-class-loader
     372                          (concatenate 'string "org.armedbear.lisp." (base-classname)))))
    375373      (eval form))))
    376374
     
    612610
    613611              (when (> *class-number* 0)
    614                 (generate-loader-function)
    615612                (write (list 'setq '*fasl-loader*
    616613                             `(sys::make-fasl-class-loader
    617                                ,*class-number*
    618614                               ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out))
    619615              (%stream-terpri out))
     
    662658    (values (truename output-file) warnings-p failure-p)))
    663659
    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 for
    667   ;;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 arg
    684                   (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         ,@(loop
    692        :for i :from 1 :to *class-number*
    693        :collect
    694        (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-policy
    711   (jvm::with-file-compilation
    712       (with-open-file
    713     (f classfile
    714        :direction :output
    715        :element-type '(unsigned-byte 8)
    716        :if-exists :supersede)
    717         (jvm:compile-defun nil expr *compile-file-environment*
    718          classfile f nil))))))
    719 
    720660(defun compile-file-if-needed (input-file &rest allargs &key force-compile
    721661                               &allow-other-keys)
Note: See TracChangeset for help on using the changeset viewer.