compiler.cfg.utilities: move and rename the helper words block>cfg, insns>block and insns>cfg, they are useful to many testing vocabs
parent
bc12a60a49
commit
c8a022423e
|
@ -1,19 +1,11 @@
|
|||
USING: accessors arrays assocs compiler.cfg
|
||||
compiler.cfg.dataflow-analysis.private compiler.cfg.instructions
|
||||
compiler.cfg.linearization compiler.cfg.registers compiler.cfg.stacks.vacant
|
||||
kernel math sequences sorting tools.test vectors ;
|
||||
compiler.cfg.linearization compiler.cfg.registers
|
||||
compiler.cfg.utilities compiler.cfg.stacks.vacant kernel math sequences sorting
|
||||
tools.test vectors ;
|
||||
IN: compiler.cfg.stacks.vacant.tests
|
||||
|
||||
! Utils
|
||||
: create-block ( insns n -- bb )
|
||||
<basic-block> swap >>number swap >>instructions ;
|
||||
|
||||
: block>cfg ( bb -- cfg )
|
||||
cfg new swap >>entry ;
|
||||
|
||||
: create-cfg ( insns -- cfg )
|
||||
0 create-block block>cfg ;
|
||||
|
||||
: output-stack-map ( cfg -- map )
|
||||
vacant-analysis run-dataflow-analysis
|
||||
nip [ [ number>> ] dip ] assoc-map >alist natural-sort last second ;
|
||||
|
@ -21,24 +13,24 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
! Initially both the d and r stacks are empty.
|
||||
{
|
||||
{ { 0 { } } { 0 { } } }
|
||||
} [ V{ } create-cfg output-stack-map ] unit-test
|
||||
} [ V{ } insns>cfg output-stack-map ] unit-test
|
||||
|
||||
! Raise d stack.
|
||||
{
|
||||
{ { 1 { } } { 0 { } } }
|
||||
} [ V{ T{ ##inc-d f 1 } } create-cfg output-stack-map ] unit-test
|
||||
} [ V{ T{ ##inc-d f 1 } } insns>cfg output-stack-map ] unit-test
|
||||
|
||||
! Raise r stack.
|
||||
{
|
||||
{ { 0 { } } { 1 { } } }
|
||||
} [ V{ T{ ##inc-r f 1 } } create-cfg output-stack-map ] unit-test
|
||||
} [ V{ T{ ##inc-r f 1 } } insns>cfg output-stack-map ] unit-test
|
||||
|
||||
! Uninitialized peeks
|
||||
[
|
||||
V{
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
} create-cfg
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
|
@ -46,7 +38,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
V{
|
||||
T{ ##inc-r f 1 }
|
||||
T{ ##peek { dst 0 } { loc R 0 } }
|
||||
} create-cfg
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
|
@ -55,7 +47,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
[ ] [
|
||||
V{
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
} create-cfg
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] unit-test
|
||||
|
||||
|
@ -64,7 +56,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
V{
|
||||
T{ ##replace { src 10 } { loc D -1 } }
|
||||
T{ ##peek { dst 0 } { loc D -1 } }
|
||||
} create-cfg
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] unit-test
|
||||
|
||||
|
@ -76,7 +68,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##peek { dst 0 } { loc D -1 } }
|
||||
}
|
||||
[ create-cfg compute-vacant-sets ]
|
||||
[ insns>cfg compute-vacant-sets ]
|
||||
[ second gc-map>> check-d>> ] bi
|
||||
] unit-test
|
||||
|
||||
|
@ -87,7 +79,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek { dst 0 } { loc D -1 } }
|
||||
} create-cfg output-stack-map first
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
|
||||
! Should not be ok because the value wasn't initialized when gc ran.
|
||||
|
@ -96,7 +88,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##inc-d f 1 }
|
||||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
} create-cfg
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
|
@ -111,7 +103,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
{ { 0 { } } { 0 { } } }
|
||||
} [
|
||||
V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
|
||||
create-cfg output-stack-map
|
||||
insns>cfg output-stack-map
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
@ -121,7 +113,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##replace { src 10 } { loc D 1 } }
|
||||
T{ ##replace { src 10 } { loc D 2 } }
|
||||
} create-cfg output-stack-map
|
||||
} insns>cfg output-stack-map
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
@ -131,7 +123,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
} create-cfg output-stack-map
|
||||
} insns>cfg output-stack-map
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
@ -142,7 +134,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
} create-cfg output-stack-map first
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
@ -152,7 +144,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
} create-cfg output-stack-map first
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
@ -169,18 +161,18 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##call }
|
||||
} create-cfg output-stack-map first
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
|
||||
: cfg1 ( -- cfg )
|
||||
V{
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
} 0 create-block
|
||||
} 0 insns>block
|
||||
V{
|
||||
T{ ##peek { dst 37 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
} 1 create-block
|
||||
} 1 insns>block
|
||||
1vector >>successors block>cfg ;
|
||||
|
||||
{ { 0 { -1 } } } [ cfg1 output-stack-map first ] unit-test
|
||||
|
@ -238,7 +230,7 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
}
|
||||
}
|
||||
} [ over create-block ] assoc-map dup
|
||||
} [ over insns>block ] assoc-map dup
|
||||
{ { 0 1 } { 1 2 } { 2 3 } { 3 8 } { 8 10 } } make-edges 0 of block>cfg ;
|
||||
|
||||
{ { 4 { 3 2 1 -3 0 -2 -1 } } } [
|
||||
|
|
|
@ -0,0 +1,6 @@
|
|||
USING: compiler.cfg help.markup help.syntax sequences ;
|
||||
IN: compiler.cfg.utilities
|
||||
|
||||
HELP: insert-basic-block
|
||||
{ $values { "from" basic-block } { "to" basic-block } { "insns" sequence } }
|
||||
{ $description "Insert basic block on the edge between 'from' and 'to'." } ;
|
|
@ -6,6 +6,15 @@ sets vectors fry arrays compiler.cfg compiler.cfg.instructions
|
|||
compiler.cfg.rpo compiler.utilities ;
|
||||
IN: compiler.cfg.utilities
|
||||
|
||||
: block>cfg ( bb -- cfg )
|
||||
cfg new swap >>entry ;
|
||||
|
||||
: insns>block ( insns n -- bb )
|
||||
<basic-block> swap >>number swap V{ } like >>instructions ;
|
||||
|
||||
: insns>cfg ( insns -- cfg )
|
||||
0 insns>block block>cfg ;
|
||||
|
||||
: back-edge? ( from to -- ? )
|
||||
[ number>> ] bi@ >= ;
|
||||
|
||||
|
@ -39,9 +48,7 @@ IN: compiler.cfg.utilities
|
|||
from successors>> [ dup to eq? [ drop bb ] when ] map! drop ;
|
||||
|
||||
:: insert-basic-block ( from to insns -- )
|
||||
! Insert basic block on the edge between 'from' and 'to'.
|
||||
<basic-block> :> bb
|
||||
insns V{ } like bb instructions<<
|
||||
insns f insns>block :> bb
|
||||
V{ from } bb predecessors<<
|
||||
V{ to } bb successors<<
|
||||
from to bb update-predecessors
|
||||
|
|
Loading…
Reference in New Issue