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 6ce15416301f19c1f18393cc07bc1c6ab202480f..e6b68cc4e157d6d97b5d5ac81c4a04833fd7681a 100644 (file)
--- 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 2b624ecc68d43da1c74b5120cc2e7617581f3d3a..0c71cfdf9aff7072a9b68d0d4bf2cea6fb00f903 100644 (file)
--- 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))