From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 2 Nov 1988 21:49:33 +0000 (+0000)
Subject: Be more careful when `sblock-continuation' is known.  If the
X-Git-Tag: 20090517-FFI~12463
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=95a4b6a66a2965bb1dd046c5b815295db51a5bae;p=mit-scheme.git

Be more careful when `sblock-continuation' is known.  If the
continuation has already been generated, we were previously generating
a jump to the continuation at this point.  This jump was dead code
because nobody referenced it.
---

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index 12db4faae..6ce154163 100644
--- a/v7/src/compiler/back/linear.scm
+++ b/v7/src/compiler/back/linear.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.5 1988/09/15 08:39:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.6 1988/11/02 21:49:33 cph Exp $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -48,9 +48,13 @@ MIT in each case. |#
 	   (lambda ()
 	     (LAP ,@(bblock-instructions bblock)
 		  ,@(if (sblock? bblock)
-			(linearize-sblock-next
-			 (or (snode-next bblock)
-			     (sblock-continuation bblock)))
+			(let ((next (snode-next bblock)))
+			  (if next
+			      (linearize-sblock-next next (bblock-label next))
+			      (let ((bblock (sblock-continuation bblock)))
+				(if (and bblock (not (node-marked? bblock)))
+				    (linearize-bblock bblock)
+				    (LAP)))))
 			(linearize-pblock bblock
 					  (pnode-consequent bblock)
 					  (pnode-alternative bblock)))))))
@@ -58,13 +62,10 @@ MIT in each case. |#
 	  (LAP ,(lap:make-label-statement (bblock-label bblock)) ,@(kernel))
 	  (kernel))))
 
-  (define (linearize-sblock-next bblock)
-    (cond ((not bblock)
-	   (LAP))
-	  ((node-marked? bblock)
-	   (LAP ,(lap:make-unconditional-branch (bblock-label bblock))))
-	  (else
-	   (linearize-bblock bblock))))
+  (define (linearize-sblock-next bblock label)
+    (if (node-marked? bblock)
+	(LAP ,(lap:make-unconditional-branch label))
+	(linearize-bblock bblock)))
 
   (define (linearize-pblock pblock cn an)
     (if (node-marked? cn)
diff --git a/v7/src/compiler/rtlbase/rtline.scm b/v7/src/compiler/rtlbase/rtline.scm
index 0eb474acf..2b624ecc6 100644
--- a/v7/src/compiler/rtlbase/rtline.scm
+++ b/v7/src/compiler/rtlbase/rtline.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtline.scm,v 4.6 1988/09/15 08:41:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtline.scm,v 4.7 1988/11/02 21:48:58 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -132,9 +132,14 @@ MIT in each case. |#
 			    (loop (rinst-next rinst))))
 		     ((sblock? bblock)
 		      (cons (rinst-rtl rinst)
-			    (linearize-sblock-next
-			     (or (snode-next bblock)
-				 (sblock-continuation bblock)))))
+			    (let ((next (snode-next bblock)))
+			      (if next
+				  (linearize-sblock-next next)
+				  (let ((bblock (sblock-continuation bblock)))
+				    (if (and bblock
+					     (not (node-marked? bblock)))
+					(linearize-bblock bblock)
+					'()))))))
 		     (else
 		      (linearize-pblock bblock
 					(rinst-rtl rinst)
@@ -144,13 +149,10 @@ MIT in each case. |#
 	  `(,(rtl:make-label-statement (bblock-label bblock)) ,@(kernel))
 	  (kernel))))
 
-  (define (linearize-sblock-next sblock)
-    (cond ((not sblock)
-	   '())
-	  ((node-marked? sblock)
-	   `(,(rtl:make-jump-statement (bblock-label sblock))))
-	  (else
-	   (linearize-bblock sblock))))
+  (define (linearize-sblock-next bblock)
+    (if (node-marked? bblock)
+	`(,(rtl:make-jump-statement (bblock-label bblock)))
+	(linearize-bblock bblock)))
 
   (define (linearize-pblock pblock predicate cn an)
     pblock