From 97120e3bf77287fb3fe5a19c70e30e8eb936f40f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 7 May 1990 11:30:17 +0000 Subject: [PATCH] Rolled back to 1.2, since there seem to be serious problems with the deleted-contiuation merging. --- compiler/ir1opt.lisp | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp index 5481777c3..a431cdf4f 100644 --- a/compiler/ir1opt.lisp +++ b/compiler/ir1opt.lisp @@ -365,7 +365,7 @@ ;;; Joining is easy when the successor's Start continuation is the same from ;;; our Last's Cont. If they differ, then we can still join when the last ;;; continuation has no next and the next continuation has no uses. In this -;;; case, we replace the last continuation with the next before joining the +;;; case, we replace the next continuation with the last before joining the ;;; blocks. ;;; (defun join-successor-if-possible (block) @@ -380,27 +380,24 @@ (lambda (block-lambda block)) (next-lambda (block-lambda next))) (cond ((or (rest (block-pred next)) + (not (eq (continuation-use last-cont) last)) (eq next block) (not (eq (lambda-home lambda) (lambda-home next-lambda))) (not (eq (find-enclosing-cleanup cleanup) (find-enclosing-cleanup next-cleanup)))) nil) - ((and (eq last-cont next-cont) - (eq (continuation-use last-cont) last)) + ((eq last-cont next-cont) (join-blocks block next) t) - ((block-start-uses next) - nil) - ((member (continuation-kind last-cont) '(:deleted :inside-block)) - (assert (not (continuation-dest next-cont))) - (unless (eq (continuation-kind last-cont) :deleted) - (let ((dest (continuation-dest last-cont))) - (when dest - (substitute-continuation next-cont last-cont))) - (delete-continuation last-cont)) - (delete-continuation-use last) - (add-continuation-use last next-cont) - (join-blocks block next) + ((and (null (block-start-uses next)) + (eq (continuation-kind last-cont) :inside-block)) + (let ((next-node (continuation-next next-cont))) + (assert (not (continuation-dest next-cont))) + (delete-continuation next-cont) + (setf (node-prev next-node) last-cont) + (setf (continuation-next last-cont) next-node) + (setf (block-start next) last-cont) + (join-blocks block next)) t) (t nil)))))) -- GitLab