Start work on escape analysis pass
parent
da255d9647
commit
84323131d9
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: fry kernel accessors sequences sequences.deep arrays
|
USING: fry kernel accessors sequences sequences.deep arrays
|
||||||
compiler.tree ;
|
stack-checker.inlining namespaces compiler.tree ;
|
||||||
IN: compiler.tree.combinators
|
IN: compiler.tree.combinators
|
||||||
|
|
||||||
: each-node ( nodes quot: ( node -- ) -- )
|
: each-node ( nodes quot: ( node -- ) -- )
|
||||||
|
@ -50,3 +50,8 @@ IN: compiler.tree.combinators
|
||||||
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
|
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
|
||||||
|
|
||||||
: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; 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
|
||||||
|
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -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) ;
|
|
@ -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 ;
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -43,18 +43,17 @@ SYMBOL: infer-children-data
|
||||||
value-infos [ clone ] change
|
value-infos [ clone ] change
|
||||||
constraints [ clone ] change ;
|
constraints [ clone ] change ;
|
||||||
|
|
||||||
|
: no-value-info ( -- )
|
||||||
|
value-infos off
|
||||||
|
constraints off ;
|
||||||
|
|
||||||
: infer-children ( node -- )
|
: infer-children ( node -- )
|
||||||
[ live-children ] [ child-constraints ] bi [
|
[ live-children ] [ child-constraints ] bi [
|
||||||
[
|
[
|
||||||
over [
|
over
|
||||||
copy-value-info
|
[ copy-value-info assume (propagate) ]
|
||||||
assume
|
[ 2drop no-value-info ]
|
||||||
(propagate)
|
if
|
||||||
] [
|
|
||||||
2drop
|
|
||||||
value-infos off
|
|
||||||
constraints off
|
|
||||||
] if
|
|
||||||
] H{ } make-assoc
|
] H{ } make-assoc
|
||||||
] 2map infer-children-data set ;
|
] 2map infer-children-data set ;
|
||||||
|
|
||||||
|
|
|
@ -142,3 +142,8 @@ SYMBOL: history
|
||||||
|
|
||||||
: inline-method-body ( #call word -- ? )
|
: inline-method-body ( #call word -- ? )
|
||||||
2dup should-inline? [ inline-word t ] [ 2drop f ] if ;
|
2dup should-inline? [ inline-word t ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
: always-inline-word? ( word -- ? )
|
||||||
|
{ curry compose } memq? ;
|
||||||
|
|
||||||
|
: always-inline-word ( #call word -- ? ) inline-word t ;
|
||||||
|
|
|
@ -325,7 +325,7 @@ cell-bits 32 = [
|
||||||
[ V{ t } ] [ [ [ 1 f <array> ] [ 2 f <array> ] if length 3 < ] final-literals ] unit-test
|
[ V{ t } ] [ [ [ 1 f <array> ] [ 2 f <array> ] if length 3 < ] final-literals ] unit-test
|
||||||
|
|
||||||
[ V{ 10 } ] [
|
[ V{ 10 } ] [
|
||||||
[ { fixnum } declare dup 10 = [ "A" throw ] unless ] final-literals
|
[ { fixnum } declare dup 10 eq? [ "A" throw ] unless ] final-literals
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Slot propagation
|
! Slot propagation
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences accessors arrays fry math.intervals
|
USING: kernel sequences accessors arrays fry math.intervals
|
||||||
combinators
|
combinators namespaces
|
||||||
stack-checker.inlining
|
stack-checker.inlining
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.copy-equiv
|
compiler.tree.copy-equiv
|
||||||
|
compiler.tree.combinators
|
||||||
compiler.tree.propagation.info
|
compiler.tree.propagation.info
|
||||||
compiler.tree.propagation.nodes
|
compiler.tree.propagation.nodes
|
||||||
compiler.tree.propagation.simple
|
compiler.tree.propagation.simple
|
||||||
|
@ -48,28 +49,20 @@ IN: compiler.tree.propagation.recursive
|
||||||
[ node-output-infos check-fixed-point drop ] 2keep
|
[ node-output-infos check-fixed-point drop ] 2keep
|
||||||
out-d>> set-value-infos ;
|
out-d>> set-value-infos ;
|
||||||
|
|
||||||
USING: namespaces math ;
|
|
||||||
SYMBOL: iter-counter
|
|
||||||
0 iter-counter set-global
|
|
||||||
M: #recursive propagate-around ( #recursive -- )
|
M: #recursive propagate-around ( #recursive -- )
|
||||||
iter-counter inc
|
[
|
||||||
iter-counter get 10 > [ "Oops" throw ] when
|
copies [ clone ] change
|
||||||
dup label>> t >>fixed-point drop [
|
constraints [ clone ] change
|
||||||
[
|
|
||||||
copies [ clone ] change
|
|
||||||
constraints [ clone ] change
|
|
||||||
|
|
||||||
child>>
|
child>>
|
||||||
[ first propagate-recursive-phi ]
|
[ first propagate-recursive-phi ]
|
||||||
[ (propagate) ]
|
[ (propagate) ]
|
||||||
bi
|
bi
|
||||||
] with-scope
|
] until-fixed-point ;
|
||||||
] [ dup label>> fixed-point>> [ drop ] [ propagate-around ] if ] bi ;
|
|
||||||
|
|
||||||
: generalize-return-interval ( info -- info' )
|
: generalize-return-interval ( info -- info' )
|
||||||
dup [ literal?>> ] [ class>> null-class? ] bi or [
|
dup [ literal?>> ] [ class>> null-class? ] bi or
|
||||||
clone [-inf,inf] >>interval
|
[ clone [-inf,inf] >>interval ] unless ;
|
||||||
] unless ;
|
|
||||||
|
|
||||||
: generalize-return ( infos -- infos' )
|
: generalize-return ( infos -- infos' )
|
||||||
[ generalize-return-interval ] map ;
|
[ generalize-return-interval ] map ;
|
||||||
|
|
|
@ -94,6 +94,7 @@ M: #declare propagate-before
|
||||||
|
|
||||||
: do-inlining ( #call word -- ? )
|
: do-inlining ( #call word -- ? )
|
||||||
{
|
{
|
||||||
|
{ [ dup always-inline-word? ] [ always-inline-word ] }
|
||||||
{ [ dup standard-generic? ] [ inline-standard-method ] }
|
{ [ dup standard-generic? ] [ inline-standard-method ] }
|
||||||
{ [ dup math-generic? ] [ inline-math-method ] }
|
{ [ dup math-generic? ] [ inline-math-method ] }
|
||||||
{ [ dup math-partial? ] [ inline-math-partial ] }
|
{ [ dup math-partial? ] [ inline-math-partial ] }
|
||||||
|
|
|
@ -29,7 +29,7 @@ UNION: fixed-length-sequence array byte-array string ;
|
||||||
bi* value-info-intersect 1array ;
|
bi* value-info-intersect 1array ;
|
||||||
|
|
||||||
: tuple-constructor? ( word -- ? )
|
: tuple-constructor? ( word -- ? )
|
||||||
{ <tuple-boa> curry compose <complex> } memq? ;
|
{ <tuple-boa> <complex> } memq? ;
|
||||||
|
|
||||||
: read-only-slots ( values class -- slots )
|
: read-only-slots ( values class -- slots )
|
||||||
#! Delegation.
|
#! Delegation.
|
||||||
|
@ -54,20 +54,12 @@ UNION: fixed-length-sequence array byte-array string ;
|
||||||
in-d>> unclip-last
|
in-d>> unclip-last
|
||||||
value-info literal>> class>> (propagate-tuple-constructor) ;
|
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 )
|
: propagate-<complex> ( #call -- info )
|
||||||
in-d>> [ value-info ] map complex <tuple-info> ;
|
in-d>> [ value-info ] map complex <tuple-info> ;
|
||||||
|
|
||||||
: propagate-tuple-constructor ( #call word -- infos )
|
: propagate-tuple-constructor ( #call word -- infos )
|
||||||
{
|
{
|
||||||
{ \ <tuple-boa> [ propagate-<tuple-boa> ] }
|
{ \ <tuple-boa> [ propagate-<tuple-boa> ] }
|
||||||
{ \ curry [ propagate-curry ] }
|
|
||||||
{ \ compose [ propagate-compose ] }
|
|
||||||
{ \ <complex> [ propagate-<complex> ] }
|
{ \ <complex> [ propagate-<complex> ] }
|
||||||
} case 1array ;
|
} case 1array ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue