From da94ef4b838ab357d22a41977b85ec27ab604640 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 25 Feb 2016 01:08:20 +0300
Subject: [PATCH] Fix an AVER caused by ignoring closed over variables.

The recent optimization where zeroes in (vector 0 0) are not written
confuses the register allocator when (vector x) is in a closure and X
has a type of (EQL 0), since the closure is allocated but the value is
never used.
Only consider strict constants, this is similar to
5b4dae02596a5d6a6c5db9fed2de089d1bd5481f.

Reported by Eric Marsden.
---
 src/compiler/generic/vm-ir2tran.lisp | 14 ++++++++++++--
 tests/compiler.pure.lisp             | 20 ++++++++++++++++++++
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp
index dbc15b6b9..aee38895c 100644
--- a/src/compiler/generic/vm-ir2tran.lisp
+++ b/src/compiler/generic/vm-ir2tran.lisp
@@ -79,7 +79,12 @@
              ;; dynamic-space is already zeroed
              (and (or (not lvar)
                       (not (lvar-dynamic-extent lvar)))
-                  (constant-lvar-p x)
+                  ;; KLUDGE: can't ignore type-derived
+                  ;; constants since they can be closed over
+                  ;; and not using them confuses the register
+                  ;; allocator.
+                  ;; See compiler.pure/cons-zero-initialization
+                  (strictly-constant-lvar-p x)
                   (eql (lvar-value x) 0))))
      (dolist (init inits)
        (let ((kind (car init))
@@ -251,7 +256,12 @@
           (let ((value (pop initial-contents)))
             ;; dynamic-space is already zeroed
             (unless (and (not dx-p)
-                         (constant-lvar-p value)
+                         ;; KLUDGE: can't ignore type-derived
+                         ;; constants since they can be closed over
+                         ;; and not using them confuses the register
+                         ;; allocator.
+                         ;; See compiler.pure/vector-zero-initialization
+                         (strictly-constant-lvar-p value)
                          (if character
                              (eql (char-code (lvar-value value)) 0)
                              (eql (lvar-value value) 0)))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 1fb8acaed..1c492d4ae 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -5757,3 +5757,23 @@
                             (isqrt (count (the bit i) #*11101))))
                         1)
                2)))
+
+(with-test (:name :vector-zero-initialization)
+  (assert (equalp (funcall (funcall (checked-compile
+                              `(lambda (x b)
+                                 (declare ((eql 0) x)
+                                          (optimize (debug 2)))
+                                 (lambda ()
+                                   (vector x (isqrt b)))))
+                                    0 4))
+                  #(0 2))))
+
+(with-test (:name :cons-zero-initialization)
+  (assert (equalp (funcall (funcall (checked-compile
+                              `(lambda (x b)
+                                 (declare ((eql 0) x)
+                                          (optimize (debug 2)))
+                                 (lambda ()
+                                   (cons x (isqrt b)))))
+                                    0 4))
+                  '(0 . 2))))
-- 
2.11.4.GIT