Changeset 12630 for branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

04/23/10 21:23:02 (13 years ago)

Author:

astalla

Message:

First rough attempt at a fasl classloader to load local functions using new.
Top-level functions are loaded through the same classloader but still using
reflection.

File:

• branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (6 diffs)

branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -199 +199 @@
           n)))
 
+(defconstant +fasl-loader-class+
+  "org/armedbear/lisp/FaslClassLoader")
 (defconstant +java-string+ "Ljava/lang/String;")
 (defconstant +java-object+ "Ljava/lang/Object;")
@@ -2175 +2177 @@
    (setf g (symbol-name (gensym "LFUN")))
    (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
+    (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
     (*code* *static-code*))
      ;; fixme *declare-inline*
      (declare-field g +lisp-object+ +field-access-default+)
-     (emit 'ldc (pool-string (file-namestring pathname)))
-     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
-      (list +java-string+) +lisp-object+)
+     (emit 'new class-name)
+     (emit 'dup)
+     (emit-invokespecial-init class-name '())
+
+     ;(emit 'ldc (pool-string (pathname-name pathname)))
+     ;(emit-invokestatic +fasl-loader-class+ "faslLoadFunction"
+     ;(list +java-string+) +lisp-object+)
+
+;     (emit 'ldc (pool-string (file-namestring pathname)))
+     
+;     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
+;     (list +java-string+) +lisp-object+)
      (emit 'putstatic *this-class* g +lisp-object+)
      (setf *static-code* *code*)
@@ -2331 +2343 @@
   (let ((g (symbol-name (gensym "INSTANCE")))
         saved-code)
+    (sys::%format t "OBJ = ~A ~S~%" (type-of obj) obj)
     (let* ((s (with-output-to-string (stream) (dump-form obj stream)))
            (*code* (if *declare-inline* *code* *static-code*)))
@@ -5316 +5329 @@
                (emit 'getstatic *this-class*
                      g +lisp-object+))))) ; Stack: template-function
-         ((member name *functions-defined-in-current-file* :test #'equal)
+         ((and (member name *functions-defined-in-current-file* :test #'equal)
+         (not (notinline-p name)))
           (emit 'getstatic *this-class*
                 (declare-setf-function name) +lisp-object+)
@@ -7892 +7906 @@
       (compile-function-call form target representation))))
 
+#|(defknown p2-java-jcall (t t t) t)
+(define-inlined-function p2-java-jcall (form target representation)
+  ((and (> *speed* *safety*)
+  (< 1 (length form))
+  (eq 'jmethod (car (cadr form)))
+  (every #'stringp (cdr (cadr form)))))
+  (let ((m (ignore-errors (eval (cadr form)))))
+    (if m 
+  (let ((must-clear-values nil)
+        (arg-types (raw-arg-types (jmethod-params m))))
+    (declare (type boolean must-clear-values))
+    (dolist (arg (cddr form))
+      (compile-form arg 'stack nil)
+      (unless must-clear-values
+        (unless (single-valued-p arg)
+    (setf must-clear-values t))))
+    (when must-clear-values
+      (emit-clear-values))
+    (dotimes (i (jarray-length raw-arg-types))
+      (push (jarray-ref raw-arg-types i) arg-types))
+    (emit-invokevirtual (jclass-name (jmethod-declaring-class m))
+            (jmethod-name m)
+            (nreverse arg-types)
+            (jmethod-return-type m)))
+      ;; delay resolving the method to run-time; it's unavailable now
+      (compile-function-call form target representation))))|#
 
 (defknown p2-char= (t t t) t)
@@ -8862 +8902 @@
   (install-p2-handler 'java:jconstructor   'p2-java-jconstructor)
   (install-p2-handler 'java:jmethod        'p2-java-jmethod)
+;  (install-p2-handler 'java:jcall          'p2-java-jcall)
   (install-p2-handler 'char=               'p2-char=)
   (install-p2-handler 'characterp          'p2-characterp)