compiler.cfg.parallel-copy: forgot to add this

basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor

@@ -0,0 +1,63 @@
+USING: compiler.cfg.parallel-copy tools.test make arrays
+compiler.cfg.registers namespaces compiler.cfg.instructions
+cpu.architecture ;
+IN: compiler.cfg.parallel-copy.tests
+
+SYMBOL: temp
+
+: test-parallel-copy ( mapping -- seq )
+    3 vreg-counter set-global
+    [ parallel-copy ] { } make ;
+
+[
+    {
+        T{ ##copy f V int-regs 3 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 }
+    }
+] [
+    H{
+        { V int-regs 1 V int-regs 2 }
+        { V int-regs 2 V int-regs 1 }
+    } test-parallel-copy
+] unit-test
+
+[
+    {
+        T{ ##copy f V int-regs 1 V int-regs 2 }
+        T{ ##copy f V int-regs 3 V int-regs 4 }
+    }
+] [
+    H{
+        { V int-regs 1 V int-regs 2 }
+        { V int-regs 3 V int-regs 4 }
+    } test-parallel-copy
+] unit-test
+
+[
+    {
+        T{ ##copy f V int-regs 1 V int-regs 3 }
+        T{ ##copy f V int-regs 2 V int-regs 1 }
+    }
+] [
+    H{
+        { V int-regs 1 V int-regs 3 }
+        { V int-regs 2 V int-regs 3 }
+    } test-parallel-copy
+] unit-test
+
+[
+    {
+        T{ ##copy f V int-regs 4 V int-regs 3 }
+        T{ ##copy f V int-regs 3 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 4 }
+    }
+] [
+    {
+        { V int-regs 2 V int-regs 1 }
+        { V int-regs 3 V int-regs 2 }
+        { V int-regs 1 V int-regs 3 }
+        { V int-regs 4 V int-regs 3 }
+    } test-parallel-copy
+] unit-test

basis/compiler/cfg/parallel-copy/parallel-copy.alt.factor

@@ -0,0 +1,57 @@
+! 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 ;

basis/compiler/cfg/parallel-copy/parallel-copy.factor

@@ -0,0 +1,46 @@
+! 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
+sets hashtables ;
+IN: compiler.cfg.parallel-copy
+
+SYMBOLS: mapping dependency-graph work-list ;
+
+: build-dependency-graph ( mapping -- deps )
+    H{ } clone [ '[ _ conjoin-at ] assoc-each ] keep ;
+
+: build-work-list ( mapping graph -- work-list )
+    [ keys ] dip '[ _ key? not ] filter <dlist> [ push-all-front ] keep ;
+
+: init ( mapping -- work-list )
+    dup build-dependency-graph
+    [ [ >hashtable mapping set ] [ dependency-graph set ] bi* ]
+    [ build-work-list dup work-list set ]
+    2bi ;
+
+:: 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 ;
+
+: perform-copy ( dst -- )
+    dup mapping get at
+    [ ##copy ] [ retire-copy ] 2bi ;
+
+: break-cycle ( dst src -- dst src' )
+    [ i dup ] dip ##copy ;
+
+: break-cycles ( mapping -- )
+    >alist [ break-cycle ] { } assoc-map-as [ ##copy ] assoc-each ;
+
+: parallel-copy ( mapping -- )
+    [
+        init [ perform-copy ] slurp-deque
+        mapping get dup assoc-empty? [ drop ] [ break-cycles ] if
+    ] with-scope ;