compiler.cfg.coalescing: some cleanups

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
+sequences namespaces sets make
 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? [
-        src dst bb waiting-for push-at
+        dst src bb waiting-for set-at
         src assoc delete-at
     ] [ src seen get conjoin ] if ;
 
@@ -41,6 +41,15 @@ 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

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