compiler.cfg.dependence: this vocab was only used by scheduling so it isn't needed anymore
Björn Lindqvist
John Benediktsson
parent
b3ebb04d6d
commit
bb504b7c3d
|
|
@ -1,44 +0,0 @@
|
|||
USING: assocs compiler.cfg.instructions help.markup help.syntax math
|
||||
sequences ;
|
||||
IN: compiler.cfg.dependence
|
||||
|
||||
HELP: node
|
||||
{ $class-description "Nodes in the dependency graph. These need to be numbered so that the same instruction will get distinct nodes if it occurs multiple times. It has the following slots:"
|
||||
{ $table
|
||||
{ { $slot "insn" } { { $link insn } } }
|
||||
{ { $slot "precedes" } { "Hash of all nodes this node must precede in the instruction flow." } }
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: <node>
|
||||
{ $values { "insn" insn } { "node" node } }
|
||||
{ $description "Creates a new dependency graph node from an CFG instruction." } ;
|
||||
|
||||
{ node <node> } related-words
|
||||
|
||||
HELP: attach-parent
|
||||
{ $values { "child" node } { "parent" node } }
|
||||
{ $description "Inserts 'node' as a children of 'parent' and sets the parent of 'node' to 'parent'." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: compiler.cfg.dependence ;"
|
||||
"T{ ##replace } T{ ##set-slot-imm } [ <node> ] bi@ attach-parent"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: select-parent
|
||||
{ $values { "precedes" assoc } { "parent/f" node } }
|
||||
{ $description "Picks the parent node for this node from an assoc of preceding nodes." } ;
|
||||
|
||||
HELP: build-fan-in-trees
|
||||
{ $values { "nodes" sequence } }
|
||||
{ $description "Selects a parent for each " { $link node } ", then initializes the " { $slot "parent-index" } " and Sethi-Ulmann number for the nodes." } ;
|
||||
|
||||
HELP: calculate-registers
|
||||
{ $values { "node" node } { "registers" integer } }
|
||||
{ $description "Calculates a nodes Sethi-Ulmann number. For a leaf node, the number is equal to the number of temporary registers the word uses." } ;
|
||||
|
||||
ARTICLE: "compiler.cfg.dependence" "Dependence graph construction"
|
||||
"This vocab is used by " { $vocab-link "compiler.cfg.scheduling" } "." ;
|
||||
|
||||
ABOUT: "compiler.cfg.dependence"
|
||||
|
|
@ -1,95 +0,0 @@
|
|||
USING: accessors arrays assocs combinators.short-circuit
|
||||
compiler.cfg.dependence compiler.cfg.instructions
|
||||
grouping kernel math random sequences tools.test vectors
|
||||
compiler.cfg.test-words ;
|
||||
IN: compiler.cfg.dependence.tests
|
||||
FROM: sets => members set= ;
|
||||
|
||||
{ t } [
|
||||
V{ T{ ##inc-r } T{ ##inc-d } } [ <node> ] map dup
|
||||
build-dependence-graph
|
||||
first2 [ insn>> ##inc-r? ] [ insn>> ##inc-d? ] bi* and
|
||||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
T{ ##load-tagged } <node> calculate-registers
|
||||
] unit-test
|
||||
|
||||
: 2node-tree ( -- tree )
|
||||
2 [ node new ] replicate first2 over attach-parent ;
|
||||
|
||||
! 0 -> 1 -> 2
|
||||
: 3node-tree ( -- tree )
|
||||
3 [ node new ] replicate first3
|
||||
over attach-parent over attach-parent ;
|
||||
|
||||
! Verification tests
|
||||
ERROR: node-missing-parent trees nodes ;
|
||||
ERROR: node-missing-children trees nodes ;
|
||||
|
||||
: flatten-tree ( node -- nodes )
|
||||
[ children>> [ flatten-tree ] map concat ] keep suffix ;
|
||||
|
||||
: verify-children ( nodes trees -- )
|
||||
2dup [ flatten-tree ] map concat
|
||||
{ [ [ length ] same? ] [ set= ] } 2&&
|
||||
[ 2drop ] [ node-missing-children ] if ;
|
||||
|
||||
{ } [
|
||||
2node-tree [ flatten-tree ] keep 1array verify-children
|
||||
] unit-test
|
||||
|
||||
[
|
||||
2node-tree 1array { } verify-children
|
||||
] [ node-missing-children? ] must-fail-with
|
||||
|
||||
{ 1 } [ 3node-tree children>> length ] unit-test
|
||||
|
||||
{ 3 } [ 3node-tree flatten-tree length ] unit-test
|
||||
|
||||
[
|
||||
{ } 3node-tree 1array verify-children
|
||||
] [ node-missing-children? ] must-fail-with
|
||||
|
||||
[
|
||||
{ } 3node-tree 1array verify-children
|
||||
] [ node-missing-children? ] must-fail-with
|
||||
|
||||
! select-parent tests
|
||||
{ f } [
|
||||
{ } select-parent
|
||||
] unit-test
|
||||
|
||||
: dummy-node ( number -- node )
|
||||
##allot new swap >>insn# node new swap >>insn ;
|
||||
|
||||
! No parent because it has +control+
|
||||
{ f } [
|
||||
10 20 [ dummy-node ] bi@ 2array { +data+ +control+ } zip select-parent
|
||||
] unit-test
|
||||
|
||||
! Yes parent
|
||||
{ 10 } [
|
||||
10 dummy-node +data+ 2array 1array select-parent insn>> insn#>>
|
||||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
20 iota [ dummy-node +data+ 2array ] map randomize
|
||||
select-parent insn>> insn#>>
|
||||
] unit-test
|
||||
|
||||
! Another
|
||||
{ t } [
|
||||
100 [
|
||||
test-not-in-order [ <node> ] map [ build-dependence-graph ] keep
|
||||
[ precedes>> select-parent ] map [ dup [ insn>> ] when ] map
|
||||
] replicate all-equal?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
100 [
|
||||
test-not-in-order [ <node> ] map dup dup
|
||||
build-dependence-graph [ maybe-set-parent ] each
|
||||
[ children>> length ] map
|
||||
] replicate all-equal?
|
||||
] unit-test
|
||||
|
|
@ -1,93 +0,0 @@
|
|||
! Copyright (C) 2009, 2010 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs compiler.cfg.def-use
|
||||
compiler.cfg.instructions fry kernel locals math math.vectors
|
||||
namespaces sequences sets sorting vectors ;
|
||||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.dependence
|
||||
|
||||
SYMBOLS: +data+ +control+ ;
|
||||
|
||||
TUPLE: node < identity-tuple insn precedes children registers parent-index ;
|
||||
|
||||
: <node> ( insn -- node )
|
||||
node new swap >>insn H{ } clone >>precedes ;
|
||||
|
||||
:: precedes ( first second how -- )
|
||||
how second first precedes>> set-at ;
|
||||
|
||||
:: add-data-edges ( nodes -- )
|
||||
! This builds up def-use information on the fly, since
|
||||
! we only care about local def-use
|
||||
H{ } clone :> definers
|
||||
nodes [| node |
|
||||
node insn>> defs-vregs [ node swap definers set-at ] each
|
||||
node insn>> uses-vregs [ definers at [ node +data+ precedes ] when* ] each
|
||||
] each ;
|
||||
|
||||
UNION: stack-insn ##peek ##replace ##replace-imm ;
|
||||
|
||||
UNION: slot-insn
|
||||
##read ##write ;
|
||||
|
||||
UNION: memory-insn
|
||||
##allot
|
||||
##load-memory ##load-memory-imm
|
||||
##store-memory ##store-memory-imm
|
||||
##write-barrier ##write-barrier-imm
|
||||
alien-call-insn
|
||||
slot-insn ;
|
||||
|
||||
: chain ( node var -- )
|
||||
dup get [
|
||||
pick +control+ precedes
|
||||
] when*
|
||||
set ;
|
||||
|
||||
GENERIC: add-control-edge ( node insn -- )
|
||||
|
||||
M: stack-insn add-control-edge loc>> chain ;
|
||||
M: memory-insn add-control-edge drop memory-insn chain ;
|
||||
M: object add-control-edge 2drop ;
|
||||
|
||||
: add-control-edges ( nodes -- )
|
||||
[ [ dup insn>> add-control-edge ] each ] with-scope ;
|
||||
|
||||
: build-dependence-graph ( nodes -- )
|
||||
[ add-control-edges ] [ add-data-edges ] bi ;
|
||||
|
||||
! Sethi-Ulmann numbering
|
||||
:: calculate-registers ( node -- registers )
|
||||
node children>> [ 0 ] [
|
||||
[ [ calculate-registers ] map natural-sort ]
|
||||
[ length iota ]
|
||||
bi v+ supremum
|
||||
] if-empty
|
||||
node insn>> temp-vregs length +
|
||||
dup node registers<< ;
|
||||
|
||||
! Constructing fan-in trees
|
||||
: keys-for ( assoc value -- keys )
|
||||
'[ nip _ = ] assoc-filter keys ;
|
||||
|
||||
: attach-parent ( child parent -- )
|
||||
[ ?push ] change-children drop ;
|
||||
|
||||
! Arbitrary tie-breaker to make the ordering deterministic.
|
||||
: tiebreak-parents ( nodes -- node/f )
|
||||
[ f ] [ [ insn>> insn#>> ] infimum-by ] if-empty ;
|
||||
|
||||
: select-parent ( precedes -- parent/f )
|
||||
! If a node has no control dependencies, then its parent is the tie-breaked
|
||||
! data dependency, if it has one. Otherwise it is a root node.
|
||||
[ +control+ keys-for empty? ] [ +data+ keys-for tiebreak-parents ] bi f ? ;
|
||||
|
||||
: maybe-set-parent ( node -- )
|
||||
dup precedes>> select-parent [ attach-parent ] [ drop ] if* ;
|
||||
|
||||
: initialize-scores ( trees -- )
|
||||
[ -1/0. >>parent-index calculate-registers drop ] each ;
|
||||
|
||||
: build-fan-in-trees ( nodes -- )
|
||||
dup [ maybe-set-parent ] each
|
||||
dup [ children>> ] map concat diff initialize-scores ;
|
||||
Loading…
Reference in New Issue