From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 22 Apr 2008 09:56:37 +0000 (+0000)
Subject: 1.0.16.4: correct nested DX reasoning
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f7ba8c211a140c8c517c1122581dae63bedf672a;p=sbcl.git

1.0.16.4: correct nested DX reasoning

 * Propagate dynamic-extentness to an argument of a function whose
   result is going to be dx-allocated only if all uses of the argument
   lvars are good-for-dx combinations -- otherwise we may accidentally
   cause DX allocation of things accessible via other variables.
---

diff --git a/NEWS b/NEWS
index 65c7865..1d33ffc 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-1.0.17 relative to 1.0.16:
+  * bug fix: dynamic extent allocation of nested lists and vectors
+    could leak to otherwise accessible parts.
   * bug fix: invalid optimization of heap-allocated alien variable
     reference.
   * bug fix: fasl header checking is less vulnerable to different
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index bd3c298..915727f 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -389,6 +389,12 @@
                (combination-fun-info use))
          (funcall it use))))
 
+(defun lvar-good-for-dx-p (lvar)
+  (let ((uses (lvar-uses lvar)))
+    (if (listp uses)
+        (every #'use-good-for-dx-p uses)
+        (use-good-for-dx-p uses))))
+
 (declaim (inline block-to-be-deleted-p))
 (defun block-to-be-deleted-p (block)
   (or (block-delete-p block)
diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 3faf635..3b57132 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -54,6 +54,7 @@
     ;; combination, and its arguments are potentially DX as well.
     (flet ((recurse (use)
              (loop for arg in (combination-args use)
+                   when (lvar-good-for-dx-p arg)
                    append (handle-nested-dynamic-extent-lvars arg))))
       (cons lvar
             (if (listp uses)
diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index d22342d..d82513d 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -291,4 +291,14 @@
     (assert (every (lambda (x) (eql x 0)) a))))
 (bdowning-2005-iv-16)
 
+
+(defun-with-dx let-converted-vars-dx-allocated-bug (x y z)
+  (let* ((a (list x y z))
+         (b (list x y z))
+         (c (list a b)))
+    (declare (dynamic-extent c))
+    (values (first c) (second c))))
+(multiple-value-bind (i j) (let-converted-vars-dx-allocated-bug 1 2 3)
+  (assert (and (equal i j)
+               (equal i (list 1 2 3)))))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 6de3458..bfc9de7 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.16.3"
+"1.0.16.4"