compiler.tree.escape-analysis: fix bug that comes up when inheritance is used

diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
index 6c50347c3a82114d7ae61e227c6b57398fa57b4c..ca2f5ed19741ae10e08df6e9b105404a0980bfa9 100644 (file)
--- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
+++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
@@ -329,3 +329,18 @@ TUPLE: empty-tuple ;
     [ { vector } declare length>> ]
     count-unboxed-allocations
 ] unit-test
+
+! Bug found while tweaking benchmark.raytracer-simd
+
+TUPLE: point-2d { x read-only } { y read-only } ;
+TUPLE: point-3d < point-2d { z read-only } ;
+
+[ 0 ] [
+    [ { point-2d } declare dup point-3d? [ z>> ] [ x>> ] if ]
+    count-unboxed-allocations
+] unit-test
+
+[ 0 ] [
+    [ point-2d boa dup point-3d? [ z>> ] [ x>> ] if ]
+    count-unboxed-allocations
+] unit-test

diff --git a/basis/compiler/tree/escape-analysis/simple/simple.factor b/basis/compiler/tree/escape-analysis/simple/simple.factor
index 5be206f2f8211f8557bdc5f5cf481775665a28a8..9634bdf2594431058ce5245a3c185813f45a8e28 100644 (file)
--- a/basis/compiler/tree/escape-analysis/simple/simple.factor
+++ b/basis/compiler/tree/escape-analysis/simple/simple.factor
@@ -61,22 +61,28 @@ M: #push escape-analysis*
 
 : record-tuple-allocation ( #call -- )
     dup immutable-tuple-boa?
-    [ [ in-d>> but-last ] [ out-d>> first ] bi record-allocation ]
+    [ [ in-d>> but-last { } like ] [ out-d>> first ] bi record-allocation ]
     [ record-unknown-allocation ]
     if ;
 
 : slot-offset ( #call -- n/f )
-    dup in-d>>
-    [ second node-value-info literal>> ]
-    [ first node-value-info class>> ] 2bi
-    2dup [ fixnum? ] [ tuple class<= ] bi* and [
-        over 2 >= [ drop 2 - ] [ 2drop f ] if
+    dup in-d>> second node-value-info literal>> dup [ 2 - ] when ;
+
+: valid-slot-offset? ( slot# in -- ? )
+    over [
+        allocation dup [
+            dup array? [ bounds-check? ] [ 2drop f ] if
+        ] [ 2drop t ] if
     ] [ 2drop f ] if ;
 
+: unknown-slot-call ( out slot# in -- )
+    [ unknown-allocation ] [ drop ] [ add-escaping-value ] tri* ;
+
 : record-slot-call ( #call -- )
-    [ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri over
+    [ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri
+    2dup valid-slot-offset?
     [ [ record-slot-access ] [ copy-slot-value ] 3bi ]
-    [ [ unknown-allocation ] [ drop ] [ add-escaping-value ] tri* ]
+    [ unknown-slot-call ]
     if ;
 
 M: #call escape-analysis*