compiler.cfg.stacks.map: this vocab is subsumed by
compiler.cfg.stacks.padding which works much betterdb4
Björn Lindqvist
parent
bc8525bf5b
commit
eba939c0f2
|
|
@ -1,9 +0,0 @@
|
|||
USING: assocs compiler.cfg help.markup help.syntax ;
|
||||
IN: compiler.cfg.stacks.map
|
||||
|
||||
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: trace-stack-state
|
||||
{ $values { "cfg" cfg } { "assoc" assoc } }
|
||||
{ $description "Outputs an assoc with the instruction numbers as keys and as values two tuples of the data and retain stacks shapes before that instruction. All instructions in the cfg gets numbered as a side-effect." } ;
|
||||
|
|
@ -1,341 +0,0 @@
|
|||
USING: accessors arrays assocs compiler.cfg
|
||||
compiler.cfg.dataflow-analysis.private compiler.cfg.instructions
|
||||
compiler.cfg.linearization compiler.cfg.registers
|
||||
compiler.cfg.utilities compiler.cfg.stacks.map kernel math namespaces
|
||||
sequences sorting tools.test vectors ;
|
||||
IN: compiler.cfg.stacks.map.tests
|
||||
|
||||
! classify-read: vacant locations
|
||||
{ 2 2 2 } [
|
||||
{ 3 { } } 2 classify-read
|
||||
{ 0 { } } -1 classify-read
|
||||
{ 3 { } } -1 classify-read
|
||||
] unit-test
|
||||
|
||||
! classify-read: over locations
|
||||
{ 1 1 1 1 1 } [
|
||||
{ 1 { 0 } } 1 classify-read
|
||||
{ 0 { } } 0 classify-read
|
||||
{ 3 { } } 4 classify-read
|
||||
{ 0 { } } 4 classify-read
|
||||
{ 1 { 0 } } 4 classify-read
|
||||
] unit-test
|
||||
|
||||
! classify-read: initialized locations
|
||||
{ 0 0 0 } [
|
||||
{ 1 { 0 } } 0 classify-read
|
||||
{ 2 { 0 1 2 } } 0 classify-read
|
||||
{ 0 { 0 1 2 } } 0 classify-read
|
||||
] unit-test
|
||||
|
||||
! fill-vacancies
|
||||
{
|
||||
{ { 0 { } } { 2 { 0 1 } } }
|
||||
{ { 0 { } } { 2 { 0 1 } } }
|
||||
{ { 0 { -1 -2 } } { 2 { 0 1 } } }
|
||||
} [
|
||||
{ { 0 { } } { 2 { } } } fill-vacancies
|
||||
{ { 0 { } } { 2 { 0 } } } fill-vacancies
|
||||
{ { 0 { -1 -2 } } { 2 { 0 } } } fill-vacancies
|
||||
] unit-test
|
||||
|
||||
! visit-insn
|
||||
|
||||
! After a ##peek that can cause a stack underflow, it is certain that
|
||||
! all stack locations are initialized.
|
||||
{
|
||||
{ { 2 { 0 1 2 } } { 0 { } } }
|
||||
} [
|
||||
{ { 2 { } } { 0 { } } } T{ ##peek f f D 2 } visit-insn
|
||||
] unit-test
|
||||
|
||||
! If the ##peek can't cause a stack underflow, then we don't have the
|
||||
! same guarantees.
|
||||
[
|
||||
{ { 2 { } } { 0 { } } } T{ ##peek f f D 0 } visit-insn
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
! verboten peek
|
||||
[
|
||||
{ { 1 { } } { 0 { } } } T{ ##peek { loc D 0 } } visit-insn
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
|
||||
! trace-stack-state
|
||||
{
|
||||
H{
|
||||
{
|
||||
0
|
||||
{ { 0 { } } { 0 { } } }
|
||||
}
|
||||
{
|
||||
1
|
||||
{ { 2 { } } { 0 { } } }
|
||||
}
|
||||
{
|
||||
2
|
||||
{ { 2 { 0 1 2 } } { 0 { } } }
|
||||
}
|
||||
}
|
||||
} [
|
||||
{
|
||||
T{ ##inc f D 2 }
|
||||
T{ ##peek f f D 2 }
|
||||
T{ ##inc f D 0 }
|
||||
} insns>cfg trace-stack-state
|
||||
] unit-test
|
||||
|
||||
! Runs the analysis and check what the resulting stack map becomes.
|
||||
: following-stack-state ( insns -- state )
|
||||
T{ ##branch } suffix insns>cfg trace-stack-state
|
||||
>alist [ first ] sort-with last second ;
|
||||
|
||||
! Initially both the d and r stacks are empty.
|
||||
{
|
||||
{ { 0 { } } { 0 { } } }
|
||||
} [ V{ } following-stack-state ] unit-test
|
||||
|
||||
{
|
||||
H{
|
||||
{ 0 { { 0 { } } { 0 { } } } }
|
||||
{ 1 { { 0 { } } { 0 { } } } }
|
||||
{ 2 { { 0 { } } { 0 { } } } }
|
||||
}
|
||||
} [
|
||||
V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } }
|
||||
insns>cfg trace-stack-state
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 1 { } } { 0 { } } }
|
||||
} [ V{ T{ ##inc f D 1 } } following-stack-state ] unit-test
|
||||
|
||||
{
|
||||
{ { 0 { } } { 1 { } } }
|
||||
} [ V{ T{ ##inc f R 1 } } following-stack-state ] unit-test
|
||||
|
||||
! Here the peek refers to a parameter of the word.
|
||||
{
|
||||
{ { 0 { 25 } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##peek { loc D 25 } }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
! The peek "causes" the vacant locations to become populated.
|
||||
{
|
||||
H{
|
||||
{ 0 { { 0 { } } { 0 { } } } }
|
||||
{ 1 { { 3 { } } { 0 { } } } }
|
||||
{ 2 { { 3 { 0 1 2 3 } } { 0 { } } } }
|
||||
}
|
||||
} [
|
||||
V{
|
||||
T{ ##inc f D 3 }
|
||||
T{ ##peek { loc D 3 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
insns>cfg trace-stack-state
|
||||
] unit-test
|
||||
|
||||
! Replace -1 then peek is ok.
|
||||
{
|
||||
H{
|
||||
{ 0 { { 0 { } } { 0 { } } } }
|
||||
{ 1 { { 0 { -1 } } { 0 { } } } }
|
||||
{ 2 { { 0 { -1 } } { 0 { } } } }
|
||||
}
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D -1 } }
|
||||
T{ ##peek { loc D -1 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
insns>cfg trace-stack-state
|
||||
] unit-test
|
||||
|
||||
! Should be ok because the value was at 0 when the gc ran.
|
||||
{
|
||||
{ { -1 { -1 } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##inc f D -1 }
|
||||
T{ ##peek { loc D -1 } }
|
||||
} following-stack-state
|
||||
] 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 } }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 1 { 1 0 } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 0 { 0 } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc f D -1 }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 0 { } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc f D -1 }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
! ##call clears the overinitialized slots.
|
||||
{
|
||||
{ { -1 { } } { 0 { } } }
|
||||
} [
|
||||
V{
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
T{ ##inc f D -1 }
|
||||
T{ ##call }
|
||||
} following-stack-state
|
||||
] unit-test
|
||||
|
||||
! Should not be ok because the value wasn't initialized when gc ran.
|
||||
[
|
||||
V{
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
|
||||
T{ ##peek { loc D 0 } }
|
||||
} following-stack-state
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##peek { loc D 0 } }
|
||||
} following-stack-state
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##inc f R 1 }
|
||||
T{ ##peek { loc R 0 } }
|
||||
} following-stack-state
|
||||
] [ vacant-peek? ] must-fail-with
|
||||
|
||||
: cfg1 ( -- cfg )
|
||||
V{
|
||||
T{ ##inc f D 1 }
|
||||
T{ ##replace { src 10 } { loc D 0 } }
|
||||
} 0 insns>block
|
||||
V{
|
||||
T{ ##peek { dst 37 } { loc D 0 } }
|
||||
T{ ##inc f D -1 }
|
||||
} 1 insns>block
|
||||
1vector >>successors block>cfg ;
|
||||
|
||||
{
|
||||
H{
|
||||
{ 0 { { 0 { } } { 0 { } } } }
|
||||
{ 1 { { 1 { } } { 0 { } } } }
|
||||
{ 2 { { 1 { 0 } } { 0 { } } } }
|
||||
{ 3 { { 1 { 0 } } { 0 { } } } }
|
||||
}
|
||||
} [ cfg1 trace-stack-state ] unit-test
|
||||
|
||||
! 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 f D 2 }
|
||||
T{ ##replace { src 0 } { loc D 1 } }
|
||||
T{ ##replace { src 0 } { loc D 0 } }
|
||||
}
|
||||
}
|
||||
{
|
||||
2 V{
|
||||
T{ ##call { word <array> } }
|
||||
}
|
||||
}
|
||||
{
|
||||
3 V{
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
T{ ##peek { dst 0 } { loc D 1 } }
|
||||
T{ ##inc f D 2 }
|
||||
T{ ##replace { src 0 } { loc D 2 } }
|
||||
T{ ##replace { src 0 } { loc D 3 } }
|
||||
T{ ##replace { src 0 } { loc D 1 } }
|
||||
}
|
||||
}
|
||||
{
|
||||
8 V{
|
||||
T{ ##peek { dst 0 } { loc D 2 } }
|
||||
T{ ##peek { dst 0 } { loc D 1 } }
|
||||
T{ ##inc f D 3 }
|
||||
T{ ##replace { src 0 } { loc D 0 } }
|
||||
T{ ##replace { src 0 } { loc D 1 } }
|
||||
T{ ##replace { src 0 } { loc D 2 } }
|
||||
T{ ##replace { src 0 } { loc D 3 } }
|
||||
}
|
||||
}
|
||||
{
|
||||
10 V{
|
||||
T{ ##inc f D -3 }
|
||||
T{ ##peek { dst 0 } { loc D 0 } }
|
||||
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 ;
|
||||
|
||||
{
|
||||
H{
|
||||
{ 0 { { 0 { } } { 0 { } } } }
|
||||
{ 1 { { 0 { } } { 0 { } } } }
|
||||
{ 2 { { 0 { } } { 0 { } } } }
|
||||
{ 3 { { 0 { } } { 0 { } } } }
|
||||
{ 4 { { 2 { } } { 0 { } } } }
|
||||
{ 5 { { 2 { 1 } } { 0 { } } } }
|
||||
{ 6 { { 2 { 1 0 } } { 0 { } } } }
|
||||
{ 7 { { 2 { 1 0 } } { 0 { } } } }
|
||||
{ 8 { { 2 { 1 0 } } { 0 { } } } }
|
||||
{ 9 { { 2 { 1 0 } } { 0 { } } } }
|
||||
{ 10 { { 4 { 3 2 } } { 0 { } } } }
|
||||
{ 11 { { 4 { 3 2 } } { 0 { } } } }
|
||||
{ 12 { { 4 { 3 2 } } { 0 { } } } }
|
||||
{ 13 { { 4 { 3 2 1 } } { 0 { } } } }
|
||||
{ 14 { { 4 { 3 2 1 } } { 0 { } } } }
|
||||
{ 15 { { 4 { 3 2 1 } } { 0 { } } } }
|
||||
{ 16 { { 7 { 6 5 4 } } { 0 { } } } }
|
||||
{ 17 { { 7 { 6 5 4 0 } } { 0 { } } } }
|
||||
{ 18 { { 7 { 6 5 4 0 1 } } { 0 { } } } }
|
||||
{ 19 { { 7 { 6 5 4 0 1 2 } } { 0 { } } } }
|
||||
{ 20 { { 7 { 6 5 4 0 1 2 3 } } { 0 { } } } }
|
||||
{ 21 { { 4 { 3 2 1 0 } } { 0 { } } } }
|
||||
{ 22 { { 4 { 3 2 1 0 } } { 0 { } } } }
|
||||
}
|
||||
} [
|
||||
bug1021-cfg trace-stack-state
|
||||
] unit-test
|
||||
|
|
@ -1,78 +0,0 @@
|
|||
USING: accessors arrays assocs compiler.cfg.dataflow-analysis
|
||||
compiler.cfg.instructions compiler.cfg.linearization
|
||||
compiler.cfg.stacks.local fry kernel math math.order namespaces
|
||||
sequences sets ;
|
||||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.stacks.map
|
||||
|
||||
! 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 ;
|
||||
|
||||
: stack>vacant ( stack -- seq )
|
||||
first2 [ 0 max iota ] dip diff ;
|
||||
|
||||
: classify-read ( stack n -- val )
|
||||
swap 2dup second member? [ 2drop 0 ] [ first >= [ 1 ] [ 2 ] if ] if ;
|
||||
|
||||
CONSTANT: initial-state { { 0 { } } { 0 { } } }
|
||||
|
||||
: mark-location ( state insn -- state' )
|
||||
[ first2 ] dip loc>> >loc<
|
||||
[ rot register-write swap ] [ swap register-write ] if 2array ;
|
||||
|
||||
: fill-vacancies ( state -- state' )
|
||||
[ [ first2 ] [ stack>vacant ] bi append 2array ] map ;
|
||||
|
||||
GENERIC: visit-insn ( state insn -- state' )
|
||||
|
||||
M: ##inc visit-insn ( state insn -- state' )
|
||||
[ first2 ] dip loc>> >loc<
|
||||
[ rot adjust-stack swap ] [ swap adjust-stack ] if 2array
|
||||
! Negative out-of stack locations immediately becomes garbage.
|
||||
[ first2 [ 0 >= ] filter 2array ] map ;
|
||||
|
||||
M: ##replace-imm visit-insn mark-location ;
|
||||
M: ##replace visit-insn mark-location ;
|
||||
|
||||
ERROR: vacant-peek insn ;
|
||||
|
||||
: underflowable-peek? ( state peek -- ? )
|
||||
2dup loc>> >loc< swap [ 0 1 ? swap nth ] dip classify-read
|
||||
dup 2 = [ drop vacant-peek ] [ 2nip 1 = ] if ;
|
||||
|
||||
M: ##peek visit-insn ( state insn -- state' )
|
||||
2dup underflowable-peek? [ [ fill-vacancies ] dip ] when mark-location ;
|
||||
|
||||
M: insn visit-insn ( state insn -- state' )
|
||||
drop ;
|
||||
|
||||
FORWARD-ANALYSIS: map
|
||||
|
||||
SYMBOL: stack-record
|
||||
|
||||
: register-stack-state ( state insn -- )
|
||||
insn#>> stack-record get 2dup at f assert= set-at ;
|
||||
|
||||
M: map-analysis transfer-set ( in-set bb dfa -- out-set )
|
||||
drop instructions>> swap [
|
||||
[ register-stack-state ] [ visit-insn ] 2bi
|
||||
] reduce ;
|
||||
|
||||
M: map-analysis ignore-block? ( bb dfa -- ? )
|
||||
2drop f ;
|
||||
|
||||
! Picking the first means that a block will only be analyzed once.
|
||||
M: map-analysis join-sets ( sets bb dfa -- set )
|
||||
2drop [ initial-state ] [ first ] if-empty ;
|
||||
|
||||
: uniquely-number-instructions ( cfg -- )
|
||||
cfg>insns [ swap insn#<< ] each-index ;
|
||||
|
||||
: trace-stack-state ( cfg -- assoc )
|
||||
H{ } clone stack-record set
|
||||
[ uniquely-number-instructions ] [ compute-map-sets ] bi
|
||||
stack-record get ;
|
||||
Loading…
Reference in New Issue