More accurate escape analysis
Slava Pestov
parent
97c750b6a6
commit
0ed0167dd6
|
|
@ -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 -- ? )
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ] }
|
||||
|
|
|
|||
Loading…
Reference in New Issue