1.0.45.5: life: Propagate implicit value cells through tail-calls.

  * When setting up "environment tn conflicts", recurse through
callee environments when processing a block that ends in a tail
local combination and a TN that represents an "implicit" value
cell.

  * This closes the hole where a tail-local-call would replace
the stack frame which allocated a closed-over lambda-var, but
the inbound stack frame didn't know about the storage for the
variable, leading to badness.  Hopefully the last bug with the
dynamic-extent closure representation changes.

  * This patch fixes what 1.0.44.34 was supposed to KLUDGE
around, and finishes fixing lp#681092 (the first half of the
fix being 1.0.44.33).

diff --git a/NEWS b/NEWS
index 76c54b1..fd5dbc1 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes relative to sbcl-1.0.45:
+  * bug fix: local tail calls to DYNAMIC-EXTENT functions can no longer cause
+    lifetime analysis to overwrite closed-over variables (lp#681092).
+
 changes in sbcl-1.0.45 relative to sbcl-1.0.44:
   * enhancement: ~/ and ~user/ are treated specially in pathnames.
     Refer to documentation for details.

diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp
index 6a89ee3..16449af 100644 (file)
--- a/src/compiler/life.lisp
+++ b/src/compiler/life.lisp
@@ -418,11 +418,31 @@
         (return))))
   (values))
 
+;;; Return true if TN represents a closed-over variable with an
+;;; "implicit" value-cell.
+(defun implicit-value-cell-tn-p (tn)
+  (let ((leaf (tn-leaf tn)))
+    (and (lambda-var-p leaf)
+         (lambda-var-indirect leaf)
+         (not (lambda-var-explicit-value-cell leaf)))))
+
+;;; If BLOCK ends with a TAIL LOCAL COMBINATION, the function called.
+;;; Otherwise, NIL.
+(defun block-tail-local-call-fun (block)
+  (let ((node (block-last block)))
+    (when (and (combination-p node)
+               (eq :local (combination-kind node))
+               (combination-tail-p node))
+      (ref-leaf (lvar-uses (combination-fun node))))))
+
 ;;; Iterate over all the blocks in ENV, setting up :LIVE conflicts for
 ;;; TN. We make the TN global if it isn't already. The TN must have at
 ;;; least one reference.
-(defun setup-environment-tn-conflicts (component tn env debug-p)
-  (declare (type component component) (type tn tn) (type physenv env))
+(defun setup-environment-tn-conflicts (component tn env debug-p &optional parent-envs)
+  (declare (type component component) (type tn tn) (type physenv env) (type list parent-envs))
+  (when (member env parent-envs)
+    ;; Prevent infinite recursion due to recursive tail calls.
+    (return-from setup-environment-tn-conflicts (values)))
   (when (and debug-p
              (not (tn-global-conflicts tn))
              (tn-local tn))
@@ -437,7 +457,15 @@
                         prev))))
         (do ((b last (ir2-block-prev b)))
             ((not (eq (ir2-block-block b) block)))
-          (setup-environment-tn-conflict tn b debug-p)))))
+          (setup-environment-tn-conflict tn b debug-p)))
+      ;; If BLOCK ends with a TAIL LOCAL COMBINATION and TN is an
+      ;; "implicit value cell" then setup conflicts for the callee
+      ;; function as well.
+      (let ((fun (and (implicit-value-cell-tn-p tn)
+                      (block-tail-local-call-fun block))))
+        (when fun
+          (setup-environment-tn-conflicts component tn (lambda-physenv fun) debug-p
+                                          (list* env parent-envs))))))
   (values))
 
 ;;; Iterate over all the environment TNs, adding always-live conflicts

diff --git a/version.lisp-expr b/version.lisp-expr
index eae7941..49f58c1 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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.45.4"
+"1.0.45.5"