compiler.cfg.dependence/scheduling: refactoring to get rid of node's follows>>
parent
645a70f1d4
commit
8347f43f84
basis/compiler/cfg
dependence
scheduling
|
@ -12,7 +12,7 @@ SYMBOL: +data+
|
|||
SYMBOL: +control+
|
||||
|
||||
TUPLE: node
|
||||
number insn precedes follows
|
||||
number insn precedes
|
||||
children parent
|
||||
registers parent-index ;
|
||||
|
||||
|
@ -24,8 +24,7 @@ M: node hashcode* nip number>> ;
|
|||
node new
|
||||
node-number counter >>number
|
||||
swap >>insn
|
||||
H{ } clone >>precedes
|
||||
V{ } clone >>follows ;
|
||||
H{ } clone >>precedes ;
|
||||
|
||||
:: precedes ( first second how -- )
|
||||
how second first precedes>> set-at ;
|
||||
|
@ -69,15 +68,8 @@ M: object add-control-edge 2drop ;
|
|||
: add-control-edges ( nodes -- )
|
||||
[ [ dup insn>> add-control-edge ] each ] with-scope ;
|
||||
|
||||
: set-follows ( nodes -- )
|
||||
[
|
||||
dup precedes>> keys [
|
||||
follows>> push
|
||||
] with each
|
||||
] each ;
|
||||
|
||||
: build-dependence-graph ( nodes -- )
|
||||
[ add-control-edges ] [ add-data-edges ] [ set-follows ] tri ;
|
||||
[ add-control-edges ] [ add-data-edges ] bi ;
|
||||
|
||||
! Sethi-Ulmann numbering
|
||||
:: calculate-registers ( node -- registers )
|
||||
|
|
|
@ -12,35 +12,28 @@ IN: compiler.cfg.scheduling
|
|||
! by Vivek Sarkar, et al.
|
||||
! 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 -- )
|
||||
children>> building get length
|
||||
'[ _ >>parent-index drop ] each ;
|
||||
|
||||
: ready? ( node -- ? ) precedes>> assoc-empty? ;
|
||||
|
||||
: remove-node ( roots node -- )
|
||||
dup follows>> [ [ precedes>> check-delete-at ] with each ] keep
|
||||
[ ready? ] filter swap push-all ;
|
||||
! Remove the node and unregister it from all nodes precedes links.
|
||||
: remove-node ( nodes node -- )
|
||||
[ swap remove! ] keep '[ precedes>> _ swap delete-at ] each ;
|
||||
|
||||
: score ( node -- n )
|
||||
[ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ;
|
||||
|
||||
: select ( vector quot: ( elt -- score ) -- elt )
|
||||
dupd supremum-by swap dupd remove-eq! drop ; inline
|
||||
|
||||
: select-instruction ( roots -- insn/f )
|
||||
: select-instruction ( nodes -- insn/f )
|
||||
[ f ] [
|
||||
dup [ score ] select
|
||||
! select one among the ready nodes (roots)
|
||||
dup [ ready? ] filter [ score ] supremum-by
|
||||
[ remove-node ] keep
|
||||
[ insn>> ] [ set-parent-indices ] bi
|
||||
] if-empty ;
|
||||
|
||||
: (reorder) ( roots -- )
|
||||
: (reorder) ( nodes -- )
|
||||
dup select-instruction [ , (reorder) ] [ drop ] if* ;
|
||||
|
||||
UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ;
|
||||
|
@ -62,14 +55,12 @@ conditional-branch-insn
|
|||
: split-insns ( insns -- pre/body/post )
|
||||
dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ;
|
||||
|
||||
: setup-root-nodes ( insns -- roots )
|
||||
[ <node> ] map
|
||||
[ build-dependence-graph ]
|
||||
[ build-fan-in-trees ]
|
||||
[ [ ready? ] V{ } filter-as ] tri ;
|
||||
: setup-nodes ( insns -- nodes )
|
||||
[ <node> ] V{ } map-as
|
||||
[ build-dependence-graph ] [ build-fan-in-trees ] [ ] tri ;
|
||||
|
||||
: reorder-body ( body -- body' )
|
||||
setup-root-nodes [ (reorder) ] V{ } make reverse ;
|
||||
setup-nodes [ (reorder) ] V{ } make reverse ;
|
||||
|
||||
: reorder ( insns -- insns' )
|
||||
split-insns first3 [ reorder-body ] dip 3append ;
|
||||
|
|
Loading…
Reference in New Issue