From 48bb117f1b3dfe677abdd36e540a0ebe143f3f17 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 8 Aug 1987 23:21:07 +0000
Subject: [PATCH] Mark the graph when compressing bblocks to prevent walking
 parts of it twice.  Also be more careful in pblock case since stashed value
 of alternative could have been deleted from the graph by the compression of
 the consequent.

---
 v7/src/compiler/rtlbase/rtlcfg.scm | 41 +++++++++++++++++-------------
 1 file changed, 23 insertions(+), 18 deletions(-)

diff --git a/v7/src/compiler/rtlbase/rtlcfg.scm b/v7/src/compiler/rtlbase/rtlcfg.scm
index e73340f6b..068bec388 100644
--- a/v7/src/compiler/rtlbase/rtlcfg.scm
+++ b/v7/src/compiler/rtlbase/rtlcfg.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcfg.scm,v 1.4 1987/08/08 22:03:38 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcfg.scm,v 1.5 1987/08/08 23:21:07 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -96,24 +96,29 @@ MIT in each case. |#
 (package (bblock-compress!)
 
 (define-export (bblock-compress! bblock)
-  (if (sblock? bblock)
-      (let ((next (snode-next bblock)))
-	(if next
-	    (begin
-	      (if (node-previous=1? next)
+  (if (not (node-marked? bblock))
+      (begin
+	(node-mark! bblock)
+	(if (sblock? bblock)
+	    (let ((next (snode-next bblock)))
+	      (if next
 		  (begin
-		    (set-rinst-next! (rinst-last (bblock-instructions bblock))
-				     (bblock-instructions next))
-		    (set-bblock-instructions! next
-					      (bblock-instructions bblock))
-		    (snode-delete! bblock)))
-	      (bblock-compress! next))))
-      (let ((consequent (pnode-consequent bblock))
-	    (alternative (pnode-alternative bblock)))
-	(if consequent
-	    (bblock-compress! consequent))
-	(if alternative
-	    (bblock-compress! alternative)))))
+		    (if (node-previous=1? next)
+			(begin
+			  (set-rinst-next!
+			   (rinst-last (bblock-instructions bblock))
+			   (bblock-instructions next))
+			  (set-bblock-instructions!
+			   next
+			   (bblock-instructions bblock))
+			  (snode-delete! bblock)))
+		    (bblock-compress! next))))
+	    (begin (let ((consequent (pnode-consequent bblock)))
+		     (if consequent
+			 (bblock-compress! consequent)))
+		   (let ((alternative (pnode-alternative bblock)))
+		     (if alternative
+			 (bblock-compress! alternative))))))))
 
 (define (rinst-last rinst)
   (if (rinst-next rinst)
-- 
2.25.1