Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
b7a1275db2
|
|
@ -8,11 +8,9 @@ IN: compiler.tree.dataflow-analysis
|
|||
! Dataflow analysis
|
||||
SYMBOL: work-list
|
||||
|
||||
: look-at-value ( values -- )
|
||||
work-list get push-front ;
|
||||
: look-at-value ( values -- ) work-list get push-front ;
|
||||
|
||||
: look-at-values ( values -- )
|
||||
work-list get '[ , push-front ] each ;
|
||||
: look-at-values ( values -- ) work-list get push-all-front ;
|
||||
|
||||
: look-at-inputs ( node -- ) in-d>> look-at-values ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! 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 ;
|
||||
USING: assocs namespaces sequences kernel math combinators sets
|
||||
fry stack-checker.state compiler.tree.copy-equiv
|
||||
compiler.tree.escape-analysis.graph ;
|
||||
IN: compiler.tree.escape-analysis.allocations
|
||||
|
||||
SYMBOL: escaping
|
||||
|
|
@ -13,7 +14,11 @@ SYMBOL: allocations
|
|||
resolve-copy allocations get at ;
|
||||
|
||||
: record-allocation ( allocation value -- )
|
||||
allocations get set-at ;
|
||||
{
|
||||
{ [ dup not ] [ 2drop ] }
|
||||
{ [ over not ] [ allocations get delete-at drop ] }
|
||||
[ allocations get set-at ]
|
||||
} cond ;
|
||||
|
||||
: record-allocations ( allocations values -- )
|
||||
[ record-allocation ] 2each ;
|
||||
|
|
@ -21,8 +26,33 @@ SYMBOL: allocations
|
|||
: 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
|
||||
! We track available values
|
||||
SYMBOL: slot-graph
|
||||
|
||||
: merge-slots ( values -- value )
|
||||
<value> [ introduce-value ] [ slot-merging get set-at ] [ ] tri ;
|
||||
dup [ ] contains? [
|
||||
<value>
|
||||
[ introduce-value ]
|
||||
[ slot-graph get add-edges ]
|
||||
[ ] tri
|
||||
] [ 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.
|
||||
|
||||
: disqualify ( slot-value -- )
|
||||
slot-graph get mark-vertex ;
|
||||
|
||||
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
|
||||
escaping-allocations set ;
|
||||
|
||||
: escaping-allocation? ( value -- ? )
|
||||
escaping-allocations get key? ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel namespaces sequences
|
||||
USING: accessors kernel namespaces sequences sets
|
||||
stack-checker.branches
|
||||
compiler.tree
|
||||
compiler.tree.propagation.branches
|
||||
compiler.tree.escape-analysis.nodes
|
||||
|
|
@ -12,6 +13,9 @@ 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? [
|
||||
|
|
@ -19,8 +23,8 @@ M: #branch escape-analysis*
|
|||
flip
|
||||
[ (merge-allocations) ] [ [ merge-slots ] map ] bi
|
||||
[ record-allocations ] keep
|
||||
] [ drop f ] if
|
||||
] [ drop f ] if
|
||||
] [ disqualify-allocations f ] if
|
||||
] [ disqualify-allocations f ] if
|
||||
] map ;
|
||||
|
||||
: merge-allocations ( in-values out-values -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1,130 @@
|
|||
IN: compiler.tree.escape-analysis.tests
|
||||
USING: compiler.tree.escape-analysis
|
||||
compiler.tree.escape-analysis.allocations compiler.tree.builder
|
||||
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 ;
|
||||
|
||||
\ escape-analysis must-infer
|
||||
|
||||
: count-unboxed-allocations ( quot -- sizes )
|
||||
build-tree
|
||||
normalize
|
||||
compute-copy-equiv
|
||||
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 ] [ [ [ + ] curry ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry drop ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry 3 slot ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry 3 slot drop ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry uncurry ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 0 ] [ [ [ [ + ] curry ] [ drop [ ] ] if ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[ [ [ + ] curry ] [ [ * ] curry ] if uncurry ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[ [ [ + ] curry ] [ [ * ] curry ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if uncurry ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[ [ [ + ] curry 4 ] [ dup [ [ * ] curry ] [ [ / ] curry ] if uncurry ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if ] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
TUPLE: cons { car read-only } { cdr read-only } ;
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] when
|
||||
] if car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] if car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] unless car>>
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa
|
||||
] [
|
||||
4 cons boa
|
||||
] if car>>
|
||||
] if
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
[
|
||||
dup 0 = [
|
||||
2 cons boa
|
||||
] [
|
||||
dup 1 = [
|
||||
3 cons boa dup .
|
||||
] [
|
||||
4 cons boa
|
||||
] if
|
||||
] if drop
|
||||
] count-unboxed-allocations
|
||||
] unit-test
|
||||
|
|
@ -3,16 +3,16 @@
|
|||
USING: kernel namespaces search-dequeues
|
||||
compiler.tree
|
||||
compiler.tree.def-use
|
||||
compiler.tree.escape-analysis.graph
|
||||
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 ;
|
||||
compiler.tree.escape-analysis.simple ;
|
||||
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) ;
|
||||
<graph> slot-graph set
|
||||
dup (escape-analysis)
|
||||
compute-escaping-allocations ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! 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 ;
|
||||
|
|
@ -6,7 +6,6 @@ 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
|
||||
|
||||
|
|
@ -24,6 +23,9 @@ 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 ] }
|
||||
|
|
|
|||
|
|
@ -1,9 +0,0 @@
|
|||
! 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 ;
|
||||
Loading…
Reference in New Issue