Working on recursive escape analysis

db4
Slava Pestov 2008-08-04 04:35:31 -05:00
parent 04a72f2472
commit 175b6deee5
7 changed files with 111 additions and 40 deletions

View File

@ -8,7 +8,8 @@ compiler.tree.combinators ;
IN: compiler.tree.copy-equiv
! Two values are copy-equivalent if they are always identical
! at run-time ("DS" relation).
! at run-time ("DS" relation). This is just a weak form of
! value numbering.
! Mapping from values to their canonical leader
SYMBOL: copies
@ -25,7 +26,8 @@ SYMBOL: copies
] if
] ;
: resolve-copy ( copy -- val ) copies get compress-path ;
: resolve-copy ( copy -- val )
copies get compress-path [ "Unknown value" throw ] unless* ;
: is-copy-of ( val copy -- ) copies get set-at ;
@ -55,7 +57,7 @@ M: #return-recursive compute-copy-equiv*
#! An output is a copy of every input if all inputs are
#! copies of the same original value.
[
swap [ resolve-copy ] map sift
swap sift [ resolve-copy ] map
dup [ all-equal? ] [ empty? not ] bi and
[ first swap is-copy-of ] [ 2drop ] if
] 2each ;

View File

@ -1,26 +1,41 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs namespaces sequences kernel math combinators sets
disjoint-sets fry stack-checker.state compiler.tree.copy-equiv ;
USING: accessors assocs namespaces sequences kernel math
combinators sets disjoint-sets fry stack-checker.state
compiler.tree.copy-equiv ;
IN: compiler.tree.escape-analysis.allocations
! A map from values to one of the following:
! - f -- initial status, assigned to values we have not seen yet;
! may potentially become an allocation later
! - a sequence of values -- potentially unboxed tuple allocations
! - t -- not allocated locally, can never be unboxed
! - t -- not allocated in this procedure, can never be unboxed
SYMBOL: allocations
: (allocation) resolve-copy allocations get ; inline
TUPLE: slot-access slot# value ;
: allocation ( value -- allocation ) (allocation) at ;
C: <slot-access> slot-access
: (allocation) ( value -- value' allocations )
resolve-copy allocations get ; inline
: allocation ( value -- allocation )
(allocation) at dup slot-access? [
[ slot#>> ] [ value>> allocation ] bi nth
allocation
] when ;
: record-allocation ( allocation value -- ) (allocation) set-at ;
: unknown-allocation ( value -- ) t swap record-allocation ;
: record-allocations ( allocations values -- )
[ record-allocation ] 2each ;
: unknown-allocations ( values -- )
[ unknown-allocation ] each ;
! We track escaping values with a disjoint set.
SYMBOL: escaping-values
@ -40,21 +55,16 @@ SYMBOL: +escaping+
[ ]
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 ;
over zero? [ 3drop ] [
<slot-access> swap record-allocation
] if ;
: merge-values ( in-values out-value -- )
escaping-values get '[ , , equate ] each ;
: merge-slots ( values -- value )
dup [ ] contains? [
<slot-value> [ merge-values ] keep
] [ drop f ] if ;
<slot-value> [ merge-values ] keep ;
: add-escaping-values ( values -- )
escaping-values get

View File

@ -13,16 +13,19 @@ M: #branch escape-analysis*
: (merge-allocations) ( values -- allocation )
[
dup [ allocation ] map dup [ ] all? [
dup [ length ] map all-equal? [
nip flip
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
[ record-allocations ] keep
] [ drop add-escaping-values f ] if
] [ drop add-escaping-values f ] if
dup [ allocation ] map sift dup empty? [ 2drop f ] [
dup [ t eq? not ] all? [
dup [ length ] map all-equal? [
nip flip
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
[ record-allocations ] keep
] [ drop add-escaping-values t ] if
] [ drop add-escaping-values t ] if
] if
] map ;
: merge-allocations ( in-values out-values -- )
[ [ sift ] map ] dip
[ [ merge-values ] 2each ]
[ [ (merge-allocations) ] dip record-allocations ]
2bi ;

View File

@ -30,6 +30,7 @@ M: node count-unboxed-allocations* drop ;
compute-copy-equiv
propagate
cleanup
compute-copy-equiv
escape-analysis
0 swap [ count-unboxed-allocations* ] each-node ;
@ -157,3 +158,32 @@ TUPLE: cons { car read-only } { cdr read-only } ;
[ car>> ] [ cdr>> ] bi
] count-unboxed-allocations
] unit-test
[ 1 ] [
[ [ 3 cons boa ] [ "A" throw ] if car>> ]
count-unboxed-allocations
] unit-test
[ 0 ] [
[ 10 [ drop ] each-integer ] count-unboxed-allocations
] unit-test
[ 2 ] [
[
1 2 cons boa 10 [ 2drop 1 2 cons boa ] each-integer car>>
] count-unboxed-allocations
] unit-test
[ 0 ] [
[
1 2 cons boa 10 [ drop 2 cons boa ] each-integer car>>
] count-unboxed-allocations
] unit-test
: infinite-cons-loop ( a -- b ) 2 cons boa infinite-cons-loop ; inline recursive
[ 0 ] [
[
1 2 cons boa infinite-cons-loop
] count-unboxed-allocations
] unit-test

