From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 1 Sep 2010 14:42:09 +0000 (+0000)
Subject: 1.0.42.15: prevent inline expansion from creating refs to dead lambda-vars
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c8ec5e9baf0e79e49aa54c6ac1b2582b74301d5b;p=sbcl.git

1.0.42.15: prevent inline expansion from creating refs to dead lambda-vars

 * Fixes lp#454681.

 * Patch by Alexey. In his words, in reference to the test-case:

   (multiple-value-bind (iterator+977 getter+978)
       (does-not-exist-but-does-not-matter)
     (flet ((iterator+976 ()
              (funcall iterator+977)))
       (declare (inline iterator+976))
       (let ((iterator+976 #'iterator+976))
         (funcall iterator+976)))))

   Inline expansion of ITERATOR+976 tries to refer to a dead
   LAMBDA-VAR ITERATOR+977 of varargs entry, which was substituted
   with ITERATOR+977 of &OPTIONAL processor. Thus the referenced
   variable is dead and is not bound anywhere.

   The attached patch fixes the problem by giving up on inline
   expansion if it tries to make a reference to a dead LAMBDA-VAR,
   similar to the way dead BLOCK tags are treated.
---

diff --git a/NEWS b/NEWS
index 7590b59..16dbb31 100644
--- a/NEWS
+++ b/NEWS
@@ -25,6 +25,8 @@ changes relative to sbcl-1.0.42
     (lp#544421)
   * bug fix: legally dynamic-extent lists and vectors used as
     initialization arguments to MAKE-ARRAY can be stack allocated. (lp#586105)
+  * bug fix: inline-expansion creating references to dead lambda-variables
+    (lp#454681, thanks to Alexey Dejneka)
 
 changes in sbcl-1.0.42 relative to sbcl-1.0.41
   * build changes
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 728a23a..a18ca2a 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -594,8 +594,7 @@
 ;;; functional instead.
 (defun reference-leaf (start next result leaf &optional (name '.anonymous.))
   (declare (type ctran start next) (type (or lvar null) result) (type leaf leaf))
-  (when (functional-p leaf)
-    (assure-functional-live-p leaf))
+  (assure-leaf-live-p leaf)
   (let* ((type (lexenv-find leaf type-restrictions))
          (leaf (or (and (defined-fun-p leaf)
                         (not (eq (defined-fun-inlinep leaf)
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 6641386..aeb2566 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1052,6 +1052,7 @@
 (defun delete-lambda-var (leaf)
   (declare (type lambda-var leaf))
 
+  (setf (lambda-var-deleted leaf) t)
   ;; Iterate over all local calls flushing the corresponding argument,
   ;; allowing the computation of the argument to be deleted. We also
   ;; mark the LET for reoptimization, since it may be that we have
@@ -2035,6 +2036,15 @@ is :ANY, the function name is not checked."
               (memq (functional-kind functional) '(:deleted :zombie))))
     (throw 'locall-already-let-converted functional)))
 
+(defun assure-leaf-live-p (leaf)
+  (typecase leaf
+    (lambda-var
+     (when (lambda-var-deleted leaf)
+       (throw 'locall-already-let-converted leaf)))
+    (functional
+     (assure-functional-live-p leaf))))
+
+
 (defun call-full-like-p (call)
   (declare (type combination call))
   (let ((kind (basic-combination-kind call)))
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 41964ad..5229904 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -1102,7 +1102,11 @@
   ;; This is set by physical environment analysis if it chooses an
   ;; indirect (value cell) representation for this variable because it
   ;; is both set and closed over.
-  indirect)
+  indirect
+  ;; true if the last reference has been deleted (and new references
+  ;; should not be made)
+  deleted
+  )
 
 (def!struct (lambda-var (:include basic-var))
   (flags (lambda-var-attributes)
@@ -1143,6 +1147,8 @@
   `(lambda-var-attributep (lambda-var-flags ,var) ignore))
 (defmacro lambda-var-indirect (var)
   `(lambda-var-attributep (lambda-var-flags ,var) indirect))
+(defmacro lambda-var-deleted (var)
+  `(lambda-var-attributep (lambda-var-flags ,var) deleted))
 
 ;;;; basic node types
 
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 19640d9..8be6ff1 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3505,3 +3505,16 @@
 
 (with-test (:name :dotimes-non-integer-counter-value)
   (assert (raises-error? (dotimes (i 8.6)) type-error)))
+
+(with-test (:name :bug-454681)
+  ;; This used to break due to reference to a dead lambda-var during
+  ;; inline expansion.
+  (assert (compile nil
+                   `(lambda ()
+                      (multiple-value-bind (iterator+977 getter+978)
+                          (does-not-exist-but-does-not-matter)
+                        (flet ((iterator+976 ()
+                                 (funcall iterator+977)))
+                          (declare (inline iterator+976))
+                          (let ((iterator+976 #'iterator+976))
+                            (funcall iterator+976))))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index e552d0a..7382b6f 100644
--- 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.42.14"
+"1.0.42.15"