More accurate escape analysis

db4
Slava Pestov 2008-08-03 21:32:12 -05:00
parent 97c750b6a6
commit 0ed0167dd6
7 changed files with 100 additions and 105 deletions

View File

@ -1,13 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs namespaces sequences kernel math combinators sets
fry stack-checker.state compiler.tree.copy-equiv
compiler.tree.escape-analysis.graph ;
disjoint-sets fry stack-checker.state compiler.tree.copy-equiv ;
IN: compiler.tree.escape-analysis.allocations
SYMBOL: escaping
! A map from values to sequences of values or 'escaping'
! A map from values to sequences of values
SYMBOL: allocations
: allocation ( value -- allocation )
@ -23,35 +20,56 @@ SYMBOL: allocations
: record-allocations ( allocations values -- )
[ record-allocation ] 2each ;
: record-slot-access ( out slot# in -- )
over zero? [ 3drop ] [ allocation ?nth swap is-copy-of ] if ;
! We track escaping values with a disjoint set.
SYMBOL: escaping-values
! We track available values
SYMBOL: slot-graph
SYMBOL: +escaping+
: <escaping-values> ( -- disjoint-set )
<disjoint-set> +escaping+ over add-atom ;
: init-escaping-values ( -- )
copies get <escaping-values>
[ '[ drop , add-atom ] assoc-each ]
[ '[ , equate ] assoc-each ]
[ nip escaping-values set ]
2tri ;
: <slot-value> ( -- value )
<value>
[ introduce-value ]
[ escaping-values get add-atom ]
[ ]
tri ;
: same-value ( in-value out-value -- )
over [
[ is-copy-of ] [ escaping-values get equate ] 2bi
] [ 2drop ] if ;
: record-slot-access ( out slot# in -- )
over zero? [ 3drop ] [ allocation ?nth swap same-value ] if ;
: merge-values ( in-values out-value -- )
escaping-values get '[ , , equate ] each ;
: merge-slots ( values -- value )
dup [ ] contains? [
<value>
[ introduce-value ]
[ slot-graph get add-edges ]
[ ] tri
<slot-value> [ merge-values ] keep
] [ drop f ] if ;
! A disqualified slot value is not available for unboxing. A
! tuple may be unboxed if none of its slots have been
! disqualified.
: add-escaping-values ( values -- )
escaping-values get
'[ +escaping+ , equate ] each ;
: disqualify ( slot-value -- )
slot-graph get mark-vertex ;
: escaping-value? ( value -- ? )
+escaping+ escaping-values get equiv? ;
SYMBOL: escaping-allocations
: compute-escaping-allocations ( -- )
#! Any allocations involving unavailable slots are
#! potentially escaping, and cannot be unboxed.
allocations get
slot-graph get marked-components
'[ [ , key? ] contains? nip ] assoc-filter
[ drop escaping-value? ] assoc-filter
escaping-allocations set ;
: escaping-allocation? ( value -- ? )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces sequences sets
USING: accessors kernel namespaces sequences sets fry
stack-checker.branches
compiler.tree
compiler.tree.propagation.branches
@ -13,22 +13,21 @@ 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? [
dup [ allocation ] map dup [ ] all? [
dup [ length ] map all-equal? [
flip
nip flip
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
[ record-allocations ] keep
] [ disqualify-allocations f ] if
] [ disqualify-allocations f ] if
] [ drop add-escaping-values f ] if
] [ drop add-escaping-values f ] if
] map ;
: merge-allocations ( in-values out-values -- )
[ (merge-allocations) ] dip record-allocations ;
[ [ merge-values ] 2each ]
[ [ (merge-allocations) ] dip record-allocations ]
2bi ;
M: #phi escape-analysis*
[ [ phi-in-d>> ] [ out-d>> ] bi merge-allocations ]

View File

@ -5,10 +5,25 @@ 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 classes.tuple.private ;
prettyprint classes.tuple.private classes classes.tuple ;
\ escape-analysis must-infer
GENERIC: count-unboxed-allocations* ( m node -- n )
: (count-unboxed-allocations) ( m node -- n )
out-d>> first escaping-allocation? [ 1+ ] unless ;
M: #call count-unboxed-allocations*
dup word>> \ <tuple-boa> =
[ (count-unboxed-allocations) ] [ drop ] if ;
M: #push count-unboxed-allocations*
dup literal>> class immutable-tuple-class?
[ (count-unboxed-allocations) ] [ drop ] if ;
M: node count-unboxed-allocations* drop ;
: count-unboxed-allocations ( quot -- sizes )
build-tree
normalize
@ -16,14 +31,7 @@ prettyprint classes.tuple.private ;
propagate
cleanup
escape-analysis
0 swap [
dup #call?
[
dup word>> \ <tuple-boa> = [
out-d>> first escaping-allocation? [ 1+ ] unless
] [ drop ] if
] [ drop ] if
] each-node ;
0 swap [ count-unboxed-allocations* ] each-node ;
[ 0 ] [ [ [ + ] curry ] count-unboxed-allocations ] unit-test
@ -128,3 +136,24 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] if drop
] count-unboxed-allocations
] unit-test
[ 2 ] [
[
[ dup cons boa ] [ drop 1 2 cons boa ] if car>>
] count-unboxed-allocations
] unit-test
[ 2 ] [
[
3dup
[ cons boa ] [ cons boa 3 cons boa ] if
[ car>> ] [ cdr>> ] bi
] count-unboxed-allocations
] unit-test
[ 2 ] [
[
3dup [ cons boa ] [ cons boa . 1 2 cons boa ] if
[ car>> ] [ cdr>> ] bi
] count-unboxed-allocations
] unit-test

