compiler.cfg.parallel-copy: fix algorithm

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor b/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
index 0234c2eae768580e53b539da5847daeb5cb6d946..17b043c1b764d0f4c666bf50832e209373fdfcb0 100644 (file)
--- a/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
+++ b/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor
@@ -11,9 +11,9 @@ SYMBOL: temp
 
 [
     {
-        T{ ##copy f V int-regs 3 V int-regs 2 }
+        T{ ##copy f V int-regs 4 V int-regs 2 }
         T{ ##copy f V int-regs 2 V int-regs 1 }
-        T{ ##copy f V int-regs 1 V int-regs 3 }
+        T{ ##copy f V int-regs 1 V int-regs 4 }
     }
 ] [
     H{

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.alt.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.alt.factor
deleted file mode 100644 (file)
index 534cef3..0000000
--- a/basis/compiler/cfg/parallel-copy/parallel-copy.alt.factor
+++ /dev/null
@@ -1,57 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs compiler.cfg.hats compiler.cfg.instructions
-deques dlists fry kernel locals namespaces sequences
-hashtables ;
-IN: compiler.cfg.parallel-copy
-
-! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
-! http://hal.archives-ouvertes.fr/docs/00/34/99/25/PDF/OutSSA-RR.pdf,
-! Algorithm 1
-
-<PRIVATE
-
-SYMBOLS: temp locs preds to-do ready ;
-
-: init-to-do ( bs -- )
-    to-do get push-all-back ;
-
-: init-ready ( bs -- )
-    locs get '[ _ key? not ] filter ready get push-all-front ;
-
-: init ( mapping temp -- )
-    temp set
-    <dlist> to-do set
-    <dlist> ready set
-    [  preds set ]
-    [ [ nip dup ] H{ } assoc-map-as locs set ]
-    [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
-
-:: process-ready ( b quot -- )
-    b preds get at :> a
-    a locs get at :> c
-    b c quot call
-    b a locs get set-at
-    a c = a preds get at and [ a ready get push-front ] when ; inline
-
-:: process-to-do ( b quot -- )
-    b preds get at locs get at b = [
-        temp get b quot call
-        temp get b locs get set-at
-        b ready get push-front
-    ] unless ; inline
-
-PRIVATE>
-
-:: parallel-mapping ( mapping temp quot -- )
-    [
-        mapping temp init
-        to-do get [
-            ready get [
-                quot process-ready
-            ] slurp-deque
-            quot process-to-do
-        ] slurp-deque
-    ] with-scope ;
-
-: parallel-copy ( mapping -- ) i [ ##copy ] parallel-mapping ;
\ No newline at end of file

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
index ff309c45ad22917a011e5dce08da21473ffaa37a..550928b8ba3df4b72ad0711cc7b7943e71ae1932 100644 (file)
--- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor
+++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
@@ -2,45 +2,59 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs compiler.cfg.hats compiler.cfg.instructions
 deques dlists fry kernel locals namespaces sequences
-sets hashtables ;
+hashtables ;
 IN: compiler.cfg.parallel-copy
 
-SYMBOLS: mapping dependency-graph work-list ;
+! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
+! http://hal.archives-ouvertes.fr/docs/00/34/99/25/PDF/OutSSA-RR.pdf,
+! Algorithm 1
 
-: build-dependency-graph ( mapping -- deps )
-    H{ } clone [ '[ _ conjoin-at ] assoc-each ] keep ;
+<PRIVATE
 
-: build-work-list ( mapping graph -- work-list )
-    [ keys ] dip '[ _ key? not ] filter <dlist> [ push-all-front ] keep ;
+SYMBOLS: temp locs preds to-do ready ;
 
-: init ( mapping -- work-list )
-    dup build-dependency-graph
-    [ [ >hashtable mapping set ] [ dependency-graph set ] bi* ]
-    [ build-work-list dup work-list set ]
-    2bi ;
+: init-to-do ( bs -- )
+    to-do get push-all-back ;
 
-:: retire-copy ( dst src -- )
-    dst mapping get delete-at
-    src dependency-graph get at :> deps
-    dst deps delete-at
-    deps assoc-empty? [
-        src mapping get key? [
-            src work-list get push-front
-        ] when
-    ] when ;
+: init-ready ( bs -- )
+    locs get '[ _ key? not ] filter ready get push-all-front ;
 
-: perform-copy ( dst -- )
-    dup mapping get at
-    [ ##copy ] [ retire-copy ] 2bi ;
+: init ( mapping temp -- )
+    temp set
+    <dlist> to-do set
+    <dlist> ready set
+    [  preds set ]
+    [ [ nip dup ] H{ } assoc-map-as locs set ]
+    [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
 
-: break-cycle ( dst src -- dst src' )
-    [ i dup ] dip ##copy ;
+:: process-ready ( b quot -- )
+    b preds get at :> a
+    a locs get at :> c
+    b c quot call
+    b a locs get set-at
+    a c = a preds get at and [ a ready get push-front ] when ; inline
 
-: break-cycles ( mapping -- )
-    >alist [ break-cycle ] { } assoc-map-as [ ##copy ] assoc-each ;
+:: process-to-do ( b quot -- )
+    ! Note that we check if b = loc(b), not b = loc(pred(b)) as the
+    ! paper suggests. Confirmed by one of the authors at
+    ! http://www.reddit.com/comments/93253/some_lecture_notes_on_ssa_form/c0bco4f
+    b locs get at b = [
+        temp get b quot call
+        temp get b locs get set-at
+        b ready get push-front
+    ] when ; inline
 
-: parallel-copy ( mapping -- )
+PRIVATE>
+
+:: parallel-mapping ( mapping temp quot -- )
     [
-        init [ perform-copy ] slurp-deque
-        mapping get dup assoc-empty? [ drop ] [ break-cycles ] if
-    ] with-scope ;
\ No newline at end of file
+        mapping temp init
+        to-do get [
+            ready get [
+                quot process-ready
+            ] slurp-deque
+            quot process-to-do
+        ] slurp-deque
+    ] with-scope ; inline
+
+: parallel-copy ( mapping -- ) i [ ##copy ] parallel-mapping ;
\ No newline at end of file