Start work on escape analysis pass

db4
Slava Pestov 2008-08-01 23:31:43 -05:00
parent da255d9647
commit 84323131d9
15 changed files with 238 additions and 39 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry kernel accessors sequences sequences.deep arrays
compiler.tree ;
stack-checker.inlining namespaces compiler.tree ;
IN: compiler.tree.combinators
: each-node ( nodes quot: ( node -- ) -- )
@ -50,3 +50,8 @@ IN: compiler.tree.combinators
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline
: until-fixed-point ( #recursive quot -- )
over label>> t >>fixed-point drop
[ with-scope ] 2keep
over label>> fixed-point>> [ 2drop ] [ until-fixed-point ] if ; inline

View File

@ -0,0 +1,28 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs namespaces sequences kernel math
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'
SYMBOL: allocations
: allocation ( value -- allocation )
resolve-copy allocations get at ;
: record-allocation ( allocation value -- )
allocations get set-at ;
: record-allocations ( allocations values -- )
[ record-allocation ] 2each ;
: record-slot-access ( out slot# in -- )
over zero? [ 3drop ] [ allocation ?nth swap is-copy-of ] if ;
! A map from values to sequences of values
SYMBOL: slot-merging
: merge-slots ( values -- value )
<value> [ introduce-value ] [ slot-merging get set-at ] [ ] tri ;

View File

@ -0,0 +1,32 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces sequences
compiler.tree
compiler.tree.propagation.branches
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.branches
SYMBOL: children-escape-data
M: #branch escape-analysis*
live-children sift [ (escape-analysis) ] each ;
: (merge-allocations) ( values -- allocation )
[
[ allocation ] map dup [ ] all? [
dup [ length ] map all-equal? [
flip
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
[ record-allocations ] keep
] [ drop f ] if
] [ drop f ] if
] map ;
: merge-allocations ( in-values out-values -- )
[ (merge-allocations) ] dip record-allocations ;
M: #phi escape-analysis*
[ [ phi-in-d>> ] [ out-d>> ] bi merge-allocations ]
[ [ phi-in-r>> ] [ out-r>> ] bi merge-allocations ]
bi ;

View File

@ -0,0 +1,18 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces search-dequeues
compiler.tree
compiler.tree.def-use
compiler.tree.escape-analysis.allocations
compiler.tree.escape-analysis.recursive
compiler.tree.escape-analysis.branches
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.simple
compiler.tree.escape-analysis.work-list ;
IN: compiler.tree.escape-analysis
: escape-analysis ( node -- node )
H{ } clone slot-merging set
H{ } clone allocations set
<hashed-dlist> work-list set
dup (escape-analysis) ;

View File

@ -0,0 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences compiler.tree ;
IN: compiler.tree.escape-analysis.nodes
GENERIC: escape-analysis* ( node -- )
M: node escape-analysis* drop ;
: (escape-analysis) ( node -- ) [ escape-analysis* ] each ;

View File

@ -0,0 +1,16 @@
IN: compiler.tree.escape-analysis.recursive.tests
USING: kernel tools.test namespaces sequences
compiler.tree.copy-equiv
compiler.tree.escape-analysis.recursive
compiler.tree.escape-analysis.allocations ;
H{ } clone allocations set
H{ } clone copies set
[ ] [ 8 [ introduce-value ] each ] unit-test
[ ] [ { 1 2 } 3 record-allocation ] unit-test
[ t ] [ { 1 2 } { 6 7 } congruent? ] unit-test
[ f ] [ { 3 4 } { 6 7 } congruent? ] unit-test
[ f ] [ { 3 4 5 } { 6 7 } congruent? ] unit-test

View File

@ -0,0 +1,56 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences math combinators accessors namespaces
compiler.tree
compiler.tree.copy-equiv
compiler.tree.combinators
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.branches
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.recursive
: congruent? ( alloc1 alloc2 -- ? )
2dup [ length ] bi@ = [
[ [ allocation ] bi@ congruent? ] 2all?
] [ 2drop f ] if ;
: check-fixed-point ( node alloc1 alloc2 -- node )
congruent? [ dup label>> f >>fixed-point drop ] unless ; inline
: node-input-allocations ( node -- allocations )
in-d>> [ allocation ] map ;
: node-output-allocations ( node -- allocations )
out-d>> [ allocation ] map ;
: recursive-stacks ( #enter-recursive -- stacks )
[ 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 ;
M: #recursive escape-analysis* ( #recursive -- )
[
copies [ clone ] change
child>>
[ first analyze-recursive-phi ]
[ (escape-analysis) ]
bi
] until-fixed-point ;
M: #call-recursive escape-analysis* ( #call-label -- )
dup
[ node-output-allocations ]
[ label>> return>> node-input-allocations ] bi
[ check-fixed-point ] keep
swap out-d>> record-allocations ;
! M: #return-recursive escape-analysis* ( #return-recursive -- )
! dup dup label>> calls>> dup empty? [ 3drop ] [
! [ node-input-allocations ]
! [ first node-output-allocations ] bi*
! check-fixed-point drop
! ] if ;

View File

@ -0,0 +1,35 @@
! Copyright (C) 2008 Slava Pestov.
! 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
compiler.tree
compiler.tree.propagation.info
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.work-list
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.simple
: record-tuple-allocation ( #call -- )
#! Delegation.
dup dup in-d>> peek node-value-info literal>>
class>> all-slots rest-slice [ read-only>> ] all? [
[ in-d>> but-last ] [ out-d>> first ] bi
record-allocation
] [ drop ] 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 ;
M: #call escape-analysis*
dup word>> {
{ \ <tuple-boa> [ record-tuple-allocation ] }
{ \ slot [ record-slot-call ] }
[ drop in-d>> add-escaping-values ]
} case ;
M: #return escape-analysis*
in-d>> add-escaping-values ;

View File

@ -0,0 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: dequeues namespaces sequences fry ;
IN: compiler.tree.escape-analysis.work-list
SYMBOL: work-list
: add-escaping-values ( values -- )
work-list get '[ , push-front ] each ;

View File

@ -43,18 +43,17 @@ SYMBOL: infer-children-data
value-infos [ clone ] change
constraints [ clone ] change ;
: no-value-info ( -- )
value-infos off
constraints off ;
: infer-children ( node -- )
[ live-children ] [ child-constraints ] bi [
[
over [
copy-value-info
assume
(propagate)
] [
2drop
value-infos off
constraints off
] if
over
[ copy-value-info assume (propagate) ]
[ 2drop no-value-info ]
if
] H{ } make-assoc
] 2map infer-children-data set ;

View File

@ -142,3 +142,8 @@ SYMBOL: history
: inline-method-body ( #call word -- ? )
2dup should-inline? [ inline-word t ] [ 2drop f ] if ;
: always-inline-word? ( word -- ? )
{ curry compose } memq? ;
: always-inline-word ( #call word -- ? ) inline-word t ;

View File

@ -325,7 +325,7 @@ cell-bits 32 = [
[ V{ t } ] [ [ [ 1 f <array> ] [ 2 f <array> ] if length 3 < ] final-literals ] unit-test
[ V{ 10 } ] [
[ { fixnum } declare dup 10 = [ "A" throw ] unless ] final-literals
[ { fixnum } declare dup 10 eq? [ "A" throw ] unless ] final-literals
] unit-test
! Slot propagation

View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors arrays fry math.intervals
combinators
combinators namespaces
stack-checker.inlining
compiler.tree
compiler.tree.copy-equiv
compiler.tree.combinators
compiler.tree.propagation.info
compiler.tree.propagation.nodes
compiler.tree.propagation.simple
@ -48,28 +49,20 @@ IN: compiler.tree.propagation.recursive
[ node-output-infos check-fixed-point drop ] 2keep
out-d>> set-value-infos ;
USING: namespaces math ;
SYMBOL: iter-counter
0 iter-counter set-global
M: #recursive propagate-around ( #recursive -- )
iter-counter inc
iter-counter get 10 > [ "Oops" throw ] when
dup label>> t >>fixed-point drop [
[
copies [ clone ] change
constraints [ clone ] change
[
copies [ clone ] change
constraints [ clone ] change
child>>
[ first propagate-recursive-phi ]
[ (propagate) ]
bi
] with-scope
] [ dup label>> fixed-point>> [ drop ] [ propagate-around ] if ] bi ;
child>>
[ first propagate-recursive-phi ]
[ (propagate) ]
bi
] until-fixed-point ;
: generalize-return-interval ( info -- info' )
dup [ literal?>> ] [ class>> null-class? ] bi or [
clone [-inf,inf] >>interval
] unless ;
dup [ literal?>> ] [ class>> null-class? ] bi or
[ clone [-inf,inf] >>interval ] unless ;
: generalize-return ( infos -- infos' )
[ generalize-return-interval ] map ;

View File

@ -94,6 +94,7 @@ M: #declare propagate-before
: do-inlining ( #call word -- ? )
{
{ [ dup always-inline-word? ] [ always-inline-word ] }
{ [ dup standard-generic? ] [ inline-standard-method ] }
{ [ dup math-generic? ] [ inline-math-method ] }
{ [ dup math-partial? ] [ inline-math-partial ] }

View File

@ -29,7 +29,7 @@ UNION: fixed-length-sequence array byte-array string ;
bi* value-info-intersect 1array ;
: tuple-constructor? ( word -- ? )
{ <tuple-boa> curry compose <complex> } memq? ;
{ <tuple-boa> <complex> } memq? ;
: read-only-slots ( values class -- slots )
#! Delegation.
@ -54,20 +54,12 @@ UNION: fixed-length-sequence array byte-array string ;
in-d>> unclip-last
value-info literal>> class>> (propagate-tuple-constructor) ;
: propagate-curry ( #call -- info )
in-d>> \ curry (propagate-tuple-constructor) ;
: propagate-compose ( #call -- info )
in-d>> \ compose (propagate-tuple-constructor) ;
: propagate-<complex> ( #call -- info )
in-d>> [ value-info ] map complex <tuple-info> ;
: propagate-tuple-constructor ( #call word -- infos )
{
{ \ <tuple-boa> [ propagate-<tuple-boa> ] }
{ \ curry [ propagate-curry ] }
{ \ compose [ propagate-compose ] }
{ \ <complex> [ propagate-<complex> ] }
} case 1array ;