Working on escape analysis

db4
Slava Pestov 2008-08-02 20:21:25 -05:00
parent 9ca1b4eeaf
commit d14efabed3
5 changed files with 164 additions and 6 deletions

View File

@ -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* ;

View File

@ -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 -- )

View File

@ -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

View File

@ -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) ;

View File

@ -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 ] }