diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor b/basis/compiler/cfg/parallel-copy/parallel-copy-tests.factor index 0234c2eae7..17b043c1b7 100644 --- 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 index 534cef36d2..0000000000 --- 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 - - to-do set - 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 ff309c45ad..550928b8ba 100644 --- 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 ; + [ 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 + to-do set + 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