compiler.cfg.parallel-copy: fix algorithm
Slava Pestov
parent
31555b05cf
commit
1a765c38da
|
|
@ -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{
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
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 ;
|
||||
Loading…
Reference in New Issue