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