1.0.30.34: flushable INITIALIZE-VECTOR

 * Allows deleting simple unused MAKE-ARRAY and VECTOR combinations.

 * Move ASSERT-NO-CONSING and ASSERT-CONSING to compiler-test-util.lisp,
   so that they can be used outside dynamic-extent.impure.lisp.

diff --git a/NEWS b/NEWS
index 7bdf0e5..7986978 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -19,6 +19,7 @@ changes relative to sbcl-1.0.30:
     constant two has been optimized.
   * optimization: ARRAY-IN-BOUNDS-P is resolved at compile-time when
     sufficient type information is available. (thanks to Leslie Polzer)
+  * optimization: unused vector creation can now be optimized away.
   * improvement: a STYLE-WARNING is signalled when a generic function
     clobbers an earlier FTYPE proclamation.
   * improvement: the compiler is able to track the effective type of

diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index 299f49f..a47798e 100644 (file)
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -90,7 +90,7 @@
 
 (defknown initialize-vector ((simple-array * (*)) &rest t)
   (simple-array * (*))
-  (always-translatable)
+  (always-translatable flushable)
   :result-arg 0)
 
 (defknown vector-fill* (t t t t) vector

diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp
index 1ed4fa6..66685b9 100644 (file)
--- a/tests/compiler-test-util.lisp
+++ b/tests/compiler-test-util.lisp
@@ -14,7 +14,9 @@
 (defpackage :compiler-test-util
   (:nicknames :ctu)
   (:use :cl :sb-c :sb-kernel)
-  (:export #:compiler-derived-type
+  (:export #:assert-consing
+           #:assert-no-consing
+           #:compiler-derived-type
            #:find-value-cell-values
            #:find-named-callees))
 
@@ -46,3 +48,23 @@
                            (or (not namep)
                                (equal name (sb-impl::fdefn-name c))))))
           collect (sb-impl::fdefn-fun c))))
+
+(defmacro assert-no-consing (form &optional times)
+  `(%assert-no-consing (lambda () ,form) ,times))
+(defun %assert-no-consing (thunk &optional times)
+  (let ((before (sb-ext:get-bytes-consed))
+        (times (or times 10000)))
+    (declare (type (integer 1 *) times))
+    (dotimes (i times)
+      (funcall thunk))
+    (assert (< (- (sb-ext:get-bytes-consed) before) times))))
+
+(defmacro assert-consing (form &optional times)
+  `(%assert-consing (lambda () ,form) ,times))
+(defun %assert-consing (thunk &optional times)
+  (let ((before (sb-ext:get-bytes-consed))
+        (times (or times 10000)))
+    (declare (type (integer 1 *) times))
+    (dotimes (i times)
+      (funcall thunk))
+    (assert (not (< (- (sb-ext:get-bytes-consed) before) times)))))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 60289eb..b3ef02c 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3225,3 +3225,10 @@
   (let ((f (compile nil `(lambda ()
                            (labels ((k (&optional x) #'k)))))))
     (assert (null (funcall f)))))
+
+(with-test (:name :flush-vector-creation)
+  (let ((f (compile nil `(lambda ()
+                           (dotimes (i 1024)
+                             (vector i i i))
+                           t))))
+    (ctu:assert-no-consing (funcall f))))

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 769ce5d..fec3839 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -14,6 +14,9 @@
 (when (eq sb-ext:*evaluator-mode* :interpret)
   (sb-ext:quit :unix-status 104))
 
+(load "compiler-test-util.lisp")
+(use-package :ctu)
+
 (setq sb-c::*check-consistency* t
       sb-ext:*stack-allocate-dynamic-extent* t)
 
@@ -481,26 +484,6 @@
   (setf (gethash 5 *table*) 13)
   (gethash 5 *table*))
 \f
-(defmacro assert-no-consing (form &optional times)
-  `(%assert-no-consing (lambda () ,form) ,times))
-(defun %assert-no-consing (thunk &optional times)
-  (let ((before (get-bytes-consed))
-        (times (or times 10000)))
-    (declare (type (integer 1 *) times))
-    (dotimes (i times)
-      (funcall thunk))
-    (assert (< (- (get-bytes-consed) before) times))))
-
-(defmacro assert-consing (form &optional times)
-  `(%assert-consing (lambda () ,form) ,times))
-(defun %assert-consing (thunk &optional times)
-  (let ((before (get-bytes-consed))
-        (times (or times 10000)))
-    (declare (type (integer 1 *) times))
-    (dotimes (i times)
-      (funcall thunk))
-    (assert (not (< (- (get-bytes-consed) before) times)))))
-
 (defvar *a-cons* (cons nil nil))
 
 (progn

diff --git a/version.lisp-expr b/version.lisp-expr
index 3da7221..e822dfe 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.30.33"
+"1.0.30.34"