Changeset 13162


Ignore:
Timestamp:
01/20/11 13:51:23 (11 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:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/0.24.x/abcl/src/org/armedbear/lisp/FaslClassLoader.java

    r13007 r13162  
    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);
    4645   
    47     public FaslClassLoader(int functionCount, String baseName, boolean useLoaderFunction) {
    48   functions = new LispObject[functionCount];
     46    public FaslClassLoader(String baseName) {
    4947  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!");
    5648      }
    57   }
    58     }
    5949
    6050    @Override
     
    120110      //Function name is fnIndex + 1
    121111      LispObject o = (LispObject) loadClass(baseName + "_" + (fnNumber + 1)).newInstance();
    122       functions[fnNumber] = o;
    123112      return o;
    124113  } catch(Exception e) {
    125       e.printStackTrace();
    126114      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()));
    128117  }
    129118    }
    130119   
    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;
    151     }
    152 
    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 {
    155122  pf_make_fasl_class_loader() {
    156             super("make-fasl-class-loader", PACKAGE_SYS, false, "function-count base-name");
     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    };
  • branches/0.24.x/abcl/src/org/armedbear/lisp/Package.java

    r13133 r13162  
    162162    {
    163163        if (name != null) {
     164            if(useList instanceof Cons) {
    164165            LispObject usedPackages = useList;
    165166            while (usedPackages != NIL) {
     
    167168                unusePackage(pkg);
    168169                usedPackages = usedPackages.cdr();
     170            }
    169171            }
    170172
  • branches/0.24.x/abcl/src/org/armedbear/lisp/compile-file.lisp

    r13046 r13162  
    370370    (let ((*load-truename* *output-file-pathname*)
    371371    (*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)))))
    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.