From: Nikodemus Siivola Date: Sun, 20 Jul 2008 07:52:07 +0000 (+0000) Subject: 1.0.18.26: explain why DX value generators must end their blocks X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cb534036e501667da3b229627bf5169d7fb5a01c;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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))) diff --git a/version.lisp-expr b/version.lisp-expr index 50025b5..5debd19 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.18.25" +"1.0.18.26"