[armedbear-cvs] r13463 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Thu Aug 11 10:05:46 2011
New Revision: 13463

Log:
Code generation efficiency: when the closure array is only
read from: don't copy it - ever.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Aug 11 10:04:30 2011	(r13462)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Aug 11 10:05:46 2011	(r13463)
@@ -2162,17 +2162,20 @@
   (let* ((*register* *register*)
          (register (allocate-register nil)))
     (aload (compiland-closure-register compiland))        ;; src
-    (emit-push-constant-int 0)                            ;; srcPos
-    (emit-push-constant-int (length *closure-variables*))
-    (emit-anewarray +lisp-closure-binding+)             ;; dest
-    (emit 'dup)
-    (astore register)  ;; save dest value
-    (emit-push-constant-int 0)                            ;; destPos
-    (emit-push-constant-int (length *closure-variables*)) ;; length
-    (emit-invokestatic +java-system+ "arraycopy"
-                       (list +java-object+ :int
-                             +java-object+ :int :int) nil)
-    (aload register))) ;; reload dest value
+    (when (some #'(lambda (var)
+                    (< 1 (variable-writes var)))
+                *closure-variables*)
+      (emit-push-constant-int 0) ;; srcPos
+      (emit-push-constant-int (length *closure-variables*))
+      (emit-anewarray +lisp-closure-binding+) ;; dest
+      (emit 'dup)
+      (astore register)        ;; save dest value
+      (emit-push-constant-int 0)                          ;; destPos
+      (emit-push-constant-int (length *closure-variables*)) ;; length
+      (emit-invokestatic +java-system+ "arraycopy"
+                         (list +java-object+ :int
+                               +java-object+ :int :int) nil)
+      (aload register)))) ;; reload dest value