Working on escape analysis
Slava Pestov
parent
9ca1b4eeaf
commit
d14efabed3
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs namespaces sequences kernel math
|
||||
USING: assocs namespaces sequences kernel math combinators sets
|
||||
stack-checker.state compiler.tree.copy-equiv ;
|
||||
IN: compiler.tree.escape-analysis.allocations
|
||||
|
||||
|
|
@ -13,7 +13,11 @@ SYMBOL: allocations
|
|||
resolve-copy allocations get at ;
|
||||
|
||||
: record-allocation ( allocation value -- )
|
||||
allocations get set-at ;
|
||||
{
|
||||
{ [ dup not ] [ 2drop ] }
|
||||
{ [ over not ] [ allocations get delete-at drop ] }
|
||||
[ allocations get set-at ]
|
||||
} cond ;
|
||||
|
||||
: record-allocations ( allocations values -- )
|
||||
[ record-allocation ] 2each ;
|
||||
|
|
@ -25,4 +29,20 @@ SYMBOL: allocations
|
|||
SYMBOL: slot-merging
|
||||
|
||||
: merge-slots ( values -- value )
|
||||
<value> [ introduce-value ] [ slot-merging get set-at ] [ ] tri ;
|
||||
dup [ ] contains? [
|
||||
<value>
|
||||
[ introduce-value ]
|
||||
[ slot-merging get set-at ]
|
||||
[ ] tri
|
||||
] [ drop f ] if ;
|
||||
|
||||
! If an allocation's slot appears in this set, the allocation
|
||||
! is disqualified from unboxing.
|
||||
SYMBOL: disqualified
|
||||
|
||||
: disqualify ( slot-value -- )
|
||||
[ disqualified get conjoin ]
|
||||
[ slot-merging get at [ disqualify ] each ] bi ;
|
||||
|
||||
: escaping-allocation? ( value -- ? )
|
||||
allocation [ [ disqualified get key? ] contains? ] [ t ] if* ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel namespaces sequences
|
||||
USING: accessors kernel namespaces sequences sets
|
||||
stack-checker.branches
|
||||
compiler.tree
|
||||
compiler.tree.propagation.branches
|
||||
compiler.tree.escape-analysis.nodes
|
||||
|
|
@ -12,6 +13,9 @@ SYMBOL: children-escape-data
|
|||
M: #branch escape-analysis*
|
||||
live-children sift [ (escape-analysis) ] each ;
|
||||
|
||||
: disqualify-allocations ( allocations -- )
|
||||
[ [ disqualify ] each ] each ;
|
||||
|
||||
: (merge-allocations) ( values -- allocation )
|
||||
[
|
||||
[ allocation ] map dup [ ] all? [
|
||||
|
|
@ -19,8 +23,8 @@ M: #branch escape-analysis*
|
|||
flip
|
||||
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
|
||||
[ record-allocations ] keep
|
||||
] [ drop f ] if
|
||||
] [ drop f ] if
|
||||
] [ disqualify-allocations f ] if
|
||||
] [ disqualify-allocations f ] if
|
||||
] map ;
|
||||
|
||||
: merge-allocations ( in-values out-values -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1,130 @@
|
|||
IN: compiler.tree.escape-analysis.tests
|
||||
USING: compiler.tree.escape-analysis
|
||||
compiler.tree.escape-analysis.allocations compiler.tree.builder
|
||||
compiler.tree.normalization compiler.tree.copy-equiv
|
||||
compiler.tree.propagation compiler.tree.cleanup
|
||||
compiler.tree.combinators compiler.tree sequences math
|
||||
kernel tools.test accessors slots.private quotations.private
|
||||
prettyprint ;
|
||||
|
||||
\ escape-analysis must-infer
|
||||
|
||||
: count-unboxed-allocations ( quot -- sizes )
|
||||
build-tree
|
||||
normalize
|
||||
compute-copy-equiv
|
||||
propagate
|
||||
cleanup
|
||||
escape-analysis
|
||||
0 swap [
|
||||
dup #call?
|
||||
[
|
||||
out-d>> dup empty? [ drop ] [
|
||||
first escaping-allocation? [ 1+ ] unless
|
||||
] if
|
||||
] [ drop ] if
|
||||
] each-node ;
|
||||
|
||||
[ 0 ] [ [ [ + ] curry ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry drop ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry 3 slot ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry 3 slot drop ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry uncurry ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 0 ] [ [ [ [ + ] curry ] [ drop [ ] ] if ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[ [ [ + ] curry ] [ [ * ] curry ] if uncurry ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[ [ [ + ] curry ] [ [ * ] curry ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if uncurry ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[ [ [ + ] curry 4 ] [ dup [ [ * ] curry ] [ [ / ] curry ] if uncurry ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
TUPLE: cons { car read-only } { cdr read-only } ;
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] when
|
||||
] if car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] if car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] unless car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if car>>
|
||||
] if
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa dup .
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] if drop
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
|
@ -14,5 +14,6 @@ IN: compiler.tree.escape-analysis
|
|||
: escape-analysis ( node -- node )
|
||||
H{ } clone slot-merging set
|
||||
H{ } clone allocations set
|
||||
H{ } clone disqualified set
|
||||
<hashed-dlist> work-list set
|
||||
dup (escape-analysis) ;
|
||||
|
|
|
|||
|
|
@ -24,6 +24,9 @@ IN: compiler.tree.escape-analysis.simple
|
|||
[ in-d>> first ] tri
|
||||
over fixnum? [ [ 3 - ] dip record-slot-access ] [ 3drop ] if ;
|
||||
|
||||
: add-escaping-values ( values -- )
|
||||
[ allocation [ disqualify ] each ] each ;
|
||||
|
||||
M: #call escape-analysis*
|
||||
dup word>> {
|
||||
{ \ <tuple-boa> [ record-tuple-allocation ] }
|
||||
|
|
|
|||
Loading…
Reference in New Issue