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 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{
|
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.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: assocs compiler.cfg.hats compiler.cfg.instructions
|
USING: assocs compiler.cfg.hats compiler.cfg.instructions
|
||||||
deques dlists fry kernel locals namespaces sequences
|
deques dlists fry kernel locals namespaces sequences
|
||||||
sets hashtables ;
|
hashtables ;
|
||||||
IN: compiler.cfg.parallel-copy
|
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 )
|
<PRIVATE
|
||||||
H{ } clone [ '[ _ conjoin-at ] assoc-each ] keep ;
|
|
||||||
|
|
||||||
: build-work-list ( mapping graph -- work-list )
|
SYMBOLS: temp locs preds to-do ready ;
|
||||||
[ keys ] dip '[ _ key? not ] filter <dlist> [ push-all-front ] keep ;
|
|
||||||
|
|
||||||
: init ( mapping -- work-list )
|
: init-to-do ( bs -- )
|
||||||
dup build-dependency-graph
|
to-do get push-all-back ;
|
||||||
[ [ >hashtable mapping set ] [ dependency-graph set ] bi* ]
|
|
||||||
[ build-work-list dup work-list set ]
|
|
||||||
2bi ;
|
|
||||||
|
|
||||||
:: retire-copy ( dst src -- )
|
: init-ready ( bs -- )
|
||||||
dst mapping get delete-at
|
locs get '[ _ key? not ] filter ready get push-all-front ;
|
||||||
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 -- )
|
: init ( mapping temp -- )
|
||||||
dup mapping get at
|
temp set
|
||||||
[ ##copy ] [ retire-copy ] 2bi ;
|
<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' )
|
:: process-ready ( b quot -- )
|
||||||
[ i dup ] dip ##copy ;
|
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 -- )
|
:: process-to-do ( b quot -- )
|
||||||
>alist [ break-cycle ] { } assoc-map-as [ ##copy ] assoc-each ;
|
! 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 temp init
|
||||||
mapping get dup assoc-empty? [ drop ] [ break-cycles ] if
|
to-do get [
|
||||||
] with-scope ;
|
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