compiler.cfg.*: new step in finalization: clear-uninitialized
this step is supposed to analyze the cfg, find where there are peeks that can cause stack underflow, and insert replace-imm instructions so that there are no uninitialized stack locations if they do. could fix #1187db4
Björn Lindqvist
Doug Coleman
parent
fd06e22e9a
commit
640759ffed
|
|
@ -3,7 +3,8 @@
|
|||
USING: compiler.cfg.build-stack-frame compiler.cfg.gc-checks
|
||||
compiler.cfg.linear-scan compiler.cfg.representations
|
||||
compiler.cfg.save-contexts compiler.cfg.ssa.destruction
|
||||
compiler.cfg.stacks.vacant compiler.cfg.utilities compiler.cfg.write-barrier ;
|
||||
compiler.cfg.stacks.clearing compiler.cfg.stacks.vacant compiler.cfg.utilities
|
||||
compiler.cfg.write-barrier ;
|
||||
IN: compiler.cfg.finalization
|
||||
|
||||
: finalize-cfg ( cfg -- )
|
||||
|
|
@ -11,7 +12,8 @@ IN: compiler.cfg.finalization
|
|||
select-representations
|
||||
insert-gc-checks
|
||||
eliminate-write-barriers
|
||||
compute-vacant-sets
|
||||
clear-uninitialized
|
||||
fill-gc-maps
|
||||
insert-save-contexts
|
||||
destruct-ssa
|
||||
linear-scan
|
||||
|
|
|
|||
|
|
@ -0,0 +1,21 @@
|
|||
USING: compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.stacks.clearing tools.test ;
|
||||
IN: compiler.cfg.stacks.clearing.tests
|
||||
|
||||
{ { } } [
|
||||
{ { 0 { } } { 0 { } } } state>replaces
|
||||
] unit-test
|
||||
|
||||
{ t f } [
|
||||
{ { 0 { } } { 0 { } } } T{ ##peek { loc D 0 } } dangerous-insn?
|
||||
{ { 0 { } } { 0 { } } } T{ ##peek { loc D -1 } } dangerous-insn?
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{
|
||||
T{ ##replace-imm { src 17 } { loc D 0 } }
|
||||
T{ ##replace-imm { src 17 } { loc D 1 } }
|
||||
}
|
||||
} [
|
||||
{ { 2 { } } { 0 { } } } state>replaces
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
USING: accessors arrays assocs combinators.short-circuit
|
||||
compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
|
||||
compiler.cfg.stacks.map kernel math sequences ;
|
||||
IN: compiler.cfg.stacks.clearing
|
||||
|
||||
: state>replaces ( state -- replaces )
|
||||
state>vacancies first2
|
||||
[ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi* append
|
||||
[ 17 swap f ##replace-imm boa ] map ;
|
||||
|
||||
: dangerous-insn? ( state insn -- ? )
|
||||
{ [ nip ##peek? ] [ dangerous-peek? ] } 2&& ;
|
||||
|
||||
: clearing-replaces ( assoc insn -- insns' )
|
||||
[ of ] keep 2dup dangerous-insn? [
|
||||
drop state>replaces
|
||||
] [ 2drop { } ] if ;
|
||||
|
||||
: visit-insns ( assoc insns -- insns' )
|
||||
[ [ clearing-replaces ] keep suffix ] with map V{ } concat-as ;
|
||||
|
||||
: clear-uninitialized ( cfg -- )
|
||||
[ trace-stack-state ] keep [
|
||||
[ visit-insns ] change-instructions drop
|
||||
] with each-basic-block ;
|
||||
|
|
@ -12,8 +12,8 @@ ARTICLE: "compiler.cfg.stacks.vacant" "Uninitialized/overinitialized stack locat
|
|||
}
|
||||
"The GC check runs before stack locations 0 and 1 have been initialized, and so the GC needs to scrub them so that they don't get traced. This is achieved by computing uninitialized locations with a dataflow analysis, and recording the information in GC maps. The call_frame_slot_visitor object in vm/slot_visitor.hpp reads this information from GC maps and performs the scrubbing." ;
|
||||
|
||||
HELP: initial-state
|
||||
{ $description "Initially the stack bottom is at 0 for both the data and retain stacks and no replaces have been registered." } ;
|
||||
! HELP: initial-state
|
||||
! { $description "Initially the stack bottom is at 0 for both the data and retain stacks and no replaces have been registered." } ;
|
||||
|
||||
HELP: vacant>bits
|
||||
{ $values
|
||||
|
|
|
|||
|
|
@ -5,59 +5,10 @@ compiler.cfg.utilities compiler.cfg.stacks.vacant kernel math sequences sorting
|
|||
tools.test vectors ;
|
||||
IN: compiler.cfg.stacks.vacant.tests
|
||||
|
||||
! Utils
|
||||
: 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{ } insns>cfg output-stack-map ] unit-test
|
||||
|
||||
! Raise d stack.
|
||||
{
|
||||
{ { 1 { } } { 0 { } } }
|
||||
} [ V{ T{ ##inc-d f 1 } } insns>cfg output-stack-map ] unit-test
|
||||
|
||||
! Raise r stack.
|
||||
{
|
||||
{ { 0 { } } { 1 { } } }
|
||||
} [ 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 } }
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##inc-r f 1 }
|
||||
T{ ##peek { dst 0 } { loc R 0 } }
|
||||
} insns>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 } }
|
||||
} insns>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 } }
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
{ { { } { 0 0 0 } } { { } { 0 } } }
|
||||
} [
|
||||
{ { 4 { 3 2 1 -3 0 -2 -1 } } { 0 { -1 } } } state>gc-data
|
||||
] unit-test
|
||||
|
||||
! Replace -1, then gc. Peek is ok here because the -1 should be
|
||||
|
|
@ -68,164 +19,99 @@ IN: compiler.cfg.stacks.vacant.tests
|
|||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##peek { dst 0 } { loc D -1 } }
|
||||
}
|
||||
[ insns>cfg compute-vacant-sets ]
|
||||
[ insns>cfg fill-in-gc-maps ]
|
||||
[ second gc-map>> check-d>> ] bi
|
||||
] unit-test
|
||||
|
||||
! 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 { } } } } }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek { dst 0 } { loc D -1 } }
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
! ! Replace -1, then gc. Peek is ok here because the -1 should be
|
||||
! ! checked.
|
||||
! { { 0 } } [
|
||||
! V{
|
||||
! T{ ##replace { src 10 } { loc D -1 } }
|
||||
! T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
! T{ ##peek { dst 0 } { loc D -1 } }
|
||||
! }
|
||||
! [ insns>cfg compute-vacant-sets ]
|
||||
! [ second gc-map>> check-d>> ] bi
|
||||
! ] 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 { } } } } }
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
} insns>cfg
|
||||
compute-vacant-sets
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
! ! 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 { } } } } }
|
||||
! T{ ##peek { dst 0 } { loc D 0 } }
|
||||
! } insns>cfg
|
||||
! compute-vacant-sets
|
||||
! ] [ vacant-peek? ] must-fail-with
|
||||
|
||||
! visit-insn should set the gc info.
|
||||
{ { 0 0 } { } } [
|
||||
{ { 2 { } } { 0 { } } }
|
||||
T{ ##alien-invoke { gc-map T{ gc-map } } }
|
||||
[ visit-insn drop ] keep gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi
|
||||
[ gc-map>> set-gc-map ] keep gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 0 { } } { 0 { } } }
|
||||
} [
|
||||
V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
|
||||
insns>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 } }
|
||||
} insns>cfg output-stack-map
|
||||
] unit-test
|
||||
! ! read-ok?
|
||||
! { t } [
|
||||
! 0 { 0 { 0 1 2 } } read-ok?
|
||||
! ] 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 } }
|
||||
} insns>cfg output-stack-map
|
||||
] unit-test
|
||||
! { f } [
|
||||
! 2 { 3 { } } read-ok?
|
||||
! ] 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 }
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
! { f } [
|
||||
! -1 { 3 { } } read-ok?
|
||||
! ] unit-test
|
||||
|
||||
{
|
||||
{ 0 { -1 } }
|
||||
} [
|
||||
V{
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
! ! { f } [
|
||||
! ! 4 { 3 { } } read-ok?
|
||||
! ! ] unit-test
|
||||
|
||||
{
|
||||
{ { { } { 0 0 0 } } { { } { 0 } } }
|
||||
} [
|
||||
{ { 4 { 3 2 1 -3 0 -2 -1 } } { 0 { -1 } } } state>gc-data
|
||||
] unit-test
|
||||
! { t } [
|
||||
! 4 { 0 { } } read-ok?
|
||||
! ] unit-test
|
||||
|
||||
! ##call clears the overinitialized slots.
|
||||
{
|
||||
{ -1 { } }
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##call }
|
||||
} insns>cfg output-stack-map first
|
||||
] unit-test
|
||||
! { t } [
|
||||
! 4 { 1 { 0 } } read-ok?
|
||||
! ] unit-test
|
||||
|
||||
: cfg1 ( -- cfg )
|
||||
V{
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
} 0 insns>block
|
||||
V{
|
||||
T{ ##peek { dst 37 } { loc D 0 } }
|
||||
T{ ##inc-d f -1 }
|
||||
} 1 insns>block
|
||||
1vector >>successors block>cfg ;
|
||||
! ! Uninitialized peeks
|
||||
! [
|
||||
! V{
|
||||
! T{ ##inc-d f 1 }
|
||||
! T{ ##peek { dst 0 } { loc D 0 } }
|
||||
! } insns>cfg
|
||||
! compute-vacant-sets
|
||||
! ] [ vacant-peek? ] must-fail-with
|
||||
|
||||
{ { 0 { -1 } } } [ cfg1 output-stack-map first ] unit-test
|
||||
! [
|
||||
! V{
|
||||
! T{ ##inc-r f 1 }
|
||||
! T{ ##peek { dst 0 } { loc R 0 } }
|
||||
! } insns>cfg
|
||||
! compute-vacant-sets
|
||||
! ] [ vacant-peek? ] must-fail-with
|
||||
|
||||
! 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{
|
||||
! ! Here again the peek refers to a parameter word, but there are
|
||||
! ! uninitialized stack locations. That probably isn't ok.
|
||||
! [
|
||||
! V{
|
||||
! T{ ##inc-d f 3 }
|
||||
! T{ ##peek { dst 0 } { loc D 3 } }
|
||||
! } insns>cfg
|
||||
! compute-vacant-sets
|
||||
! ] [ vacant-peek? ] must-fail-with
|
||||
|
||||
T{ ##inc-d f -3 }
|
||||
T{ ##peek { dst 0 } { loc D -3 } }
|
||||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
}
|
||||
}
|
||||
} [ 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 } } } [
|
||||
bug1021-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 { } } } } }
|
||||
! ! T{ ##peek { dst 0 } { loc D 0 } }
|
||||
! ! } insns>cfg
|
||||
! ! compute-map-sets
|
||||
! ! ] [ vacant-peek? ] must-fail-with
|
||||
|
|
|
|||
|
|
@ -1,25 +1,11 @@
|
|||
USING: accessors arrays compiler.cfg.dataflow-analysis
|
||||
compiler.cfg.instructions compiler.cfg.registers fry kernel math
|
||||
math.order sequences sets ;
|
||||
USING: accessors arrays assocs compiler.cfg.instructions
|
||||
compiler.cfg.stacks.map fry kernel math sequences ;
|
||||
IN: compiler.cfg.stacks.vacant
|
||||
|
||||
! Utils
|
||||
! ! Utils
|
||||
: write-slots ( tuple values slots -- )
|
||||
[ execute( x y -- z ) ] 2each drop ;
|
||||
|
||||
! Operations on the stack info
|
||||
: register-write ( n stack -- stack' )
|
||||
first2 rot suffix members 2array ;
|
||||
|
||||
: adjust-stack ( n stack -- stack' )
|
||||
first2 pick '[ _ + ] map [ + ] dip 2array ;
|
||||
|
||||
: read-ok? ( n stack -- ? )
|
||||
[ first >= ] [ second in? ] 2bi or ;
|
||||
|
||||
: stack>vacant ( stack -- seq )
|
||||
first2 [ 0 max iota ] dip diff ;
|
||||
|
||||
: vacant>bits ( vacant -- bits )
|
||||
[ { } ] [
|
||||
dup supremum 1 + 1 <array>
|
||||
|
|
@ -40,57 +26,10 @@ IN: compiler.cfg.stacks.vacant
|
|||
: state>gc-data ( state -- gc-data )
|
||||
[ stack>scrub-and-check ] map ;
|
||||
|
||||
CONSTANT: initial-state { { 0 { } } { 0 { } } }
|
||||
|
||||
: 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 ;
|
||||
|
||||
M: ##peek visit-insn ( state insn -- state' )
|
||||
2dup peek-loc-ok? [ drop ] [ vacant-peek ] if ;
|
||||
|
||||
M: ##call visit-insn ( state insn -- state' )
|
||||
! After a word call, we can't trust any overinitialized locations
|
||||
! to contain valid pointers anymore.
|
||||
drop [ first2 [ 0 >= ] filter 2array ] map ;
|
||||
|
||||
: set-gc-map ( state gc-map -- )
|
||||
swap state>gc-data concat
|
||||
{ >>scrub-d >>check-d >>scrub-r >>check-r } write-slots ;
|
||||
|
||||
M: gc-map-insn visit-insn ( state insn -- state' )
|
||||
dupd gc-map>> set-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 ;
|
||||
: fill-gc-maps ( cfg -- )
|
||||
trace-stack-state [ drop gc-map-insn? ] assoc-filter
|
||||
[ swap gc-map>> set-gc-map ] assoc-each ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue