Merge branch 'dcn' of git://factorcode.org/git/factor into dcn

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

@@ -10,25 +10,43 @@ SYMBOL: copies
 : resolve ( vreg -- vreg )
     [ copies get at ] keep or ;
 
-: record-copy ( insn -- )
+: record-copy ( ##copy -- )
     [ src>> resolve ] [ dst>> ] bi copies get set-at ; inline
 
+<PRIVATE
+
+GENERIC: visit-insn ( insn -- )
+
+M: ##copy visit-insn record-copy ;
+
+M: ##phi visit-insn inputs>> values [ resolve ] map all-equal? [ "BLAH!" print ] when ;
+
+M: insn visit-insn drop ;
+
 : collect-copies ( cfg -- )
     H{ } clone copies set
     [
         instructions>>
-        [ dup ##copy? [ record-copy ] [ drop ] if ] each
+        [ visit-insn ] each
     ] each-basic-block ;
 
+GENERIC: update-insn ( insn -- keep? )
+
+M: ##copy update-insn drop f ;
+
+M: insn update-insn rename-insn-uses t ;
+
 : rename-copies ( cfg -- )
     copies get dup assoc-empty? [ 2drop ] [
         renamings set
         [
             instructions>>
-            [ dup ##copy? [ drop f ] [ rename-insn-uses t ] if ] filter-here
+            [ update-insn ] filter-here
         ] each-basic-block
     ] if ;
 
+PRIVATE>
+
 : copy-propagation ( cfg -- cfg' )
     [ collect-copies ]
     [ rename-copies ]

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 ;