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
db4
Björn Lindqvist 2014-11-09 07:34:31 +01:00 committed by Doug Coleman
parent 586c47e5ab
commit 7ebceb50e5
2 changed files with 24 additions and 27 deletions

View File

@ -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 ;

View File

@ -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 ;