compiler.cfg.ssa.interference: cleanup

diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index 653ab0ce28f87c927c1dbea157b2987cdbe07092..c76891407055318f2a44ea3cbe417f3bc29f2ce9 100644 (file)
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -35,12 +35,7 @@ SYMBOL: copies
 
 : classes-interfere? ( vreg1 vreg2 -- ? )
     [ leader ] bi@ 2dup eq? [ 2drop f ] [
-        [ class-elements flatten ] bi@
-        '[
-            _ [
-                interferes?
-            ] with any?
-        ] any?
+        [ class-elements flatten ] bi@ sets-interfere?
     ] if ;
 
 : update-leaders ( vreg1 vreg2 -- )

diff --git a/basis/compiler/cfg/ssa/interference/interference-tests.factor b/basis/compiler/cfg/ssa/interference/interference-tests.factor
index 6d296b885ec786bd042bfc2ce5940c2246cd8377..f8876755d92d318975453f86711320dc6e6ac6fd 100644 (file)
--- a/basis/compiler/cfg/ssa/interference/interference-tests.factor
+++ b/basis/compiler/cfg/ssa/interference/interference-tests.factor
@@ -36,17 +36,17 @@ V{
 
 [ ] [ test-interference ] unit-test
 
-[ f ] [ V int-regs 0 V int-regs 1 interferes? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 0 interferes? ] unit-test
-[ f ] [ V int-regs 2 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 2 interferes? ] unit-test
-[ t ] [ V int-regs 0 V int-regs 2 interferes? ] unit-test
-[ t ] [ V int-regs 2 V int-regs 0 interferes? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 1 interferes? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 4 interferes? ] unit-test
-[ t ] [ V int-regs 4 V int-regs 3 interferes? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 5 interferes? ] unit-test
-[ t ] [ V int-regs 5 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 6 interferes? ] unit-test
-[ f ] [ V int-regs 6 V int-regs 3 interferes? ] unit-test
\ No newline at end of file
+[ f ] [ V int-regs 0 V int-regs 1 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 0 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 2 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 2 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 0 V int-regs 2 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 2 V int-regs 0 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 1 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 4 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 4 V int-regs 3 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 5 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 5 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 6 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 6 V int-regs 3 vregs-interfere? ] unit-test
\ No newline at end of file

diff --git a/basis/compiler/cfg/ssa/interference/interference.factor b/basis/compiler/cfg/ssa/interference/interference.factor
index 1bf388750fb512e3ae087dc415cb1a9fcedf2fcd..f8553ec9de27eac9b5e7cd66fdbd8cb0569adb16 100644 (file)
--- a/basis/compiler/cfg/ssa/interference/interference.factor
+++ b/basis/compiler/cfg/ssa/interference/interference.factor
@@ -39,7 +39,7 @@ IN: compiler.cfg.ssa.interference
 
 PRIVATE>
 
-: interferes? ( vreg1 vreg2 -- ? )
+: vregs-interfere? ( vreg1 vreg2 -- ? )
     2dup [ def-of ] bi@ {
         { [ 2dup eq? ] [ interferes-same-block? ] }
         { [ 2dup dominates? ] [ interferes-first-dominates? ] }
@@ -48,11 +48,12 @@ PRIVATE>
     } cond ;
 
 ! Debug this stuff later
+<PRIVATE
 
 : quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ;
 
 : quadratic-test ( seq1 seq2 -- ? )
-    '[ _ [ interferes? ] with any? ] any? ;
+    '[ _ [ vregs-interfere? ] with any? ] any? ;
 
 : sort-vregs-by-bb ( vregs -- alist )
     defs get
@@ -64,15 +65,22 @@ PRIVATE>
 : find-parent ( dom current -- parent )
     over empty? [ 2drop f ] [
         over last over dominates? [ drop last ] [
-            [ pop* ] dip find-parent
+            over pop* find-parent
         ] if
     ] if ;
 
 :: linear-test ( seq1 seq2 -- ? )
+    ! Instead of sorting, SSA destruction should keep equivalence
+    ! classes sorted by merging them on append
     V{ } clone :> dom
     seq1 seq2 append sort-vregs-by-bb [| pair |
         pair first :> current
         dom current find-parent
-        dup [ current interferes? ] when
+        dup [ current vregs-interfere? ] when
         [ t ] [ current dom push f ] if
     ] any? ;
+
+PRIVATE>
+
+: sets-interfere? ( seq1 seq2 -- ? )
+    quadratic-test ;
\ No newline at end of file