Changeset 12698


Ignore:
Timestamp:
05/17/10 18:53:41 (12 years ago)
Author:
astalla
Message:

Load class bytes on demand for disassemble.

Location:
branches/less-reflection/abcl/src/org/armedbear/lisp
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/less-reflection/abcl/src/org/armedbear/lisp/FaslClassLoader.java

    r12672 r12698  
    6060    protected Class<?> findClass(String name) throws ClassNotFoundException {
    6161  try {
    62       Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
    63       byte[] b = readFunctionBytes(pathname);
     62      byte[] b = getFunctionClassBytes(name);
    6463      return defineClass(name, b, 0, b.length);
    6564  } catch(Throwable e) { //TODO handle this better, readFunctionBytes uses Debug.assert() but should return null
     
    6867      throw new ClassNotFoundException("Function class not found: " + name, e);
    6968  }
     69    }
     70
     71    public byte[] getFunctionClassBytes(String name) {
     72  Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
     73  return readFunctionBytes(pathname);
     74    }
     75   
     76    public byte[] getFunctionClassBytes(Class<?> functionClass) {
     77  return getFunctionClassBytes(functionClass.getName());
     78    }
     79
     80    public byte[] getFunctionClassBytes(Function f) {
     81  byte[] b = getFunctionClassBytes(f.getClass());
     82  f.setClassBytes(b);
     83  return b;
    7084    }
    7185
  • branches/less-reflection/abcl/src/org/armedbear/lisp/Function.java

    r12672 r12698  
    174174        propertyList = putf(propertyList, Symbol.CLASS_BYTES,
    175175                            new JavaObject(bytes));
     176    }
     177
     178    public final LispObject getClassBytes() {
     179  LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
     180  if(o != NIL) {
     181      return o;
     182  } else {
     183      ClassLoader c = getClass().getClassLoader();
     184      if(c instanceof FaslClassLoader) {
     185    return new JavaObject(((FaslClassLoader) c).getFunctionClassBytes(this));
     186      } else {
     187    return NIL;
     188      }
     189  }
     190    }
     191
     192    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
     193    public static final class pf_function_class_bytes extends Primitive {
     194  public pf_function_class_bytes() {
     195      super("function-class-bytes", PACKAGE_SYS, false, "function");
     196        }
     197        @Override
     198        public LispObject execute(LispObject arg) {
     199            if (arg instanceof Function) {
     200                return ((Function) arg).getClassBytes();
     201      }
     202            return type_error(arg, Symbol.FUNCTION);
     203        }
    176204    }
    177205
  • branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp

    r12680 r12698  
    616616
    617617        (when (> *class-number* 0)
    618     (let* ((basename (base-classname))
    619            (expr `(lambda (fasl-loader fn-index)
    620         (identity fasl-loader) ;;to avoid unused arg
    621         ;;Ugly: should export & import JVM:: symbols
    622         (ecase fn-index
    623           ,@(loop
    624                :for i :from 1 :to *class-number*
    625                :collect
    626            (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
    627              `(,(1- i)
    628                 (jvm::with-inline-code ()
    629             (jvm::emit 'jvm::aload 1)
    630             (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
    631                    nil jvm::+java-object+)
    632             (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
    633             (jvm::emit 'jvm::dup)
    634             (jvm::emit-push-constant-int ,(1- i))
    635             (jvm::emit 'jvm::new ,class)
    636             (jvm::emit 'jvm::dup)
    637             (jvm::emit-invokespecial-init ,class '())
    638             (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
    639                    (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
    640             (jvm::emit 'jvm::pop))
    641                 t))))))
    642            (classname (fasl-loader-classname))
    643            (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
    644                      *output-file-pathname*))))
    645       (jvm::with-saved-compiler-policy
    646           (jvm::with-file-compilation
    647         (with-open-file
    648             (f classfile
    649          :direction :output
    650          :element-type '(unsigned-byte 8)
    651          :if-exists :supersede)
    652           (jvm:compile-defun nil expr nil
    653                  classfile f nil)))))
     618    (generate-loader-function)
    654619    (write (list 'setq '*fasl-loader*
    655620           `(sys::make-fasl-class-loader
     
    701666    (values (truename output-file) warnings-p failure-p)))
    702667
     668(defun generate-loader-function ()
     669  (let* ((basename (base-classname))
     670   (expr `(lambda (fasl-loader fn-index)
     671      (identity fasl-loader) ;;to avoid unused arg
     672      (ecase fn-index
     673        ,@(loop
     674       :for i :from 1 :to *class-number*
     675       :collect
     676       (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
     677         `(,(1- i)
     678            (jvm::with-inline-code ()
     679        (jvm::emit 'jvm::aload 1)
     680        (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
     681               nil jvm::+java-object+)
     682        (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
     683        (jvm::emit 'jvm::dup)
     684        (jvm::emit-push-constant-int ,(1- i))
     685        (jvm::emit 'jvm::new ,class)
     686        (jvm::emit 'jvm::dup)
     687        (jvm::emit-invokespecial-init ,class '())
     688        (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
     689               (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
     690        (jvm::emit 'jvm::pop))
     691            t))))))
     692   (classname (fasl-loader-classname))
     693   (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
     694             *output-file-pathname*))))
     695    (jvm::with-saved-compiler-policy
     696  (jvm::with-file-compilation
     697      (with-open-file
     698    (f classfile
     699       :direction :output
     700       :element-type '(unsigned-byte 8)
     701       :if-exists :supersede)
     702        (jvm:compile-defun nil expr nil
     703         classfile f nil))))))
     704
    703705(defun compile-file-if-needed (input-file &rest allargs &key force-compile
    704706                               &allow-other-keys)
  • branches/less-reflection/abcl/src/org/armedbear/lisp/disassemble.lisp

    r11391 r12698  
    4848      (unless (compiled-function-p function)
    4949        (setf function (compile nil function)))
    50       (when (getf (function-plist function) 'class-bytes)
    51         (with-input-from-string
    52           (stream (disassemble-class-bytes (getf (function-plist function) 'class-bytes)))
    53           (loop
    54             (let ((line (read-line stream nil)))
    55               (unless line (return))
    56               (write-string "; ")
    57               (write-string line)
    58               (terpri))))
    59         (return-from disassemble)))
    60     (%format t "; Disassembly is not available.~%")))
     50      (let ((class-bytes (function-class-bytes function)))
     51  (when class-bytes
     52    (with-input-from-string
     53        (stream (disassemble-class-bytes class-bytes))
     54      (loop
     55         (let ((line (read-line stream nil)))
     56     (unless line (return))
     57     (write-string "; ")
     58     (write-string line)
     59     (terpri))))
     60    (return-from disassemble)))
     61      (%format t "; Disassembly is not available.~%"))))
Note: See TracChangeset for help on using the changeset viewer.