steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.dependence/scheduling: refactoring to get rid of node's follows>>

db4
Björn Lindqvist 2014-11-11 02:22:50 +01:00 committed by Doug Coleman
parent 645a70f1d4
commit 8347f43f84
2 changed files with 14 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/compiler/cfg/dependence/dependence.factor
View File

@ -12,7 +12,7 @@ SYMBOL: +data+
SYMBOL: +control+ SYMBOL: +control+
TUPLE: node TUPLE: node
number insn precedes follows number insn precedes
children parent children parent
registers parent-index ; registers parent-index ;
@ -24,8 +24,7 @@ M: node hashcode* nip number>> ;
node new node new
node-number counter >>number node-number counter >>number
swap >>insn swap >>insn
H{ } clone >>precedes H{ } clone >>precedes ;
V{ } clone >>follows ;
:: precedes ( first second how -- ) :: precedes ( first second how -- )
how second first precedes>> set-at ; how second first precedes>> set-at ;
@ -69,15 +68,8 @@ M: object add-control-edge 2drop ;
: add-control-edges ( nodes -- ) : add-control-edges ( nodes -- )
[ [ dup insn>> add-control-edge ] each ] with-scope ; [ [ dup insn>> add-control-edge ] each ] with-scope ;
: set-follows ( nodes -- )
[
dup precedes>> keys [
follows>> push
] with each
] each ;
: build-dependence-graph ( nodes -- ) : build-dependence-graph ( nodes -- )
[ add-control-edges ] [ add-data-edges ] [ set-follows ] tri ; [ add-control-edges ] [ add-data-edges ] bi ;
! Sethi-Ulmann numbering ! Sethi-Ulmann numbering
:: calculate-registers ( node -- registers ) :: calculate-registers ( node -- registers )

31
basis/compiler/cfg/scheduling/scheduling.factor
View File

@ -12,35 +12,28 @@ IN: compiler.cfg.scheduling
! by Vivek Sarkar, et al. ! by Vivek Sarkar, et al.
! http://portal.acm.org/citation.cfm?id=377849 ! http://portal.acm.org/citation.cfm?id=377849
ERROR: bad-delete-at key assoc ;
: check-delete-at ( key assoc -- )
2dup key? [ delete-at ] [ bad-delete-at ] if ;
: set-parent-indices ( node -- ) : set-parent-indices ( node -- )
children>> building get length children>> building get length
'[ _ >>parent-index drop ] each ; '[ _ >>parent-index drop ] each ;
: ready? ( node -- ? ) precedes>> assoc-empty? ; : ready? ( node -- ? ) precedes>> assoc-empty? ;
: remove-node ( roots node -- ) ! Remove the node and unregister it from all nodes precedes links.
dup follows>> [ [ precedes>> check-delete-at ] with each ] keep : remove-node ( nodes node -- )
[ ready? ] filter swap push-all ; [ swap remove! ] keep '[ precedes>> _ swap delete-at ] each ;
: score ( node -- n ) : score ( node -- n )
[ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ; [ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ;
: select ( vector quot: ( elt -- score ) -- elt ) : select-instruction ( nodes -- insn/f )
dupd supremum-by swap dupd remove-eq! drop ; inline
: select-instruction ( roots -- insn/f )
[ f ] [ [ f ] [
dup [ score ] select ! select one among the ready nodes (roots)
dup [ ready? ] filter [ score ] supremum-by
[ remove-node ] keep [ remove-node ] keep
[ insn>> ] [ set-parent-indices ] bi [ insn>> ] [ set-parent-indices ] bi
] if-empty ; ] if-empty ;
: (reorder) ( roots -- ) : (reorder) ( nodes -- )
dup select-instruction [ , (reorder) ] [ drop ] if* ; dup select-instruction [ , (reorder) ] [ drop ] if* ;
UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ; UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ;
@ -62,14 +55,12 @@ conditional-branch-insn
: split-insns ( insns -- pre/body/post ) : split-insns ( insns -- pre/body/post )
dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ; dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ;
: setup-root-nodes ( insns -- roots ) : setup-nodes ( insns -- nodes )
[ <node> ] map [ <node> ] V{ } map-as
[ build-dependence-graph ] [ build-dependence-graph ] [ build-fan-in-trees ] [ ] tri ;
[ build-fan-in-trees ]
[ [ ready? ] V{ } filter-as ] tri ;
: reorder-body ( body -- body' ) : reorder-body ( body -- body' )
setup-root-nodes [ (reorder) ] V{ } make reverse ; setup-nodes [ (reorder) ] V{ } make reverse ;
: reorder ( insns -- insns' ) : reorder ( insns -- insns' )
split-insns first3 [ reorder-body ] dip 3append ; split-insns first3 [ reorder-body ] dip 3append ;