Scheduling doesn't have such redundant data structures anymore

db4
Daniel Ehrenberg 2010-02-11 21:21:22 -06:00
parent a6f255a985
commit 5a3d0fb883
2 changed files with 16 additions and 18 deletions

View File

@ -12,11 +12,13 @@ SYMBOL: roots
SYMBOL: node-number
SYMBOL: nodes
SYMBOL: +data+
SYMBOL: +control+
! Nodes in the dependency graph
! These need to be numbered so that the same instruction
! will get distinct nodes if it occurs multiple times
TUPLE: node
precedes-data precedes-control
number insn precedes follows
children parent
registers parent-index ;
@ -30,22 +32,15 @@ M: node hashcode* nip number>> ;
node-number counter >>number
swap >>insn
H{ } clone >>precedes
H{ } clone >>precedes-data
H{ } clone >>precedes-control
H{ } clone >>follows ;
: ready? ( node -- ? ) precedes>> assoc-empty? ;
: precedes ( first second -- )
swap precedes>> conjoin ;
: spin ( a b c -- c b a )
[ 2nip ] [ drop nip ] [ 2drop ] 3tri ;
: precedes-data ( first second -- )
[ precedes ]
[ swap precedes-data>> conjoin ] 2bi ;
: precedes-control ( first second -- )
[ precedes ]
[ swap precedes-control>> conjoin ] 2bi ;
: precedes ( first second how -- )
spin precedes>> set-at ;
:: add-data-edges ( nodes -- )
! This builds up def-use information on the fly, since
@ -53,11 +48,11 @@ M: node hashcode* nip number>> ;
H{ } clone :> definers
nodes [| node |
node insn>> defs-vreg [ node swap definers set-at ] when*
node insn>> uses-vregs [ definers at [ node precedes-data ] when* ] each
node insn>> uses-vregs [ definers at [ node +data+ precedes ] when* ] each
] each ;
: make-chain ( nodes -- )
[ dup rest-slice [ precedes-control ] 2each ] unless-empty ;
[ dup rest-slice [ +control+ precedes ] 2each ] unless-empty ;
: instruction-chain ( nodes quot -- )
'[ insn>> @ ] filter make-chain ; inline
@ -107,7 +102,7 @@ UNION: alien-call-insn
: set-follows ( nodes -- )
[
dup precedes>> values [
dup precedes>> keys [
follows>> conjoin
] with each
] each ;
@ -140,11 +135,14 @@ UNION: alien-call-insn
[ >>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>> assoc-empty? [
dup precedes-data>> values [ drop ] [
dup precedes>> +control+ keys-for empty? [
dup precedes>> +data+ keys-for [ drop ] [
first attach-parent
] if-empty
] [ drop ] if ;

View File

@ -26,7 +26,7 @@ ERROR: bad-delete-at key assoc ;
'[ _ >>parent-index drop ] each ;
: remove-node ( node -- )
[ follows>> values ] keep
[ follows>> keys ] keep
'[ [ precedes>> _ swap check-delete-at ] each ]
[ [ ready? ] filter roots get push-all ] bi ;