From 8b367c9dc077bbe307d9a59429510a6e16026a91 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 19 Feb 1990 10:48:00 +0000 Subject: [PATCH] In the NODE-ENDS-BLOCK cleanup computation, we should associate the cleanup with the block holding the mess-up node, rather than the cleanup-start continuation. --- compiler/ir1util.lisp | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index e1cd0eff6..da35d2c6d 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -415,21 +415,23 @@ (setf (continuation-block last-cont) new-block))) (setf (continuation-block cont) new-block)) - (do ((cup (find-enclosing-cleanup cleanup) - (find-enclosing-cleanup (cleanup-enclosing cup)))) - ((null cup)) - (when (eq (continuation-block (cleanup-start cup)) new-block) - (do ((cup (find-enclosing-cleanup (cleanup-enclosing cup)) - (find-enclosing-cleanup (cleanup-enclosing cup)))) - ((null cup) - (let ((start-cleanup (block-start-cleanup block))) + (let ((start-cleanup (block-start-cleanup block))) + (do ((cup (find-enclosing-cleanup cleanup) + (find-enclosing-cleanup (cleanup-enclosing cup)))) + ((null cup)) + (when (eq (node-block (continuation-use (cleanup-start cup))) + new-block) + (do ((cup (find-enclosing-cleanup (cleanup-enclosing cup)) + (find-enclosing-cleanup (cleanup-enclosing cup)))) + ((null cup) (setf (block-end-cleanup block) start-cleanup) - (setf (block-start-cleanup new-block) start-cleanup))) - (unless (eq (continuation-block (cleanup-start cup)) new-block) - (setf (block-end-cleanup block) cup) - (setf (block-start-cleanup new-block) cup) - (return))) - (return))) + (setf (block-start-cleanup new-block) start-cleanup)) + (let ((cb (node-block (continuation-use (cleanup-start cup))))) + (unless (eq cb new-block) + (setf (block-end-cleanup block) cup) + (setf (block-start-cleanup new-block) cup) + (return)))) + (return)))) (setf (block-type-asserted block) t) (setf (block-test-modified block) t)))) -- GitLab