diff --git a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor index 09c20a93dc..19a5e5b12a 100644 --- a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor @@ -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+ + +: ( -- disjoint-set ) + +escaping+ over add-atom ; + +: init-escaping-values ( -- ) + copies get + [ '[ drop , add-atom ] assoc-each ] + [ '[ , equate ] assoc-each ] + [ nip escaping-values set ] + 2tri ; + +: ( -- 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? [ - - [ introduce-value ] - [ slot-graph get add-edges ] - [ ] tri + [ 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 -- ? ) diff --git a/unfinished/compiler/tree/escape-analysis/branches/branches.factor b/unfinished/compiler/tree/escape-analysis/branches/branches.factor index 1bd6973369..950e0341f9 100644 --- a/unfinished/compiler/tree/escape-analysis/branches/branches.factor +++ b/unfinished/compiler/tree/escape-analysis/branches/branches.factor @@ -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 ] diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor index 83cdfd980b..6f99868c23 100644 --- a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -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>> \ = + [ (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>> \ = [ - 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 diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor index c41627005b..0ba44a1dc5 100644 --- a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor @@ -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 - slot-graph set dup (escape-analysis) compute-escaping-allocations ; diff --git a/unfinished/compiler/tree/escape-analysis/graph/graph-tests.factor b/unfinished/compiler/tree/escape-analysis/graph/graph-tests.factor deleted file mode 100644 index 3a7dee58a9..0000000000 --- a/unfinished/compiler/tree/escape-analysis/graph/graph-tests.factor +++ /dev/null @@ -1,19 +0,0 @@ -IN: compiler.tree.escape-analysis.graph.tests -USING: compiler.tree.escape-analysis.graph tools.test namespaces -accessors ; - - "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 diff --git a/unfinished/compiler/tree/escape-analysis/graph/graph.factor b/unfinished/compiler/tree/escape-analysis/graph/graph.factor deleted file mode 100644 index 59ba51d99e..0000000000 --- a/unfinished/compiler/tree/escape-analysis/graph/graph.factor +++ /dev/null @@ -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 ) - H{ } clone 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 ; - -> 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 ; diff --git a/unfinished/compiler/tree/escape-analysis/simple/simple.factor b/unfinished/compiler/tree/escape-analysis/simple/simple.factor index 8329a04a61..8828b4c410 100644 --- a/unfinished/compiler/tree/escape-analysis/simple/simple.factor +++ b/unfinished/compiler/tree/escape-analysis/simple/simple.factor @@ -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- [ ] 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>> { { \ [ record-tuple-allocation ] }