1.0.18.26: explain why DX value generators must end their blocks

 * Explanation and test-case from Alexey Dejneka -- mistakes are mine in the
   transcription.

 * Note about REFs to DX closures violating the rule -- which is why we cannot
   assert it right now.

 * Use DO-USES instead of DOLIST in UPDATE-UVL-LIVE-SETS.

 * Fix a stray typo in comment in USE-GOOD-FOR-DX-P.

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index f522cfc..695a9b6 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -402,7 +402,7 @@
   ;; as the original one. It would be either good to have an
   ;; explanation of why casts don't point across components, or an
   ;; explanation of when they do it. ...in the meanwhile AVER that
-  ;; our expactation holds true.
+  ;; our assumption holds true.
   (aver (or (not component) (eq component (node-component use))))
   (or (and (combination-p use)
            (eq (combination-kind use) :known)
@@ -832,6 +832,7 @@
   (let* ((block (node-block node))
          (start (node-next node))
          (last (block-last block)))
+    (check-type last node)
     (unless (eq last node)
       (aver (and (eq (ctran-kind start) :inside-block)
                  (not (block-delete-p block))))

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 66538ae..a65bae3 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -45,15 +45,9 @@
 
 (defun handle-nested-dynamic-extent-lvars (lvar)
   (let ((uses (lvar-uses lvar)))
-    ;; Stack analysis wants DX value generators to end their
-    ;; blocks. Uses of mupltiple used LVARs already end their blocks,
-    ;; so we just need to process used-once LVARs.
-    ;;
-    ;; FIXME: Is this true? I cannot trigger any bad behaviour if I nuke this
-    ;; form, and the only assumption regarding block ends I see in in stack
-    ;; analysis is the one made by MAP-BLOCK-NLXES, which assumes that nodes
-    ;; with cleanups in their lexenv end their blocks. If this one is
-    ;; necessary, we should explain why in more detail. --NS 2008-07-19
+    ;; DX value generators must end their blocks: see UPDATE-UVL-LIVE-SETS.
+    ;; Uses of mupltiple-use LVARs already end their blocks, so we just need
+    ;; to process uses of single-use LVARs.
     (when (node-p uses)
       (node-ends-block uses))
     ;; If this LVAR's USE is good for DX, it is either a CAST, or it

diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp
index 00730cb..51d416d 100644 (file)
--- a/src/compiler/stack.lisp
+++ b/src/compiler/stack.lisp
@@ -94,23 +94,28 @@
                      block
                      (lambda (dx-cleanup)
                        (dolist (lvar (cleanup-info dx-cleanup))
-                         (let ((uses (lvar-uses lvar)))
-                           (dolist (generator (if (listp uses) uses (list uses)))
-                             (let* ((block (node-block generator))
-                                    (2block (block-info block)))
-                               ;; DX objects, living in the LVAR, are
-                               ;; alive in the environment, protected
-                               ;; by the CLEANUP. We also cannot move
-                               ;; them (because, in general, we cannot
-                               ;; track all references to
-                               ;; them). Therefore, everything,
-                               ;; allocated deeper than a DX object,
-                               ;; should be kept alive until the
-                               ;; object is deallocated.
-                               (setq new-end (merge-uvl-live-sets
-                                              new-end (ir2-block-end-stack 2block)))
-                               (setq new-end (merge-uvl-live-sets
-                                              new-end (ir2-block-pushed 2block)))))))))
+                         (do-uses (generator lvar)
+                           (let* ((block (node-block generator))
+                                  (2block (block-info block)))
+                             ;; DX objects, living in the LVAR, are alive in
+                             ;; the environment, protected by the CLEANUP. We
+                             ;; also cannot move them (because, in general, we
+                             ;; cannot track all references to them).
+                             ;; Therefore, everything, allocated deeper than a
+                             ;; DX object -- that is, before the DX object --
+                             ;; should be kept alive until the object is
+                             ;; deallocated.
+                             ;;
+                             ;; Since DX generators end their blocks, we can
+                             ;; find out UVLs allocated before them by looking
+                             ;; at the stack at the end of the block.
+                             ;;
+                             ;; FIXME: This is not quite true: REFs to DX
+                             ;; closures don't end their blocks!
+                             (setq new-end (merge-uvl-live-sets
+                                            new-end (ir2-block-end-stack 2block)))
+                             (setq new-end (merge-uvl-live-sets
+                                            new-end (ir2-block-pushed 2block))))))))
 
     (setf (ir2-block-end-stack 2block) new-end)
 

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 4eb2db3..df9bf95 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -563,4 +563,21 @@
   (def 0 (list :one) (list :two) (list :three))
   (def 1 (make-array 128) (list 1 2 3 4 5 6 7 8) (list 'list))
   (def 2 (list 1) (list 2 3) (list 4 5 6 7)))
+
+;;; Test that unknown-values coming after a DX value won't mess up the stack analysis
+(defun test-update-uvl-live-sets (x y z)
+ (declare (optimize speed (safety 0)))
+ (flet ((bar (a b)
+          (declare (dynamic-extent a))
+          (eval `(list (length ',a) ',b))))
+   (list (bar x y)
+         (bar (list x y z)                  ; dx push
+              (list
+               (multiple-value-call 'list
+                 (eval '(values 1 2 3))     ; uv push
+                 (max y z)
+               )                            ; uv pop
+               14)
+         ))))
+(assert (equal '((0 4) (3 ((1 2 3 5) 14))) (test-update-uvl-live-sets #() 4 5)))
 \f

diff --git a/version.lisp-expr b/version.lisp-expr
index 50025b5..5debd19 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.18.25"
+"1.0.18.26"