View File

@ -10,12 +10,16 @@ compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.recursive
: congruent? ( alloc1 alloc2 -- ? )
2dup [ length ] bi@ = [
[ [ allocation ] bi@ congruent? ] 2all?
] [ 2drop f ] if ;
{
{ [ 2dup [ f eq? ] either? ] [ eq? ] }
{ [ 2dup [ t eq? ] either? ] [ eq? ] }
{ [ 2dup [ length ] bi@ = not ] [ 2drop f ] }
[ [ [ allocation ] bi@ congruent? ] 2all? ]
} cond ;
: check-fixed-point ( node alloc1 alloc2 -- node )
congruent? [ dup label>> f >>fixed-point drop ] unless ; inline
[ congruent? ] 2all?
[ dup label>> f >>fixed-point drop ] unless ; inline
: node-input-allocations ( node -- allocations )
in-d>> [ allocation ] map ;
@ -27,13 +31,18 @@ IN: compiler.tree.escape-analysis.recursive
[ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
: analyze-recursive-phi ( #enter-recursive -- )
[ ] [ recursive-stacks flip (merge-allocations) ] [ out-d>> ] tri
[ [ allocation ] map check-fixed-point drop ] 2keep
record-allocations ;
[ ] [ recursive-stacks flip ] [ out-d>> ] tri
[ [ merge-values ] 2each ]
[
[ (merge-allocations) ] dip
[ [ allocation ] map check-fixed-point drop ]
[ record-allocations ]
2bi
] 2bi ;
M: #recursive escape-analysis* ( #recursive -- )
[
copies [ clone ] change
! copies [ clone ] change
child>>
[ first analyze-recursive-phi ]

View File

@ -10,12 +10,21 @@ compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.simple
M: #introduce escape-analysis*
value>> unknown-allocation ;
: record-literal-allocation ( value object -- )
dup class immutable-tuple-class? [
tuple-slots rest-slice
[ <slot-value> [ swap record-literal-allocation ] keep ] map
swap record-allocation
] [
drop unknown-allocation
] if ;
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 ;
[ out-d>> first ] [ literal>> ] bi record-literal-allocation ;
: record-tuple-allocation ( #call -- )
#! Delegation.
@ -23,19 +32,27 @@ M: #push escape-analysis*
class>> immutable-tuple-class? [
[ in-d>> but-last ] [ out-d>> first ] bi
record-allocation
] [ drop ] if ;
] [ out-d>> unknown-allocations ] if ;
: record-slot-call ( #call -- )
[ out-d>> first ]
[ dup in-d>> second node-value-info literal>> ]
[ in-d>> first ] tri
over fixnum? [ [ 3 - ] dip record-slot-access ] [ 3drop ] if ;
over fixnum? [
[ 3 - ] dip record-slot-access
] [
2drop unknown-allocation
] if ;
M: #call escape-analysis*
dup word>> {
{ \ <tuple-boa> [ record-tuple-allocation ] }
{ \ slot [ record-slot-call ] }
[ drop in-d>> add-escaping-values ]
[
drop
[ in-d>> add-escaping-values ]
[ out-d>> unknown-allocations ] bi
]
} case ;
M: #return escape-analysis*

View File

@ -59,7 +59,7 @@ SYMBOL: infer-children-data
: compute-phi-input-infos ( phi-in -- phi-info )
infer-children-data get
'[ , [ [ value-info ] bind ] 2map ] map ;
'[ , [ [ [ value-info ] [ null-info ] if* ] bind ] 2map ] map ;
: annotate-phi-inputs ( #phi -- )
dup phi-in-d>> compute-phi-input-infos >>phi-info-d