compiler.cfg.stacks.vacant: compiler pass replacing uninitialized for more accurate stack maps
This pass uses a better algorithm for keeping track of all stack manipulations which means that the stack maps it assigns are much more precise.db4
Björn Lindqvist
Doug Coleman
parent
d1032c159a
commit
e961a03837
|
|
@ -4,7 +4,7 @@ USING: kernel compiler.cfg.representations
|
||||||
compiler.cfg.scheduling compiler.cfg.gc-checks
|
compiler.cfg.scheduling compiler.cfg.gc-checks
|
||||||
compiler.cfg.write-barrier compiler.cfg.save-contexts
|
compiler.cfg.write-barrier compiler.cfg.save-contexts
|
||||||
compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
|
compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
|
||||||
compiler.cfg.linear-scan compiler.cfg.stacks.uninitialized ;
|
compiler.cfg.linear-scan compiler.cfg.stacks.vacant ;
|
||||||
IN: compiler.cfg.finalization
|
IN: compiler.cfg.finalization
|
||||||
|
|
||||||
: finalize-cfg ( cfg -- cfg' )
|
: finalize-cfg ( cfg -- cfg' )
|
||||||
|
|
@ -12,7 +12,7 @@ IN: compiler.cfg.finalization
|
||||||
schedule-instructions
|
schedule-instructions
|
||||||
insert-gc-checks
|
insert-gc-checks
|
||||||
eliminate-write-barriers
|
eliminate-write-barriers
|
||||||
dup compute-uninitialized-sets
|
dup compute-vacant-sets
|
||||||
insert-save-contexts
|
insert-save-contexts
|
||||||
destruct-ssa
|
destruct-ssa
|
||||||
linear-scan
|
linear-scan
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,222 @@
|
||||||
|
USING: accessors arrays assocs compiler.cfg
|
||||||
|
compiler.cfg.dataflow-analysis.private compiler.cfg.instructions
|
||||||
|
compiler.cfg.registers 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 ;
|
||||||
|
|
||||||
|
! Initially both the d and r stacks are empty.
|
||||||
|
{
|
||||||
|
{ { 0 { } } { 0 { } } }
|
||||||
|
} [ V{ } create-cfg output-stack-map ] unit-test
|
||||||
|
|
||||||
|
! Raise d stack.
|
||||||
|
{
|
||||||
|
{ { 1 { } } { 0 { } } }
|
||||||
|
} [ V{ T{ ##inc-d f 1 } } create-cfg output-stack-map ] unit-test
|
||||||
|
|
||||||
|
! Raise r stack.
|
||||||
|
{
|
||||||
|
{ { 0 { } } { 1 { } } }
|
||||||
|
} [ V{ T{ ##inc-r f 1 } } create-cfg output-stack-map ] unit-test
|
||||||
|
|
||||||
|
! Uninitialized peeks
|
||||||
|
! [
|
||||||
|
! V{
|
||||||
|
! T{ ##inc-d f 1 }
|
||||||
|
! T{ ##peek { dst 0 } { loc D 0 } }
|
||||||
|
! } create-cfg
|
||||||
|
! compute-vacant-sets
|
||||||
|
! ] [ vacant-peek? ] must-fail-with
|
||||||
|
|
||||||
|
! [
|
||||||
|
! V{
|
||||||
|
! T{ ##inc-r f 1 }
|
||||||
|
! T{ ##peek { dst 0 } { loc R 0 } }
|
||||||
|
! } create-cfg
|
||||||
|
! compute-vacant-sets
|
||||||
|
! ] [ vacant-peek? ] must-fail-with
|
||||||
|
|
||||||
|
|
||||||
|
! Here the peek refers to a parameter of the word.
|
||||||
|
[ ] [
|
||||||
|
V{
|
||||||
|
T{ ##peek { dst 0 } { loc D 0 } }
|
||||||
|
} create-cfg
|
||||||
|
compute-vacant-sets
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Replace -1 then peek is ok.
|
||||||
|
[ ] [
|
||||||
|
V{
|
||||||
|
T{ ##replace { src 10 } { loc D -1 } }
|
||||||
|
T{ ##peek { dst 0 } { loc D -1 } }
|
||||||
|
} create-cfg
|
||||||
|
compute-vacant-sets
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Replace -1, then gc, then peek is not ok.
|
||||||
|
! [
|
||||||
|
! V{
|
||||||
|
! T{ ##replace { src 10 } { loc D -1 } }
|
||||||
|
! T{ ##alien-invoke { gc-map T{ gc-map { scrub-d B{ } } } } }
|
||||||
|
! T{ ##peek { dst 0 } { loc D -1 } }
|
||||||
|
! } create-cfg
|
||||||
|
! compute-vacant-sets
|
||||||
|
! ] [ vacant-peek? ] must-fail-with
|
||||||
|
|
||||||
|
! Should be ok because the value was at 0 when the gc ran.
|
||||||
|
{ { -1 { -1 } } } [
|
||||||
|
V{
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d B{ } } } } }
|
||||||
|
T{ ##inc-d f -1 }
|
||||||
|
T{ ##peek { dst 0 } { loc D -1 } }
|
||||||
|
} create-cfg output-stack-map first
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Should not be ok because the value wasn't initialized when gc ran.
|
||||||
|
! [
|
||||||
|
! V{
|
||||||
|
! T{ ##inc-d f 1 }
|
||||||
|
! T{ ##alien-invoke { gc-map T{ gc-map { scrub-d B{ } } } } }
|
||||||
|
! T{ ##peek { dst 0 } { loc D 0 } }
|
||||||
|
! } create-cfg
|
||||||
|
! compute-vacant-sets
|
||||||
|
! ] [ vacant-peek? ] must-fail-with
|
||||||
|
|
||||||
|
! visit-insn should set the gc info.
|
||||||
|
{ B{ 0 0 } B{ } } [
|
||||||
|
{ { 2 { } } { 0 { } } }
|
||||||
|
T{ ##alien-invoke { gc-map T{ gc-map } } }
|
||||||
|
[ visit-insn drop ] keep gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ { { 0 { } } { 0 { } } } } [
|
||||||
|
V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
|
||||||
|
create-cfg output-stack-map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{
|
||||||
|
{ { 0 { 0 1 2 } } { 0 { } } }
|
||||||
|
} [
|
||||||
|
V{
|
||||||
|
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
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{
|
||||||
|
{ { 1 { 1 0 } } { 0 { } } }
|
||||||
|
} [
|
||||||
|
V{
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
T{ ##inc-d f 1 }
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
} create-cfg output-stack-map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{
|
||||||
|
{ 0 { 0 -1 } }
|
||||||
|
} [
|
||||||
|
V{
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
T{ ##inc-d f 1 }
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
T{ ##inc-d f -1 }
|
||||||
|
} create-cfg output-stack-map first
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ { 0 { -1 } } }
|
||||||
|
[
|
||||||
|
V{
|
||||||
|
T{ ##inc-d f 1 }
|
||||||
|
T{ ##replace { src 10 } { loc D 0 } }
|
||||||
|
T{ ##inc-d f -1 }
|
||||||
|
} create-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
|
||||||
|
V{
|
||||||
|
T{ ##peek { dst 37 } { loc D 0 } }
|
||||||
|
T{ ##inc-d f -1 }
|
||||||
|
} 1 create-block
|
||||||
|
1vector >>successors block>cfg ;
|
||||||
|
|
||||||
|
{ { 0 { -1 } } } [ cfg1 output-stack-map first ] unit-test
|
||||||
|
|
||||||
|
: connect-bbs ( from to -- )
|
||||||
|
[ [ successors>> ] dip suffix! drop ]
|
||||||
|
[ predecessors>> swap suffix! drop ] 2bi ;
|
||||||
|
|
||||||
|
: make-edges ( block-map edgelist -- )
|
||||||
|
[ [ of ] with map first2 connect-bbs ] with each ;
|
||||||
|
|
||||||
|
! Same cfg structure as the bug1021:run-test word but with
|
||||||
|
! non-datastack instructions mostly omitted.
|
||||||
|
: bug1021-cfg ( -- cfg )
|
||||||
|
{
|
||||||
|
{ 0 V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } } }
|
||||||
|
{
|
||||||
|
1 V{
|
||||||
|
T{ ##inc-d f 2 }
|
||||||
|
T{ ##replace { src 0 } { loc D 1 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 0 } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
2 V{
|
||||||
|
T{ ##call { word <array> } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
3 V{
|
||||||
|
T{ ##inc-d f 2 }
|
||||||
|
T{ ##peek { dst 0 } { loc D 2 } }
|
||||||
|
T{ ##peek { dst 0 } { loc D 3 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 2 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 3 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 1 } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
8 V{
|
||||||
|
T{ ##inc-d f 3 }
|
||||||
|
T{ ##peek { dst 0 } { loc D 5 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 0 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 3 } }
|
||||||
|
T{ ##peek { dst 0 } { loc D 4 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 1 } }
|
||||||
|
T{ ##replace { src 0 } { loc D 2 } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
10 V{
|
||||||
|
|
||||||
|
T{ ##inc-d f -3 }
|
||||||
|
T{ ##peek { dst 0 } { loc D -3 } }
|
||||||
|
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d B{ } } } } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} [ over create-block ] assoc-map dup
|
||||||
|
{ { 0 1 } { 1 2 } { 2 3 } { 3 8 } { 8 10 } } make-edges 0 of block>cfg ;
|
||||||
|
|
||||||
|
{ { 4 { 3 2 1 0 } } } [ bug1021-cfg output-stack-map first ] unit-test
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
USING: accessors arrays byte-arrays classes compiler.cfg.dataflow-analysis
|
||||||
|
compiler.cfg.instructions compiler.cfg.registers
|
||||||
|
formatting fry io kernel math math.order sequences sets ;
|
||||||
|
QUALIFIED: sets
|
||||||
|
IN: compiler.cfg.stacks.vacant
|
||||||
|
|
||||||
|
! Operations on the stack info
|
||||||
|
: register-write ( n stack -- stack' )
|
||||||
|
first2 rot suffix sets:members 2array ;
|
||||||
|
|
||||||
|
: adjust-stack ( n stack -- stack' )
|
||||||
|
first2 pick '[ _ + ] map [ + ] dip 2array ;
|
||||||
|
|
||||||
|
: read-ok? ( n stack -- ? )
|
||||||
|
[ first >= ] [ second in? ] 2bi or ;
|
||||||
|
|
||||||
|
! After a gc, negative writes have been erased.
|
||||||
|
: register-gc ( stack -- stack' )
|
||||||
|
first2 [ 0 >= ] filter 2array ;
|
||||||
|
|
||||||
|
: stack>vacant ( stack -- seq )
|
||||||
|
first2 [ 0 max iota ] dip diff ;
|
||||||
|
|
||||||
|
: vacant>byte-array ( seq -- ba )
|
||||||
|
[ B{ } ] [
|
||||||
|
dup supremum 1 + 1 <array>
|
||||||
|
[ '[ _ 0 -rot set-nth ] each ] keep >byte-array
|
||||||
|
] if-empty ;
|
||||||
|
|
||||||
|
! Operations on the analysis state
|
||||||
|
: state>gc-map ( state -- pair )
|
||||||
|
[ stack>vacant vacant>byte-array ] map ;
|
||||||
|
|
||||||
|
! Stack bottom is 0 for d and r and no replaces.
|
||||||
|
: initial-state ( -- state )
|
||||||
|
{ { 0 { } } { 0 { } } } ;
|
||||||
|
|
||||||
|
: insn>gc-map ( insn -- pair )
|
||||||
|
gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi 2array ;
|
||||||
|
|
||||||
|
! : log-gc-map-insn ( state insn -- )
|
||||||
|
! [ state>gc-map ] [ [ class-of ] [ insn>gc-map ] bi ] bi* rot
|
||||||
|
! 2dup = not [ "%u: given %u have %u\n" printf ] [ 3drop ] if ;
|
||||||
|
|
||||||
|
: insn>location ( insn -- n ds? )
|
||||||
|
loc>> [ n>> ] [ ds-loc? ] bi ;
|
||||||
|
|
||||||
|
: visit-replace ( state insn -- state' )
|
||||||
|
[ first2 ] dip insn>location
|
||||||
|
[ rot register-write swap ] [ swap register-write ] if 2array ;
|
||||||
|
|
||||||
|
ERROR: vacant-peek insn ;
|
||||||
|
|
||||||
|
: peek-loc-ok? ( state insn -- ? )
|
||||||
|
insn>location 0 1 ? rot nth read-ok? ;
|
||||||
|
|
||||||
|
GENERIC: visit-insn ( state insn -- state' )
|
||||||
|
|
||||||
|
M: ##inc-d visit-insn ( state insn -- state' )
|
||||||
|
n>> swap first2 [ adjust-stack ] dip 2array ;
|
||||||
|
|
||||||
|
M: ##inc-r visit-insn ( state insn -- state' )
|
||||||
|
n>> swap first2 swapd adjust-stack 2array ;
|
||||||
|
|
||||||
|
M: ##replace-imm visit-insn visit-replace ;
|
||||||
|
M: ##replace visit-insn visit-replace ;
|
||||||
|
|
||||||
|
! Disabled for now until support is added for tracking overinitialized
|
||||||
|
! stack locations.
|
||||||
|
M: ##peek visit-insn ( state insn -- state' )
|
||||||
|
drop ;
|
||||||
|
! 2dup peek-loc-ok? [ drop ] [ vacant-peek ] if ;
|
||||||
|
|
||||||
|
: set-gc-map ( state insn -- )
|
||||||
|
gc-map>> swap state>gc-map first2 [ >>scrub-d ] [ >>scrub-r ] bi* drop ;
|
||||||
|
|
||||||
|
M: gc-map-insn visit-insn ( state insn -- state' )
|
||||||
|
dupd set-gc-map [ register-gc ] map ;
|
||||||
|
! gc-map>> swap state>gc-map first2
|
||||||
|
! [ >>scrub-d ] [ >>scrub-r ] bi* drop ;
|
||||||
|
! 2dup log-gc-map-insn drop [ register-gc ] map ;
|
||||||
|
|
||||||
|
M: insn visit-insn ( state insn -- state' )
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
FORWARD-ANALYSIS: vacant
|
||||||
|
|
||||||
|
M: vacant-analysis transfer-set ( in-set bb dfa -- out-set )
|
||||||
|
drop instructions>> swap [ visit-insn ] reduce ;
|
||||||
|
|
||||||
|
M: vacant-analysis ignore-block? ( bb dfa -- ? )
|
||||||
|
2drop f ;
|
||||||
|
|
||||||
|
! Picking the first means that a block will only be analyzed once.
|
||||||
|
M: vacant-analysis join-sets ( sets bb dfa -- set )
|
||||||
|
2drop [ initial-state ] [ first ] if-empty ;
|
||||||
Loading…
Reference in New Issue