From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 6 Nov 1988 14:50:00 +0000 (+0000)
Subject: Heed branch preferences when deciding which branch to generate in line.
X-Git-Tag: 20090517-FFI~12428
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c278aa32c3b3dd56a1486add089d75ad714b6da1;p=mit-scheme.git

Heed branch preferences when deciding which branch to generate in line.
---

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index 6ce154163..e6b68cc4e 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.6 1988/11/02 21:49:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.7 1988/11/06 14:50:00 cph Rel $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -68,23 +68,33 @@ MIT in each case. |#
 	(linearize-bblock bblock)))
 
   (define (linearize-pblock pblock cn an)
-    (if (node-marked? cn)
-	(if (node-marked? an)
-	    (LAP ,@((pblock-consequent-lap-generator pblock) (bblock-label cn))
-		 ,(lap:make-unconditional-branch (bblock-label an)))
-	    (LAP ,@((pblock-consequent-lap-generator pblock) (bblock-label cn))
-		 ,@(linearize-bblock an)))
-	(if (node-marked? an)
-	    (LAP ,@((pblock-alternative-lap-generator pblock)
-		    (bblock-label an))
-		 ,@(linearize-bblock cn))
-	    (let ((clabel (bblock-label! cn))
-		  (alternative (linearize-bblock an)))
-	      (LAP ,@((pblock-consequent-lap-generator pblock) clabel)
-		   ,@alternative
-		   ,@(if (node-marked? cn)
-			 (LAP)
-			 (linearize-bblock cn)))))))
+    (let ((heed-preference
+	   (lambda (finish)
+	     (if (eq? 'CONSEQUENT (pnode/preferred-branch pblock))
+		 (finish (pblock-alternative-lap-generator pblock) an cn)
+		 (finish (pblock-consequent-lap-generator pblock) cn an)))))
+      (if (node-marked? cn)
+	  (if (node-marked? an)
+	      (heed-preference
+	       (lambda (generator cn an)
+		 (LAP ,@(generator (bblock-label cn))
+		      ,(lap:make-unconditional-branch (bblock-label an)))))
+	      (LAP ,@((pblock-consequent-lap-generator pblock)
+		      (bblock-label cn))
+		   ,@(linearize-bblock an)))
+	  (if (node-marked? an)
+	      (LAP ,@((pblock-alternative-lap-generator pblock)
+		      (bblock-label an))
+		   ,@(linearize-bblock cn))
+	      (heed-preference
+	       (lambda (generator cn an)
+		 (let ((clabel (bblock-label! cn))
+		       (alternative (linearize-bblock an)))
+		   (LAP ,@(generator clabel)
+			,@alternative
+			,@(if (node-marked? cn)
+			      (LAP)
+			      (linearize-bblock cn))))))))))
 
   (linearize-bblock bblock))
 
diff --git a/v7/src/compiler/rtlbase/rtline.scm b/v7/src/compiler/rtlbase/rtline.scm
index 2b624ecc6..0c71cfdf9 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.7 1988/11/02 21:48:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtline.scm,v 4.8 1988/11/06 14:49:45 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -155,24 +155,32 @@ MIT in each case. |#
 	(linearize-bblock bblock)))
 
   (define (linearize-pblock pblock predicate cn an)
-    pblock
-    (if (node-marked? cn)
-	(if (node-marked? an)
-	    `(,(rtl:make-jumpc-statement predicate (bblock-label cn))
-	      ,(rtl:make-jump-statement (bblock-label an)))
-	    `(,(rtl:make-jumpc-statement predicate (bblock-label cn))
-	      ,@(linearize-bblock an)))
-	(if (node-marked? an)
-	    `(,(rtl:make-jumpc-statement (rtl:negate-predicate predicate)
-					 (bblock-label an))
-	      ,@(linearize-bblock cn))
-	    (let ((clabel (bblock-label! cn))
-		   (alternative (linearize-bblock an)))
-	      `(,(rtl:make-jumpc-statement predicate clabel)
-		,@alternative
-		,@(if (node-marked? cn)
-		      '()
-		      (linearize-bblock cn)))))))
+    (let ((heed-preference
+	   (lambda (finish)
+	     (if (eq? 'CONSEQUENT (pnode/preferred-branch pblock))
+		 (finish (rtl:negate-predicate predicate) an cn)
+		 (finish predicate cn an)))))
+      (if (node-marked? cn)
+	  (if (node-marked? an)
+	      (heed-preference
+	       (lambda (predicate cn an)
+		 `(,(rtl:make-jumpc-statement predicate (bblock-label cn))
+		   ,(rtl:make-jump-statement (bblock-label an)))))
+	      `(,(rtl:make-jumpc-statement predicate (bblock-label cn))
+		,@(linearize-bblock an)))
+	  (if (node-marked? an)
+	      `(,(rtl:make-jumpc-statement (rtl:negate-predicate predicate)
+					   (bblock-label an))
+		,@(linearize-bblock cn))
+	      (heed-preference
+	       (lambda (predicate cn an)
+		 (let ((clabel (bblock-label! cn))
+		       (alternative (linearize-bblock an)))
+		   `(,(rtl:make-jumpc-statement predicate clabel)
+		     ,@alternative
+		     ,@(if (node-marked? cn)
+			   '()
+			   (linearize-bblock cn))))))))))
 
   (linearize-bblock bblock))