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

compiler.cfg.scheduling: refactoring to get rid of the roots dynamic variable

db4
Björn Lindqvist 2014-11-11 01:34:29 +01:00 committed by Doug Coleman
parent a96fff60af
commit 645a70f1d4
1 changed files with 11 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -21,14 +21,11 @@ ERROR: bad-delete-at key assoc ;
children>> building get length children>> building get length
'[ _ >>parent-index drop ] each ; '[ _ >>parent-index drop ] each ;
SYMBOL: roots
: ready? ( node -- ? ) precedes>> assoc-empty? ; : ready? ( node -- ? ) precedes>> assoc-empty? ;
: remove-node ( node -- ) : remove-node ( roots node -- )
[ follows>> members ] keep dup follows>> [ [ precedes>> check-delete-at ] with each ] keep
'[ [ precedes>> _ swap check-delete-at ] each ] [ ready? ] filter swap push-all ;
[ [ ready? ] filter roots get push-all ] bi ;
: score ( node -- n ) : score ( node -- n )
[ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ; [ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ;
@ -36,18 +33,15 @@ SYMBOL: roots
: select ( vector quot: ( elt -- score ) -- elt ) : select ( vector quot: ( elt -- score ) -- elt )
dupd supremum-by swap dupd remove-eq! drop ; inline dupd supremum-by swap dupd remove-eq! drop ; inline
: select-instruction ( -- insn/f ) : select-instruction ( roots -- insn/f )
roots get [ f ] [ [ f ] [
[ score ] select dup [ score ] select
[ insn>> ] [ remove-node ] keep
[ set-parent-indices ] [ insn>> ] [ set-parent-indices ] bi
[ remove-node ] tri
] if-empty ; ] if-empty ;
: (reorder) ( -- ) : (reorder) ( roots -- )
select-instruction [ dup select-instruction [ , (reorder) ] [ drop ] if* ;
, (reorder)
] when* ;
UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ; UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ;
@ -75,7 +69,7 @@ conditional-branch-insn
[ [ ready? ] V{ } filter-as ] tri ; [ [ ready? ] V{ } filter-as ] tri ;
: reorder-body ( body -- body' ) : reorder-body ( body -- body' )
setup-root-nodes roots set [ (reorder) ] V{ } make reverse ; setup-root-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 ;