From d14efabed37ce9c9727924fbf8be34aa72db18db Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 2 Aug 2008 20:21:25 -0500 Subject: [PATCH] Working on escape analysis --- .../allocations/allocations.factor | 26 +++- .../escape-analysis/branches/branches.factor | 10 +- .../escape-analysis-tests.factor | 130 ++++++++++++++++++ .../escape-analysis/escape-analysis.factor | 1 + .../tree/escape-analysis/simple/simple.factor | 3 + 5 files changed, 164 insertions(+), 6 deletions(-) create mode 100644 unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor diff --git a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor index 7600a3b5a2..59febb3801 100644 --- a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs namespaces sequences kernel math +USING: assocs namespaces sequences kernel math combinators sets stack-checker.state compiler.tree.copy-equiv ; IN: compiler.tree.escape-analysis.allocations @@ -13,7 +13,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 ; @@ -25,4 +29,20 @@ SYMBOL: allocations SYMBOL: slot-merging : merge-slots ( values -- value ) - [ introduce-value ] [ slot-merging get set-at ] [ ] tri ; + dup [ ] contains? [ + + [ introduce-value ] + [ slot-merging get set-at ] + [ ] tri + ] [ drop f ] if ; + +! If an allocation's slot appears in this set, the allocation +! is disqualified from unboxing. +SYMBOL: disqualified + +: disqualify ( slot-value -- ) + [ disqualified get conjoin ] + [ slot-merging get at [ disqualify ] each ] bi ; + +: escaping-allocation? ( value -- ? ) + allocation [ [ disqualified get key? ] contains? ] [ t ] if* ; diff --git a/unfinished/compiler/tree/escape-analysis/branches/branches.factor b/unfinished/compiler/tree/escape-analysis/branches/branches.factor index 23e53fd4fe..1bd6973369 100644 --- a/unfinished/compiler/tree/escape-analysis/branches/branches.factor +++ b/unfinished/compiler/tree/escape-analysis/branches/branches.factor @@ -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 -- ) diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor new file mode 100644 index 0000000000..34ecc74813 --- /dev/null +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -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 ; + +\ escape-analysis must-infer + +: count-unboxed-allocations ( quot -- sizes ) + build-tree + normalize + compute-copy-equiv + propagate + cleanup + escape-analysis + 0 swap [ + dup #call? + [ + out-d>> dup empty? [ drop ] [ + first escaping-allocation? [ 1+ ] unless + ] 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 diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor index 490fff82ec..e8c02046f2 100644 --- a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor @@ -14,5 +14,6 @@ IN: compiler.tree.escape-analysis : escape-analysis ( node -- node ) H{ } clone slot-merging set H{ } clone allocations set + H{ } clone disqualified set work-list set dup (escape-analysis) ; diff --git a/unfinished/compiler/tree/escape-analysis/simple/simple.factor b/unfinished/compiler/tree/escape-analysis/simple/simple.factor index cc6ac57a5e..93d0b28be3 100644 --- a/unfinished/compiler/tree/escape-analysis/simple/simple.factor +++ b/unfinished/compiler/tree/escape-analysis/simple/simple.factor @@ -24,6 +24,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>> { { \ [ record-tuple-allocation ] }