Changeset 12698

Timestamp:

05/17/10 18:53:41 (13 years ago)

Author:

astalla

Message:

Load class bytes on demand for disassemble.

Location:

branches/less-reflection/abcl/src/org/armedbear/lisp

Files:

• FaslClassLoader.java (modified) (2 diffs)
• Function.java (modified) (1 diff)
• compile-file.lisp (modified) (2 diffs)
• disassemble.lisp (modified) (1 diff)

branches/less-reflection/abcl/src/org/armedbear/lisp/FaslClassLoader.java

@@ -60 +60 @@
     protected Class<?> findClass(String name) throws ClassNotFoundException {
   try {
-      Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
-      byte[] b = readFunctionBytes(pathname);
+      byte[] b = getFunctionClassBytes(name);
       return defineClass(name, b, 0, b.length);
   } catch(Throwable e) { //TODO handle this better, readFunctionBytes uses Debug.assert() but should return null
@@ -68 +67 @@
       throw new ClassNotFoundException("Function class not found: " + name, e);
   }
+    }
+
+    public byte[] getFunctionClassBytes(String name) {
+  Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
+  return readFunctionBytes(pathname);
+    }
+    
+    public byte[] getFunctionClassBytes(Class<?> functionClass) {
+  return getFunctionClassBytes(functionClass.getName());
+    }
+
+    public byte[] getFunctionClassBytes(Function f) {
+  byte[] b = getFunctionClassBytes(f.getClass());
+  f.setClassBytes(b);
+  return b;
     }
 

branches/less-reflection/abcl/src/org/armedbear/lisp/Function.java

@@ -174 +174 @@
         propertyList = putf(propertyList, Symbol.CLASS_BYTES,
                             new JavaObject(bytes));
+    }
+
+    public final LispObject getClassBytes() {
+  LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
+  if(o != NIL) {
+      return o;
+  } else {
+      ClassLoader c = getClass().getClassLoader();
+      if(c instanceof FaslClassLoader) {
+    return new JavaObject(((FaslClassLoader) c).getFunctionClassBytes(this));
+      } else {
+    return NIL;
+      }
+  }
+    }
+
+    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
+    public static final class pf_function_class_bytes extends Primitive {
+  public pf_function_class_bytes() {
+      super("function-class-bytes", PACKAGE_SYS, false, "function");
+        }
+        @Override
+        public LispObject execute(LispObject arg) {
+            if (arg instanceof Function) {
+                return ((Function) arg).getClassBytes();
+      }
+            return type_error(arg, Symbol.FUNCTION);
+        }
     }
 

branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -616 +616 @@
 
         (when (> *class-number* 0)
-    (let* ((basename (base-classname))
-           (expr `(lambda (fasl-loader fn-index)
-        (identity fasl-loader) ;;to avoid unused arg
-        ;;Ugly: should export & import JVM:: symbols
-        (ecase fn-index
-          ,@(loop
-               :for i :from 1 :to *class-number*
-               :collect
-           (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
-             `(,(1- i)
-                (jvm::with-inline-code ()
-            (jvm::emit 'jvm::aload 1)
-            (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
-                   nil jvm::+java-object+)
-            (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
-            (jvm::emit 'jvm::dup)
-            (jvm::emit-push-constant-int ,(1- i))
-            (jvm::emit 'jvm::new ,class)
-            (jvm::emit 'jvm::dup)
-            (jvm::emit-invokespecial-init ,class '())
-            (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
-                   (list "I" 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 nil
-                 classfile f nil)))))
+    (generate-loader-function)
     (write (list 'setq '*fasl-loader*
            `(sys::make-fasl-class-loader
@@ -701 +666 @@
     (values (truename output-file) warnings-p failure-p)))
 
+(defun generate-loader-function ()
+  (let* ((basename (base-classname))
+   (expr `(lambda (fasl-loader fn-index)
+      (identity fasl-loader) ;;to avoid unused arg
+      (ecase fn-index
+        ,@(loop
+       :for i :from 1 :to *class-number*
+       :collect
+       (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
+         `(,(1- i)
+            (jvm::with-inline-code ()
+        (jvm::emit 'jvm::aload 1)
+        (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
+               nil jvm::+java-object+)
+        (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
+        (jvm::emit 'jvm::dup)
+        (jvm::emit-push-constant-int ,(1- i))
+        (jvm::emit 'jvm::new ,class)
+        (jvm::emit 'jvm::dup)
+        (jvm::emit-invokespecial-init ,class '())
+        (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
+               (list "I" 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 nil
+         classfile f nil))))))
+
 (defun compile-file-if-needed (input-file &rest allargs &key force-compile
                                &allow-other-keys)

branches/less-reflection/abcl/src/org/armedbear/lisp/disassemble.lisp

@@ -48 +48 @@
       (unless (compiled-function-p function)
         (setf function (compile nil function)))
-      (when (getf (function-plist function) 'class-bytes)
-        (with-input-from-string
-          (stream (disassemble-class-bytes (getf (function-plist function) 'class-bytes)))
-          (loop
-            (let ((line (read-line stream nil)))
-              (unless line (return))
-              (write-string "; ")
-              (write-string line)
-              (terpri))))
-        (return-from disassemble)))
-    (%format t "; Disassembly is not available.~%")))
+      (let ((class-bytes (function-class-bytes function)))
+  (when class-bytes
+    (with-input-from-string
+        (stream (disassemble-class-bytes class-bytes))
+      (loop
+         (let ((line (read-line stream nil)))
+     (unless line (return))
+     (write-string "; ")
+     (write-string line)
+     (terpri))))
+    (return-from disassemble)))
+      (%format t "; Disassembly is not available.~%"))))