From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 6 Nov 1988 14:38:21 +0000 (+0000)
Subject: Add operations to allow specification of branch preference in pblocks.
X-Git-Tag: 20090517-FFI~12430
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=81ba21c789d2709e2b8d585a18440c59e6dbbf60;p=mit-scheme.git

Add operations to allow specification of branch preference in pblocks.
---

diff --git a/v7/src/compiler/rtlbase/rtlcfg.scm b/v7/src/compiler/rtlbase/rtlcfg.scm
index 0e223648b..f45fa4168 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 4.4 1988/09/07 06:20:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcfg.scm,v 4.5 1988/11/06 14:38:21 cph Exp $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -164,4 +164,26 @@ MIT in each case. |#
 	  (snode-delete! bblock)
 	  (set-rgraph-bblocks! *current-rgraph*
 			       (delq! bblock
-				      (rgraph-bblocks *current-rgraph*)))))))
\ No newline at end of file
+				      (rgraph-bblocks *current-rgraph*)))))))
+
+(define-integrable (pcfg/prefer-consequent! pcfg)
+  (pcfg/prefer-branch! 'CONSEQUENT pcfg))
+
+(define-integrable (pcfg/prefer-alternative! pcfg)
+  (pcfg/prefer-branch! 'ALTERNATIVE pcfg))
+
+(define (pcfg/prefer-branch! branch pcfg)
+  (let loop ((bblock (cfg-entry-node pcfg)))
+    (cond ((pblock? bblock)
+	   (cfg-node-put! bblock cfg/prefer-branch/tag branch))
+	  ((sblock? bblock)
+	   (loop (snode-next bblock)))
+	  (else
+	   (error "PCFG/PREFER-BRANCH!: Unknown bblock type" bblock))))
+  pcfg)
+
+(define-integrable (pnode/preferred-branch pnode)
+  (cfg-node-get pnode cfg/prefer-branch/tag))
+
+(define-integrable cfg/prefer-branch/tag
+  (string->symbol "#[(compiler)cfg/prefer-branch]"))
\ No newline at end of file