--- /dev/null
+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
\ No newline at end of file
--- /dev/null
+! 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
--- /dev/null
+! 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 ;
\ No newline at end of file