Scheduling uses sets where appropriate

db4
Daniel Ehrenberg 2010-03-24 10:38:52 -04:00
parent 12db8a6c77
commit 31f23c8eba
2 changed files with 11 additions and 13 deletions

View File

@ -4,6 +4,7 @@ USING: accessors assocs combinators compiler.cfg.def-use
compiler.cfg.instructions compiler.cfg.registers fry kernel compiler.cfg.instructions compiler.cfg.registers fry kernel
locals namespaces sequences sets sorting math.vectors locals namespaces sequences sets sorting math.vectors
make math combinators.short-circuit vectors ; make math combinators.short-circuit vectors ;
FROM: namespaces => set ;
IN: compiler.cfg.dependence IN: compiler.cfg.dependence
! Dependence graph construction ! Dependence graph construction
@ -32,15 +33,12 @@ M: node hashcode* nip number>> ;
node-number counter >>number node-number counter >>number
swap >>insn swap >>insn
H{ } clone >>precedes H{ } clone >>precedes
H{ } clone >>follows ; V{ } clone >>follows ;
: ready? ( node -- ? ) precedes>> assoc-empty? ; : ready? ( node -- ? ) precedes>> assoc-empty? ;
: spin ( a b c -- c b a ) :: precedes ( first second how -- )
[ 2nip ] [ drop nip ] [ 2drop ] 3tri ; how second first precedes>> set-at ;
: precedes ( first second how -- )
spin precedes>> set-at ;
:: add-data-edges ( nodes -- ) :: add-data-edges ( nodes -- )
! This builds up def-use information on the fly, since ! This builds up def-use information on the fly, since
@ -107,12 +105,12 @@ M: object add-control-edge 2drop ;
: set-follows ( nodes -- ) : set-follows ( nodes -- )
[ [
dup precedes>> keys [ dup precedes>> keys [
follows>> conjoin follows>> push
] with each ] with each
] each ; ] each ;
: set-roots ( nodes -- ) : set-roots ( nodes -- )
[ ready? ] filter V{ } like roots set ; [ ready? ] V{ } filter-as roots set ;
: build-dependence-graph ( instructions -- ) : build-dependence-graph ( instructions -- )
[ <node> ] map { [ <node> ] map {

View File

@ -26,7 +26,7 @@ ERROR: bad-delete-at key assoc ;
'[ _ >>parent-index drop ] each ; '[ _ >>parent-index drop ] each ;
: remove-node ( node -- ) : remove-node ( node -- )
[ follows>> keys ] keep [ follows>> members ] keep
'[ [ precedes>> _ swap check-delete-at ] each ] '[ [ precedes>> _ swap check-delete-at ] each ]
[ [ ready? ] filter roots get push-all ] bi ; [ [ ready? ] filter roots get push-all ] bi ;
@ -84,12 +84,12 @@ t check-scheduling? set-global
ERROR: definition-after-usage vreg old-bb new-bb ; ERROR: definition-after-usage vreg old-bb new-bb ;
:: check-usages ( new-bb old-bb -- ) :: check-usages ( new-bb old-bb -- )
H{ } clone :> useds HS{ } clone :> useds
new-bb instructions>> split-3-ways drop nip new-bb instructions>> split-3-ways drop nip
[| insn | [| insn |
insn uses-vregs [ useds conjoin ] each insn uses-vregs [ useds adjoin ] each
insn defs-vreg :> def-reg insn defs-vreg :> def-reg
def-reg useds key? def-reg useds in?
[ def-reg old-bb new-bb definition-after-usage ] when [ def-reg old-bb new-bb definition-after-usage ] when
] each ; ] each ;
@ -132,7 +132,7 @@ ERROR: definition-after-usage vreg old-bb new-bb ;
: schedule-instructions ( cfg -- cfg' ) : schedule-instructions ( cfg -- cfg' )
dup [ dup [
dup might-spill? dup might-spill?
[ schedule-block ] [ schedule-block ]
[ drop ] if [ drop ] if
] each-basic-block ; ] each-basic-block ;