compiler.cfg.utilities: move and rename the helper words block>cfg, insns>block and insns>cfg, they are useful to many testing vocabs

db4
Björn Lindqvist 2014-11-07 18:56:26 +01:00 committed by Doug Coleman
parent bc12a60a49
commit c8a022423e
3 changed files with 38 additions and 33 deletions

View File

@ -1,19 +1,11 @@
USING: accessors arrays assocs compiler.cfg USING: accessors arrays assocs compiler.cfg
compiler.cfg.dataflow-analysis.private compiler.cfg.instructions compiler.cfg.dataflow-analysis.private compiler.cfg.instructions
compiler.cfg.linearization compiler.cfg.registers compiler.cfg.stacks.vacant compiler.cfg.linearization compiler.cfg.registers
kernel math sequences sorting tools.test vectors ; compiler.cfg.utilities compiler.cfg.stacks.vacant kernel math sequences sorting
tools.test vectors ;
IN: compiler.cfg.stacks.vacant.tests IN: compiler.cfg.stacks.vacant.tests
! Utils ! 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 ) : output-stack-map ( cfg -- map )
vacant-analysis run-dataflow-analysis vacant-analysis run-dataflow-analysis
nip [ [ number>> ] dip ] assoc-map >alist natural-sort last second ; 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. ! Initially both the d and r stacks are empty.
{ {
{ { 0 { } } { 0 { } } } { { 0 { } } { 0 { } } }
} [ V{ } create-cfg output-stack-map ] unit-test } [ V{ } insns>cfg output-stack-map ] unit-test
! Raise d stack. ! Raise d stack.
{ {
{ { 1 { } } { 0 { } } } { { 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. ! Raise r stack.
{ {
{ { 0 { } } { 1 { } } } { { 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 ! Uninitialized peeks
[ [
V{ V{
T{ ##inc-d f 1 } T{ ##inc-d f 1 }
T{ ##peek { dst 0 } { loc D 0 } } T{ ##peek { dst 0 } { loc D 0 } }
} create-cfg } insns>cfg
compute-vacant-sets compute-vacant-sets
] [ vacant-peek? ] must-fail-with ] [ vacant-peek? ] must-fail-with
@ -46,7 +38,7 @@ IN: compiler.cfg.stacks.vacant.tests
V{ V{
T{ ##inc-r f 1 } T{ ##inc-r f 1 }
T{ ##peek { dst 0 } { loc R 0 } } T{ ##peek { dst 0 } { loc R 0 } }
} create-cfg } insns>cfg
compute-vacant-sets compute-vacant-sets
] [ vacant-peek? ] must-fail-with ] [ vacant-peek? ] must-fail-with
@ -55,7 +47,7 @@ IN: compiler.cfg.stacks.vacant.tests
[ ] [ [ ] [
V{ V{
T{ ##peek { dst 0 } { loc D 0 } } T{ ##peek { dst 0 } { loc D 0 } }
} create-cfg } insns>cfg
compute-vacant-sets compute-vacant-sets
] unit-test ] unit-test
@ -64,7 +56,7 @@ IN: compiler.cfg.stacks.vacant.tests
V{ V{
T{ ##replace { src 10 } { loc D -1 } } T{ ##replace { src 10 } { loc D -1 } }
T{ ##peek { dst 0 } { loc D -1 } } T{ ##peek { dst 0 } { loc D -1 } }
} create-cfg } insns>cfg
compute-vacant-sets compute-vacant-sets
] unit-test ] unit-test
@ -76,7 +68,7 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
T{ ##peek { dst 0 } { loc D -1 } } T{ ##peek { dst 0 } { loc D -1 } }
} }
[ create-cfg compute-vacant-sets ] [ insns>cfg compute-vacant-sets ]
[ second gc-map>> check-d>> ] bi [ second gc-map>> check-d>> ] bi
] unit-test ] unit-test
@ -87,7 +79,7 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
T{ ##inc-d f -1 } T{ ##inc-d f -1 }
T{ ##peek { dst 0 } { loc D -1 } } T{ ##peek { dst 0 } { loc D -1 } }
} create-cfg output-stack-map first } insns>cfg output-stack-map first
] unit-test ] unit-test
! Should not be ok because the value wasn't initialized when gc ran. ! 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{ ##inc-d f 1 }
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
T{ ##peek { dst 0 } { loc D 0 } } T{ ##peek { dst 0 } { loc D 0 } }
} create-cfg } insns>cfg
compute-vacant-sets compute-vacant-sets
] [ vacant-peek? ] must-fail-with ] [ vacant-peek? ] must-fail-with
@ -111,7 +103,7 @@ IN: compiler.cfg.stacks.vacant.tests
{ { 0 { } } { 0 { } } } { { 0 { } } { 0 { } } }
} [ } [
V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } } V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
create-cfg output-stack-map insns>cfg output-stack-map
] unit-test ] 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 0 } }
T{ ##replace { src 10 } { loc D 1 } } T{ ##replace { src 10 } { loc D 1 } }
T{ ##replace { src 10 } { loc D 2 } } T{ ##replace { src 10 } { loc D 2 } }
} create-cfg output-stack-map } insns>cfg output-stack-map
] unit-test ] unit-test
{ {
@ -131,7 +123,7 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
T{ ##inc-d f 1 } T{ ##inc-d f 1 }
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
} create-cfg output-stack-map } insns>cfg output-stack-map
] unit-test ] unit-test
{ {
@ -142,7 +134,7 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##inc-d f 1 } T{ ##inc-d f 1 }
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
T{ ##inc-d f -1 } T{ ##inc-d f -1 }
} create-cfg output-stack-map first } insns>cfg output-stack-map first
] unit-test ] unit-test
{ {
@ -152,7 +144,7 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##inc-d f 1 } T{ ##inc-d f 1 }
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
T{ ##inc-d f -1 } T{ ##inc-d f -1 }
} create-cfg output-stack-map first } insns>cfg output-stack-map first
] unit-test ] unit-test
{ {
@ -169,18 +161,18 @@ IN: compiler.cfg.stacks.vacant.tests
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
T{ ##inc-d f -1 } T{ ##inc-d f -1 }
T{ ##call } T{ ##call }
} create-cfg output-stack-map first } insns>cfg output-stack-map first
] unit-test ] unit-test
: cfg1 ( -- cfg ) : cfg1 ( -- cfg )
V{ V{
T{ ##inc-d f 1 } T{ ##inc-d f 1 }
T{ ##replace { src 10 } { loc D 0 } } T{ ##replace { src 10 } { loc D 0 } }
} 0 create-block } 0 insns>block
V{ V{
T{ ##peek { dst 37 } { loc D 0 } } T{ ##peek { dst 37 } { loc D 0 } }
T{ ##inc-d f -1 } T{ ##inc-d f -1 }
} 1 create-block } 1 insns>block
1vector >>successors block>cfg ; 1vector >>successors block>cfg ;
{ { 0 { -1 } } } [ cfg1 output-stack-map first ] unit-test { { 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 { } } } } } 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 ; { { 0 1 } { 1 2 } { 2 3 } { 3 8 } { 8 10 } } make-edges 0 of block>cfg ;
{ { 4 { 3 2 1 -3 0 -2 -1 } } } [ { { 4 { 3 2 1 -3 0 -2 -1 } } } [

View File

@ -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'." } ;

View File

@ -6,6 +6,15 @@ sets vectors fry arrays compiler.cfg compiler.cfg.instructions
compiler.cfg.rpo compiler.utilities ; compiler.cfg.rpo compiler.utilities ;
IN: compiler.cfg.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 -- ? ) : back-edge? ( from to -- ? )
[ number>> ] bi@ >= ; [ number>> ] bi@ >= ;
@ -39,9 +48,7 @@ IN: compiler.cfg.utilities
from successors>> [ dup to eq? [ drop bb ] when ] map! drop ; from successors>> [ dup to eq? [ drop bb ] when ] map! drop ;
:: insert-basic-block ( from to insns -- ) :: insert-basic-block ( from to insns -- )
! Insert basic block on the edge between 'from' and 'to'. insns f insns>block :> bb
<basic-block> :> bb
insns V{ } like bb instructions<<
V{ from } bb predecessors<< V{ from } bb predecessors<<
V{ to } bb successors<< V{ to } bb successors<<
from to bb update-predecessors from to bb update-predecessors