View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces search-dequeues
USING: kernel namespaces search-dequeues assocs fry sequences
disjoint-sets
compiler.tree
compiler.tree.def-use
compiler.tree.escape-analysis.graph
compiler.tree.copy-equiv
compiler.tree.escape-analysis.allocations
compiler.tree.escape-analysis.recursive
compiler.tree.escape-analysis.branches
@ -12,7 +13,7 @@ compiler.tree.escape-analysis.simple ;
IN: compiler.tree.escape-analysis
: escape-analysis ( node -- node )
init-escaping-values
H{ } clone allocations set
<graph> slot-graph set
dup (escape-analysis)
compute-escaping-allocations ;

View File

@ -1,19 +0,0 @@
IN: compiler.tree.escape-analysis.graph.tests
USING: compiler.tree.escape-analysis.graph tools.test namespaces
accessors ;
<graph> "graph" set
[ ] [ { 2 3 4 } 1 "graph" get add-edges ] unit-test
[ ] [ { 5 6 } 2 "graph" get add-edges ] unit-test
[ ] [ { 7 8 } 9 "graph" get add-edges ] unit-test
[ ] [ { 6 10 } 4 "graph" get add-edges ] unit-test
[ ] [ 3 "graph" get mark-vertex ] unit-test
[ H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 5 } { 6 6 } { 10 10 } } ]
[ "graph" get marked>> ] unit-test
[ ] [ { 1 11 } 12 "graph" get add-edges ] unit-test
[ t ] [ 11 "graph" get marked-vertex? ] unit-test

View File

@ -1,38 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors assocs fry sequences sets
dequeues search-dequeues namespaces ;
IN: compiler.tree.escape-analysis.graph
TUPLE: graph edges work-list ;
: <graph> ( -- graph )
H{ } clone <hashed-dlist> graph boa ;
: mark-vertex ( vertex graph -- ) work-list>> push-front ;
: add-edge ( out in graph -- )
[ edges>> push-at ] [ swapd edges>> push-at ] 3bi ;
: add-edges ( out-seq in graph -- )
'[ , , add-edge ] each ;
<PRIVATE
SYMBOL: marked
: (mark-vertex) ( vertex graph -- )
over marked get key? [ 2drop ] [
[ drop marked get conjoin ]
[ [ edges>> at ] [ work-list>> ] bi push-all-front ]
2bi
] if ;
PRIVATE>
: marked-components ( graph -- vertices )
#! All vertices in connected components of marked vertices.
H{ } clone marked [
[ work-list>> ] keep
'[ , (mark-vertex) ] slurp-dequeue
] with-variable ;

View File

@ -2,17 +2,25 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences classes.tuple
classes.tuple.private math math.private slots.private
combinators dequeues search-dequeues namespaces fry
combinators dequeues search-dequeues namespaces fry classes
stack-checker.state
compiler.tree
compiler.tree.propagation.info
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.simple
M: #push escape-analysis*
#! Delegation.
dup literal>> dup class immutable-tuple-class? [
tuple-slots length 1- [ <slot-value> ] replicate
swap out-d>> first record-allocation
] [ 2drop ] if ;
: record-tuple-allocation ( #call -- )
#! Delegation.
dup dup in-d>> peek node-value-info literal>>
class>> all-slots rest-slice [ read-only>> ] all? [
class>> immutable-tuple-class? [
[ in-d>> but-last ] [ out-d>> first ] bi
record-allocation
] [ drop ] if ;
@ -23,9 +31,6 @@ 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 ] }