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 0e223648b7d6c0b4a8458f7dec3a48d5cf5d3e42..f45fa41688da73af8b8e5b8c413da7fbbe6fe13f 100644 (file)
--- 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*)))))))
+\f
+(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