Changeset 13466


Ignore:
Timestamp:
08/12/11 12:08:25 (10 years ago)
Author:
ehuelsmann
Message:

Reduce load time of nested functions and the number of class loader objects.

This commit groups all nested function objects resulting from a COMPILE call
into one class loader (instead of a class loader each). Additionally, nested
function objects aren't instantiated using reflection anymore, instead, the
'new' instruction is used, winning a factor 100 per local function.

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

Legend:

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

    r13445 r13466  
    707707  autoload(PACKAGE_SYS, "get-fasl-function", "FaslClassLoader", false);
    708708
     709  autoload(PACKAGE_SYS, "make-memory-class-loader", "MemoryClassLoader", false);
     710  autoload(PACKAGE_SYS, "put-memory-function", "MemoryClassLoader", false);
     711  autoload(PACKAGE_SYS, "get-memory-function", "MemoryClassLoader", false);
     712       
    709713        autoload(Symbol.SET_CHAR, "StringFunctions");
    710714        autoload(Symbol.SET_SCHAR, "StringFunctions");
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r13464 r13466  
    4949                 pool-class pool-field pool-method pool-int
    5050                 pool-float pool-long pool-double))
     51
     52(declaim (special *memory-class-loader*))
    5153
    5254(defun pool-name (name)
     
    22072209          (t
    22082210           (dformat t "compile-local-function-call default case~%")
    2209            (let* ((g (if *file-compilation*
    2210                          (declare-local-function local-function)
    2211                          (declare-object
    2212                           (local-function-function local-function)))))
     2211           (let* ((g (declare-local-function local-function)))
    22132212             (emit-getstatic *this-class* g +lisp-object+)
    22142213                                        ; Stack: template-function
     
    40644063             (setf (local-function-class-file local-function)
    40654064                   (compiland-class-file compiland))
    4066              (setf (local-function-function local-function)
    4067                    (load-compiled-function
    4068                     (sys::%get-output-stream-bytes stream))))))))
     4065             (let ((bytes (sys::%get-output-stream-bytes stream)))
     4066               (sys::put-memory-function *memory-class-loader*
     4067                                         (class-name-internal
     4068                                          (abcl-class-file-class-name
     4069                                           (compiland-class-file compiland)))
     4070                   bytes)))))))
    40694071
    40704072(defun emit-make-compiled-closure-for-labels
     
    40974099             (setf (local-function-class-file local-function)
    40984100                   (compiland-class-file compiland))
    4099              (let ((g (declare-object
    4100                        (load-compiled-function
    4101                         (sys::%get-output-stream-bytes stream)))))
     4101             (let* ((bytes (sys::%get-output-stream-bytes stream))
     4102                    (g (declare-local-function local-function)))
     4103               (sys::put-memory-function *memory-class-loader*
     4104                                         (class-name-internal
     4105                                          (abcl-class-file-class-name
     4106                                           (compiland-class-file compiland)))
     4107                  bytes)
    41024108               (emit-make-compiled-closure-for-labels
    4103                 local-function compiland g)))))))
     4109                local-function compiland g)
     4110               ))))))
    41044111
    41054112(defknown p2-flet-node (t t t) t)
     
    41534160         (with-open-stream (stream (sys::%make-byte-array-output-stream))
    41544161           (compile-and-write-to-stream compiland stream)
    4155            (emit-load-externalized-object (load-compiled-function
    4156                                            (sys::%get-output-stream-bytes stream))))))
     4162           (let ((bytes (sys::%get-output-stream-bytes stream)))
     4163             (sys::put-memory-function *memory-class-loader*
     4164                                       (class-name-internal
     4165                                        (abcl-class-file-class-name
     4166                                         (compiland-class-file compiland)))
     4167                  bytes)
     4168             (emit-getstatic *this-class*
     4169                         (declare-local-function
     4170                          (make-local-function
     4171                           :class-file (compiland-class-file compiland)))
     4172                         +lisp-object+)))))
    41574173  (cond ((null *closure-variables*))    ; Nothing to do.
    41584174        ((compiland-closure-register *current-compiland*)
     
    41864202                              'stack nil))
    41874203            (t
    4188              (let ((g (if *file-compilation*
    4189                           (declare-local-function local-function)
    4190                           (declare-object
    4191                            (local-function-function local-function)))))
     4204             (let ((g (declare-local-function local-function)))
    41924205               (emit-getstatic *this-class* g +lisp-object+)
    41934206                                        ; Stack: template-function
     
    42274240                              'stack nil))
    42284241            (t
    4229              (let ((g (if *file-compilation*
    4230                           (declare-local-function local-function)
    4231                           (declare-object
    4232                            (local-function-function local-function)))))
     4242             (let ((g (declare-local-function local-function)))
    42334243               (emit-getstatic *this-class*
    42344244                     g +lisp-object+))))) ; Stack: template-function
     
    73817391  "Compiles a lambda expression `form'. If `filespec' is NIL,
    73827392a random Java class name is generated, if it is non-NIL, it's used
    7383 to derive a Java class name from."
     7393to derive a Java class name from.
     7394
     7395Returns the a abcl-class-file structure containing the description of the
     7396generated class."
    73847397  (aver (eq (car form) 'LAMBDA))
    73857398  (catch 'compile-defun-abort
     
    74037416                                                              environment)
    74047417                                 :class-file class-file)
    7405                  stream))))
     7418                 stream)
     7419      class-file)))
    74067420
    74077421(defvar *catch-errors* t)
     
    74977511  ;; This function is part of the call chain from COMPILE, but
    74987512  ;; not COMPILE-FILE
    7499   (let* (compiled-function)
     7513  (let* (compiled-function
     7514         (*memory-class-loader* (sys::make-memory-class-loader)))
    75007515    (with-compilation-unit ()
    75017516      (with-saved-compiler-policy
    75027517          (setf compiled-function
    7503                 (load-compiled-function
    7504                  (with-open-stream (s (sys::%make-byte-array-output-stream))
    7505                    (compile-defun name expr env nil s nil)
    7506                    (finish-output s)
    7507                    (sys::%get-output-stream-bytes s))))))
     7518                (with-open-stream (s (sys::%make-byte-array-output-stream))
     7519                  (let* ((class-file (compile-defun name expr env nil s nil))
     7520                         (bytes (progn
     7521                                  (finish-output s)
     7522                                  (sys::%get-output-stream-bytes s)))
     7523                         (class-name (class-name-internal
     7524                                      (abcl-class-file-class-name class-file))))
     7525                    (sys::put-memory-function *memory-class-loader*
     7526                                              class-name bytes)
     7527                    (sys::get-memory-function *memory-class-loader*
     7528                                              class-name))))))
    75087529    (when (and name (functionp compiled-function))
    75097530      (sys::set-function-definition name compiled-function definition))
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r13448 r13466  
    381381  compiland
    382382  inline-expansion
    383   function    ;; the function loaded through load-compiled-function
    384383  class-file  ;; the class file structure for this function
    385384  variable    ;; the variable which contains the loaded compiled function
Note: See TracChangeset for help on using the changeset viewer.