2015-11-18 18:53:46 -05:00
|
|
|
USING: accessors compiler.cfg compiler.cfg.builder.blocks
|
2015-11-21 19:06:11 -05:00
|
|
|
compiler.cfg.instructions compiler.cfg.stacks.local
|
2016-03-08 10:30:25 -05:00
|
|
|
compiler.cfg.utilities compiler.test kernel namespaces sequences
|
2015-11-21 19:06:11 -05:00
|
|
|
tools.test ;
|
2015-03-15 19:14:41 -04:00
|
|
|
IN: compiler.cfg.builder.blocks.tests
|
|
|
|
|
2015-11-18 18:53:46 -05:00
|
|
|
! (begin-basic-block)
|
|
|
|
{ 20 } [
|
|
|
|
{ } 20 insns>block (begin-basic-block)
|
2016-03-06 22:42:28 -05:00
|
|
|
predecessors>> first number>>
|
2015-11-18 18:53:46 -05:00
|
|
|
] cfg-unit-test
|
|
|
|
|
|
|
|
! begin-branch
|
|
|
|
{ f } [
|
2016-03-06 22:42:28 -05:00
|
|
|
height-state get <basic-block> begin-branch drop height-state get eq?
|
|
|
|
] cfg-unit-test
|
|
|
|
|
|
|
|
{ f } [
|
|
|
|
<basic-block> dup begin-branch eq?
|
2015-11-18 18:53:46 -05:00
|
|
|
] cfg-unit-test
|
|
|
|
|
2015-11-21 19:06:11 -05:00
|
|
|
! emit-trivial-block
|
|
|
|
{
|
|
|
|
V{ T{ ##no-tco } T{ ##branch } }
|
|
|
|
} [
|
2016-03-07 00:40:27 -05:00
|
|
|
<basic-block> dup set-basic-block
|
|
|
|
[ drop ##no-tco, ] emit-trivial-block
|
|
|
|
predecessors>> first instructions>>
|
2015-11-21 19:06:11 -05:00
|
|
|
] cfg-unit-test
|
|
|
|
|
2016-03-06 22:42:28 -05:00
|
|
|
! end-basic-block
|
2016-03-08 08:38:48 -05:00
|
|
|
{ } [
|
|
|
|
<basic-block> dup set-basic-block ##branch, end-basic-block
|
2016-03-06 22:42:28 -05:00
|
|
|
] unit-test
|
|
|
|
|
2015-03-15 19:14:41 -04:00
|
|
|
{
|
|
|
|
{ "succ" "succ" "succ" }
|
|
|
|
} [
|
2015-03-26 09:19:57 -04:00
|
|
|
3 [ <basic-block> ] replicate <basic-block> "succ" >>number
|
|
|
|
dupd connect-Nto1-bbs [ successors>> first number>> ] map
|
2015-03-15 19:14:41 -04:00
|
|
|
] unit-test
|