From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 8 Aug 1987 23:21:07 +0000 (+0000)
Subject: Mark the graph when compressing bblocks to prevent walking parts of it
X-Git-Tag: 20090517-FFI~13171
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=48bb117f1b3dfe677abdd36e540a0ebe143f3f17;p=mit-scheme.git

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.
---

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)