+ (original-start (ir2-block-start-stack 2block))
+ (end (ir2-block-end-stack 2block))
+ (new-end end))
+ (dolist (succ (block-succ block))
+ (setq new-end (merge-uvl-live-sets new-end
+ (ir2-block-start-stack (block-info succ)))))
+ (map-block-nlxes (lambda (nlx-info)
+ (let* ((nle (nlx-info-target nlx-info))
+ (nle-start-stack (ir2-block-start-stack
+ (block-info nle)))
+ (exit-lvar (nlx-info-lvar nlx-info))
+ (next-stack (if exit-lvar
+ (remove exit-lvar nle-start-stack)
+ nle-start-stack)))
+ (setq new-end (merge-uvl-live-sets
+ new-end next-stack))))
+ block
+ (lambda (dx-cleanup)
+ (dolist (lvar (cleanup-info dx-cleanup))
+ (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)
+
+ (let ((start new-end))
+ (setq start (set-difference start (ir2-block-pushed 2block)))
+ (setq start (merge-uvl-live-sets start (ir2-block-popped 2block)))
+
+ ;; We cannot delete unused UVLs during NLX, so all UVLs live at
+ ;; ENTRY will be actually live at NLE.
+ ;;
+ ;; BUT, UNWIND-PROTECTor is called in the environment, which has
+ ;; nothing in common with the environment of its entry. So we
+ ;; fictively compute its stack from the containing cleanups, but
+ ;; do not propagate additional LVARs from the entry, thus
+ ;; preveting bogus stack cleanings.
+ ;;
+ ;; TODO: Insert a check that no values are discarded in UWP. Or,
+ ;; maybe, we just don't need to create NLX-ENTRY for UWP?
+ (when (and (eq (component-head (block-component block))
+ (first (block-pred block)))
+ (not (bind-p (block-start-node block))))
+ (let* ((nlx-info (nle-block-nlx-info block))
+ (cleanup (nlx-info-cleanup nlx-info)))
+ (unless (eq (cleanup-kind cleanup) :unwind-protect)
+ (let* ((entry-block (node-block (cleanup-mess-up cleanup)))
+ (entry-stack (ir2-block-start-stack (block-info entry-block))))
+ (setq start (merge-uvl-live-sets start entry-stack))))))
+
+ (when *check-consistency*
+ (aver (subsetp original-start start)))
+ (cond ((subsetp start original-start)
+ nil)
+ (t
+ (setf (ir2-block-start-stack 2block) start)
+ t)))))