From 7ebceb50e5a63b984260c7014fecb6e885b03336 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sun, 9 Nov 2014 07:34:31 +0100
Subject: [PATCH] compiler.cfg.dependence/scheduling: select-parent and roots
 moved to scheduling

the roots stuff is only used by compiler.cfg.scheduling, so it's more
simple to have it there than in compiler.cfg.dependence
---
 .../compiler/cfg/dependence/dependence.factor | 36 +++++++------------
 .../compiler/cfg/scheduling/scheduling.factor | 15 ++++++--
 2 files changed, 24 insertions(+), 27 deletions(-)

diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor
index ceb7ba4518..425ac07590 100644
--- a/basis/compiler/cfg/dependence/dependence.factor
+++ b/basis/compiler/cfg/dependence/dependence.factor
@@ -6,7 +6,6 @@ namespaces sequences sorting make math math.vectors vectors ;
 FROM: namespaces => set ;
 IN: compiler.cfg.dependence
 
-SYMBOL: roots
 SYMBOL: node-number
 
 SYMBOL: +data+
@@ -28,8 +27,6 @@ M: node hashcode* nip number>> ;
         H{ } clone >>precedes
         V{ } clone >>follows ;
 
-: ready? ( node -- ? ) precedes>> assoc-empty? ;
-
 :: precedes ( first second how -- )
     how second first precedes>> set-at ;
 
@@ -79,16 +76,8 @@ M: object add-control-edge 2drop ;
         ] with each
     ] each ;
 
-: set-roots ( nodes -- )
-    [ ready? ] V{ } filter-as roots set ;
-
 : build-dependence-graph ( nodes -- )
-    {
-        [ add-control-edges ]
-        [ add-data-edges ]
-        [ set-follows ]
-        [ set-roots ]
-    } cleave ;
+    [ add-control-edges ] [ add-data-edges ] [ set-follows ] tri ;
 
 ! Sethi-Ulmann numbering
 :: calculate-registers ( node -- registers )
@@ -101,23 +90,22 @@ M: object add-control-edge 2drop ;
     dup node registers<< ;
 
 ! Constructing fan-in trees
-: attach-parent ( node parent -- )
-    [ >>parent drop ] [ [ ?push ] change-children drop ] 2bi ;
-
 : keys-for ( assoc value -- keys )
     '[ nip _ = ] assoc-filter keys ;
 
-: choose-parent ( node -- )
-    ! If a node has control dependences, it has to be a root
-    ! Otherwise, choose one of the data dependences for a parent
-    dup precedes>> +control+ keys-for empty? [
-        dup precedes>> +data+ keys-for [ drop ] [
-            first attach-parent
-        ] if-empty
-    ] [ drop ] if ;
+: attach-parent ( node parent -- )
+    [ >>parent drop ] [ [ ?push ] change-children drop ] 2bi ;
+
+: select-parent ( precedes -- parent/f )
+    ! If a node has no control dependencies, then its parent is its first
+    ! data dependency, if it has one. Otherwise it is a root node.
+    [ +control+ keys-for empty? ] [ +data+ keys-for ?first ] bi f ? ;
+
+: maybe-set-parent ( node -- )
+    dup precedes>> select-parent [ attach-parent ] [ drop ] if* ;
 
 : make-trees ( nodes -- trees )
-    [ [ choose-parent ] each ] [ [ parent>> not ] filter ] bi ;
+    [ [ maybe-set-parent ] each ] [ [ parent>> not ] filter ] bi ;
 
 : initialize-scores ( trees -- )
     [ -1/0. >>parent-index calculate-registers drop ] each ;
diff --git a/basis/compiler/cfg/scheduling/scheduling.factor b/basis/compiler/cfg/scheduling/scheduling.factor
index 313ca79903..924c203fe2 100644
--- a/basis/compiler/cfg/scheduling/scheduling.factor
+++ b/basis/compiler/cfg/scheduling/scheduling.factor
@@ -3,6 +3,7 @@
 USING: accessors arrays assocs compiler.cfg.def-use compiler.cfg.dependence
 compiler.cfg.instructions compiler.cfg.linear-scan.numbering compiler.cfg.rpo
 cpu.architecture fry kernel make math namespaces sequences sets splitting ;
+FROM: namespaces => set ;
 IN: compiler.cfg.scheduling
 
 ! Instruction scheduling to reduce register pressure, from:
@@ -20,6 +21,10 @@ ERROR: bad-delete-at key assoc ;
     children>> building get length
     '[ _ >>parent-index drop ] each ;
 
+SYMBOL: roots
+
+: ready? ( node -- ? ) precedes>> assoc-empty? ;
+
 : remove-node ( node -- )
     [ follows>> members ] keep
     '[ [ precedes>> _ swap check-delete-at ] each ]
@@ -63,10 +68,14 @@ conditional-branch-insn
 : split-insns ( insns -- pre/body/post )
     dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ;
 
-: reorder-body ( body -- body' )
+: setup-root-nodes ( insns -- roots )
     [ <node> ] map
-    [ build-dependence-graph ] [ build-fan-in-trees ] bi
-    [ (reorder) ] V{ } make reverse ;
+    [ build-dependence-graph ]
+    [ build-fan-in-trees ]
+    [ [ ready? ] V{ } filter-as ] tri ;
+
+: reorder-body ( body -- body' )
+    setup-root-nodes roots set [ (reorder) ] V{ } make reverse ;
 
 : reorder ( insns -- insns' )
     split-insns first3 [ reorder-body ] dip 3append ;