183 lines
4.3 KiB
Factor
183 lines
4.3 KiB
Factor
USING: accessors arrays assocs combinators.short-circuit
|
|
compiler.cfg.dependence compiler.cfg.instructions compiler.cfg.registers fry
|
|
grouping kernel math namespaces random sequences tools.test vectors ;
|
|
IN: compiler.cfg.dependence.tests
|
|
FROM: sets => members set= ;
|
|
|
|
{
|
|
V{
|
|
T{ node
|
|
{ number 1 }
|
|
{ insn T{ ##inc-r } }
|
|
{ precedes H{ } }
|
|
}
|
|
T{ node
|
|
{ number 2 }
|
|
{ insn T{ ##inc-d } }
|
|
{ precedes H{ } }
|
|
}
|
|
}
|
|
} [
|
|
0 node-number set-global
|
|
V{ T{ ##inc-r } T{ ##inc-d } } [ <node> ] map dup
|
|
build-dependence-graph
|
|
] unit-test
|
|
|
|
{ 0 } [
|
|
T{ ##load-tagged } <node> calculate-registers
|
|
] unit-test
|
|
|
|
: 2node-tree ( -- tree )
|
|
2 iota [ node new swap >>number ] map first2 over attach-parent ;
|
|
|
|
! 0 -> 1 -> 2
|
|
: 3node-tree ( -- tree )
|
|
3 iota [ node new swap >>number ] map 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-parents ( nodes trees -- )
|
|
2dup '[ [ parent>> ] [ _ member? ] bi or ] all?
|
|
[ 2drop ] [ node-missing-parent ] if ;
|
|
|
|
: verify-children ( nodes trees -- )
|
|
2dup [ flatten-tree ] map concat
|
|
{ [ [ length ] same? ] [ set= ] } 2&&
|
|
[ 2drop ] [ node-missing-children ] if ;
|
|
|
|
: verify-trees ( nodes trees -- )
|
|
[ verify-parents ] [ verify-children ] 2bi ;
|
|
|
|
{ } [ 2node-tree 1array dup verify-parents ] unit-test
|
|
|
|
[
|
|
2node-tree 1array { } verify-parents
|
|
] [ node-missing-parent? ] 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-trees
|
|
] [ node-missing-children? ] must-fail-with
|
|
|
|
! select-parent tests
|
|
{ f } [
|
|
{ } select-parent
|
|
] unit-test
|
|
|
|
: dummy-node ( number -- node )
|
|
node new over >>number ##allot new rot >>insn# >>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
|
|
|
|
! Shared with compiler.cfg.scheduling
|
|
: test-not-in-order ( -- nodes )
|
|
V{
|
|
##load-tagged
|
|
##allot
|
|
##set-slot-imm
|
|
##load-reference
|
|
##allot
|
|
##set-slot-imm
|
|
##set-slot-imm
|
|
##set-slot-imm
|
|
##replace
|
|
} [ [ new ] [ 2 * ] bi* >>insn# ] map-index ;
|
|
|
|
{ 7 } [
|
|
test-not-in-order [ <node> ] map dup
|
|
build-dependence-graph
|
|
make-trees length
|
|
] 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
|
|
|
|
: test-some-kind-of-dep ( -- insns )
|
|
V{
|
|
T{ ##peek { dst 275 } { loc D 2 } }
|
|
T{ ##load-tagged { dst 277 } { val 0 } }
|
|
T{ ##allot
|
|
{ dst 280 }
|
|
{ size 16 }
|
|
{ class-of array }
|
|
{ temp 6 }
|
|
}
|
|
T{ ##set-slot-imm
|
|
{ src 277 }
|
|
{ obj 280 }
|
|
{ slot 1 }
|
|
{ tag 2 }
|
|
}
|
|
T{ ##load-reference
|
|
{ dst 283 }
|
|
{ obj
|
|
{
|
|
vector
|
|
2
|
|
1
|
|
tuple
|
|
258304024774
|
|
vector
|
|
8390923745423
|
|
}
|
|
}
|
|
}
|
|
T{ ##allot
|
|
{ dst 285 }
|
|
{ size 32 }
|
|
{ class-of tuple }
|
|
{ temp 12 }
|
|
}
|
|
T{ ##set-slot-imm
|
|
{ src 283 }
|
|
{ obj 285 }
|
|
{ slot 1 }
|
|
{ tag 7 }
|
|
}
|
|
T{ ##set-slot-imm
|
|
{ src 280 }
|
|
{ obj 285 }
|
|
{ slot 2 }
|
|
{ tag 7 }
|
|
}
|
|
} [ 2 * >>insn# ] map-index ;
|