Revert "compiler.cfg.coalescing: some cleanups"

This reverts commit e5834c4ba7.

basis/compiler/cfg/coalescing/coalescing.factor

@@ -1,17 +1,17 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs fry kernel locals math math.order
-sequences namespaces sets make
+sequences namespaces sets
 compiler.cfg.rpo
 compiler.cfg.def-use
 compiler.cfg.utilities
 compiler.cfg.dominance
 compiler.cfg.instructions
 compiler.cfg.liveness.ssa
-compiler.cfg.parallel-copy
 compiler.cfg.critical-edges
 compiler.cfg.coalescing.state
 compiler.cfg.coalescing.forest
+compiler.cfg.coalescing.copies
 compiler.cfg.coalescing.renaming
 compiler.cfg.coalescing.live-ranges
 compiler.cfg.coalescing.process-blocks ;
@@ -29,7 +29,7 @@ SYMBOL: seen
 
 :: visit-renaming ( dst assoc src bb -- )
     src seen get key? [
-        dst src bb waiting-for set-at
+        src dst bb waiting-for push-at
         src assoc delete-at
     ] [ src seen get conjoin ] if ;
 
@@ -41,15 +41,6 @@ SYMBOL: seen
         ] assoc-each
     ] assoc-each ;
 
-: insert-copies ( -- )
-    waiting get [
-        [ instructions>> building ] dip '[
-            building get pop
-            _ parallel-copy
-            ,
-        ] with-variable
-    ] assoc-each ;
-
 : remove-phis-from-block ( bb -- )
     instructions>> [ ##phi? not ] filter-here ;
 

basis/compiler/cfg/coalescing/copies/copies.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs hashtables fry kernel make namespaces
+sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ;
+IN: compiler.cfg.coalescing.copies
+
+: compute-copies ( assoc -- assoc' )
+    dup assoc-size <hashtable> [
+        '[
+            [ 2dup eq? [ 2drop ] [ _ 2dup key? [ "OOPS" throw ] [ set-at ] if ] if ] with each
+        ] assoc-each
+    ] keep ;
+
+: insert-copies ( -- )
+    waiting get [
+        [ instructions>> building ] dip '[
+            building get pop
+            _ compute-copies parallel-copy
+            ,
+        ] with-variable
+    ] assoc-each ;

basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor

@@ -47,7 +47,7 @@ SYMBOLS: phi-union unioned-blocks ;
     2nip processed-name ;
 
 :: trivial-interference ( bb src dst -- )
-    src dst bb waiting-for set-at
+    dst src bb waiting-for push-at
     src used-by-another get push ;
 
 :: add-to-renaming-set ( bb src dst -- )
@@ -118,21 +118,20 @@ SYMBOLS: visited work-list ;
     <dlist> [ push-all-front ] keep
     [ work-list set ] [ process-df-nodes ] bi ;
 
-: add-local-interferences ( ##phi -- )
+:: add-local-interferences ( bb ##phi -- )
     ! bb contains the phi node. If the input is defined in the same
     ! block as the phi node, we have to check for interference.
     ! This can only happen if the value is carried by a back edge.
-    
-    ! XXX: in the LLVM version they only add an interference if
-    ! the operand is defined in the same block as the ##phi, but
-    ! this doesn't work here. Investigate
-    [ phi-union get ] dip dst>> '[ drop _ 2array , ] assoc-each ;
+    phi-union get [
+        drop dup def-of bb eq?
+        [ ##phi dst>> 2array , ] [ drop ] if
+    ] assoc-each ;
 
-: compute-local-interferences ( ##phi -- pairs )
+: compute-local-interferences ( bb ##phi -- pairs )
     [
-        [ phi-union get keys compute-dom-forest process-phi-union ]
+        [ phi-union get keys compute-dom-forest process-phi-union drop ]
         [ add-local-interferences ]
-        bi
+        2bi
     ] { } make ;
 
 :: insert-copies-for-interference ( ##phi src -- )
@@ -150,14 +149,13 @@ SYMBOLS: visited work-list ;
     dst>> phi-union get swap renaming-sets get set-at
     phi-union get [ drop processed-name ] assoc-each ;
 
-: process-phi ( ##phi -- )
+:: process-phi ( bb ##phi -- )
     H{ } clone phi-union set
     H{ } clone unioned-blocks set
-    [ [ inputs>> ] [ dst>> ] bi '[ _ process-phi-operand ] assoc-each ]
-    [ dup compute-local-interferences process-local-interferences ]
-    [ add-renaming-set ]
-    tri ;
+    ##phi inputs>> ##phi dst>> '[ _ process-phi-operand ] assoc-each
+    ##phi bb ##phi compute-local-interferences process-local-interferences
+    ##phi add-renaming-set ;
 
 : process-block ( bb -- )
-    instructions>>
-    [ dup ##phi? [ process-phi t ] [ drop f ] if ] all? drop ;
+    dup instructions>>
+    [ dup ##phi? [ process-phi t ] [ 2drop f ] if ] with all? drop ;

basis/compiler/cfg/coalescing/renaming/renaming.factor

@@ -37,7 +37,7 @@ IN: compiler.cfg.coalescing.renaming
 : rename-copies ( -- )
     waiting renamings get '[
         [
-            [ [ _ ?at drop ] bi@ ] assoc-map
+            [ _ [ ?at drop ] [ '[ _ ?at drop ] map ] bi-curry bi* ] assoc-map
         ] assoc-map
     ] change ;