Fix escape analysis bug; speedup on fib4 benchmark

diff --git a/basis/compiler/tree/escape-analysis/allocations/allocations.factor b/basis/compiler/tree/escape-analysis/allocations/allocations.factor
index 100ced5acd6c3ead610c4883fb81f3adcb0809cc..4c197d7fc03d6613763baaf191749ac852003fce 100644 (file)
--- a/basis/compiler/tree/escape-analysis/allocations/allocations.factor
+++ b/basis/compiler/tree/escape-analysis/allocations/allocations.factor
@@ -103,6 +103,9 @@ DEFER: copy-value
     [ [ allocation copy-allocation ] dip record-allocation ]
     2bi ;
 
+: copy-values ( from to -- )
+    [ copy-value ] 2each ;
+
 : copy-slot-value ( out slot# in -- )
     allocation {
         { [ dup not ] [ 3drop ] }

diff --git a/basis/compiler/tree/escape-analysis/recursive/recursive.factor b/basis/compiler/tree/escape-analysis/recursive/recursive.factor
index 3d8d15e5ec5b8663681634de6e7f41c1708a47b1..059ac1de02ba74fd037f64569e1bb59aa7ecc667 100644 (file)
--- a/basis/compiler/tree/escape-analysis/recursive/recursive.factor
+++ b/basis/compiler/tree/escape-analysis/recursive/recursive.factor
@@ -42,24 +42,26 @@ IN: compiler.tree.escape-analysis.recursive
     ] 2bi ;
 
 M: #recursive escape-analysis* ( #recursive -- )
+    [ label>> return>> in-d>> introduce-values ]
     [
-        child>>
-        [ first out-d>> introduce-values ]
-        [ first analyze-recursive-phi ]
-        [ (escape-analysis) ]
-        tri
-    ] until-fixed-point ;
+        [
+            child>>
+            [ first out-d>> introduce-values ]
+            [ first analyze-recursive-phi ]
+            [ (escape-analysis) ]
+            tri
+        ] until-fixed-point
+    ] bi ;
 
 M: #enter-recursive escape-analysis* ( #enter-recursive -- )
     #! Handled by #recursive
     drop ;
 
-: return-allocations ( node -- allocations )
-    label>> return>> node-input-allocations ;
-
 M: #call-recursive escape-analysis* ( #call-label -- )
-    [ ] [ return-allocations ] [ node-output-allocations ] tri
-    [ check-fixed-point ] [ drop swap out-d>> record-allocations ] 3bi ;
+    [ ] [ label>> return>> ] [ node-output-allocations ] tri
+    [ [ node-input-allocations ] dip check-fixed-point ]
+    [ drop swap [ in-d>> ] [ out-d>> ] bi* copy-values ]
+    3bi ;
 
 M: #return-recursive escape-analysis* ( #return-recursive -- )
     [ call-next-method ]

diff --git a/basis/compiler/tree/escape-analysis/simple/simple.factor b/basis/compiler/tree/escape-analysis/simple/simple.factor
index 58d721b602bc061218ecbe7cd295a1a431fbd7d3..d69f6cab9e9016a445531834cbea70965001e1c1 100644 (file)
--- a/basis/compiler/tree/escape-analysis/simple/simple.factor
+++ b/basis/compiler/tree/escape-analysis/simple/simple.factor
@@ -13,7 +13,7 @@ IN: compiler.tree.escape-analysis.simple
 
 M: #terminate escape-analysis* drop ;
 
-M: #renaming escape-analysis* inputs/outputs [ copy-value ] 2each ;
+M: #renaming escape-analysis* inputs/outputs copy-values ;
 
 M: #introduce escape-analysis* out-d>> unknown-allocations ;
 

diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor
index 98ec4ee3f0fb22c00fff585e23de5f5daf2a3efe..12c7a60ec8ae01274bb1e8abea410b76432b1ddf 100644 (file)
--- a/basis/compiler/tree/normalization/normalization.factor
+++ b/basis/compiler/tree/normalization/normalization.factor
@@ -204,5 +204,6 @@ M: node normalize* ;
     H{ } clone rename-map set
     dup [ collect-label-info ] each-node
     dup count-introductions make-values
-    [ (normalize) ] [ nip #introduce ] 2bi prefix
+    [ (normalize) ] [ nip ] 2bi
+    dup empty? [ drop ] [ #introduce prefix ] if
     rename-node-values ;

diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
index 8135572bb1daaa503feac36f0fd1105a5a9821ec..334fcb11f0ce3825f9a14df32bd6c74989d27c73 100644 (file)
--- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
+++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
@@ -46,3 +46,10 @@ TUPLE: empty-tuple ;
     [ bleach-node ] curry [ ] compose impeach-node ; inline recursive
 
 [ ] [ [ [ ] bleach-node ] test-unboxing ] unit-test
+
+TUPLE: box { i read-only } ;
+
+: box-test ( m -- n )
+    dup box-test i>> swap box-test drop box boa ; inline recursive
+
+[ ] [ [ T{ box f 34 } box-test i>> ] test-unboxing ] unit-test

diff --git a/extra/benchmark/fib4/fib4.factor b/extra/benchmark/fib4/fib4.factor
index 580be0d0ecfffb3706e9480ba06164c060e2fd7b..c988e5722e6c693762f0e3bf648bf13c12fb5215 100644 (file)
--- a/extra/benchmark/fib4/fib4.factor
+++ b/extra/benchmark/fib4/fib4.factor
@@ -1,7 +1,7 @@
 USING: accessors math kernel debugger ;
 IN: benchmark.fib4
 
-TUPLE: box i ;
+TUPLE: box { i read-only } ;
 
 C: <box> box
 
@@ -15,8 +15,8 @@ C: <box> box
         i>> 1- <box>
         tuple-fib
         swap i>> swap i>> + <box>
-    ] if ;
+    ] if ; inline recursive
 
-: fib-main ( -- ) T{ box f 34 } tuple-fib T{ box f 9227465 } assert= ;
+: fib-main ( -- ) T{ box f 34 } tuple-fib i>> 9227465 assert= ;
 
 MAIN: fib-main