compiler.cfg.ssa.construction: use the baller method for pruned SSA
Slava Pestov
Slava Pestov
parent
f9c9814e57
commit
8bc2ea7a5c
|
|
@ -10,6 +10,16 @@ IN: compiler.cfg.ssa.construction.tests
|
|||
0 vreg-counter set-global
|
||||
0 basic-block set-global ;
|
||||
|
||||
: test-ssa ( -- )
|
||||
cfg new 0 get >>entry
|
||||
dup cfg set
|
||||
construct-ssa
|
||||
drop ;
|
||||
|
||||
: clean-up-phis ( insns -- insns' )
|
||||
[ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ;
|
||||
|
||||
! Test 1
|
||||
reset-counters
|
||||
|
||||
V{
|
||||
|
|
@ -38,12 +48,6 @@ V{
|
|||
1 3 edge
|
||||
2 3 edge
|
||||
|
||||
: test-ssa ( -- )
|
||||
cfg new 0 get >>entry
|
||||
dup cfg set
|
||||
construct-ssa
|
||||
drop ;
|
||||
|
||||
[ ] [ test-ssa ] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -69,9 +73,6 @@ V{
|
|||
}
|
||||
] [ 2 get instructions>> ] unit-test
|
||||
|
||||
: clean-up-phis ( insns -- insns' )
|
||||
[ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ;
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##phi f 6 H{ { 1 4 } { 2 5 } } }
|
||||
|
|
@ -83,6 +84,7 @@ V{
|
|||
clean-up-phis
|
||||
] unit-test
|
||||
|
||||
! Test 2
|
||||
reset-counters
|
||||
|
||||
V{ } 0 test-bb
|
||||
|
|
@ -110,4 +112,89 @@ V{ } 6 test-bb
|
|||
] [
|
||||
4 get instructions>>
|
||||
clean-up-phis
|
||||
] unit-test
|
||||
] unit-test
|
||||
|
||||
! Test 3
|
||||
reset-counters
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-integer f 3 3 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-integer f 3 4 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##return }
|
||||
} 4 test-bb
|
||||
|
||||
0 { 1 2 3 } edges
|
||||
1 4 edge
|
||||
2 4 edge
|
||||
3 4 edge
|
||||
|
||||
[ ] [ test-ssa ] unit-test
|
||||
|
||||
[ V{ } ] [ 4 get instructions>> [ ##phi? ] filter ] unit-test
|
||||
|
||||
! Test 4
|
||||
reset-counters
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-integer f 0 4 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-integer f 0 4 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 5 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 6 test-bb
|
||||
|
||||
V{
|
||||
T{ ##return }
|
||||
} 7 test-bb
|
||||
|
||||
0 { 1 6 } edges
|
||||
1 { 2 3 4 } edges
|
||||
2 5 edge
|
||||
3 5 edge
|
||||
4 5 edge
|
||||
5 7 edge
|
||||
6 7 edge
|
||||
|
||||
[ ] [ test-ssa ] unit-test
|
||||
|
||||
[ V{ } ] [ 5 get instructions>> [ ##phi? ] filter ] unit-test
|
||||
|
||||
[ V{ } ] [ 7 get instructions>> [ ##phi? ] filter ] unit-test
|
||||
|
|
@ -1,11 +1,10 @@
|
|||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces kernel accessors sequences fry assocs
|
||||
sets math combinators
|
||||
sets math combinators deques dlists
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.def-use
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.dominance
|
||||
compiler.cfg.instructions
|
||||
|
|
@ -15,12 +14,18 @@ compiler.cfg.ssa.construction.tdmsc ;
|
|||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.ssa.construction
|
||||
|
||||
! The phi placement algorithm is implemented in
|
||||
! compiler.cfg.ssa.construction.tdmsc.
|
||||
! Iterated dominance frontiers are computed using the DJ Graph
|
||||
! method in compiler.cfg.ssa.construction.tdmsc.
|
||||
|
||||
! The renaming algorithm is based on "Practical Improvements to
|
||||
! the Construction and Destruction of Static Single Assignment Form",
|
||||
! however we construct pruned SSA, not semi-pruned SSA.
|
||||
! the Construction and Destruction of Static Single Assignment
|
||||
! Form".
|
||||
|
||||
! We construct pruned SSA without computing live sets, by
|
||||
! building a dependency graph for phi instructions, marking the
|
||||
! transitive closure of a vertex as live if it is referenced by
|
||||
! some non-phi instruction. Thanks to Cameron Zwarich for the
|
||||
! trick.
|
||||
|
||||
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.49.9683
|
||||
|
||||
|
|
@ -50,31 +55,32 @@ M: vreg-insn compute-insn-defs
|
|||
[ compute-insn-defs ] with each
|
||||
] simple-analysis ;
|
||||
|
||||
! Maps basic blocks to sequences of vregs
|
||||
SYMBOL: inserting-phi-nodes
|
||||
! Maps basic blocks to sequences of ##phi instructions
|
||||
SYMBOL: inserting-phis
|
||||
|
||||
: insert-phi-node-later ( vreg bb -- )
|
||||
2dup live-in key? [
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
|
||||
inserting-phi-nodes get push-at
|
||||
] [ 2drop ] if ;
|
||||
: insert-phi-later ( vreg bb -- )
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
|
||||
inserting-phis get push-at ;
|
||||
|
||||
: compute-phi-nodes-for ( vreg bbs -- )
|
||||
keys merge-set [ insert-phi-node-later ] with each ;
|
||||
: compute-phis-for ( vreg bbs -- )
|
||||
keys merge-set [ insert-phi-later ] with each ;
|
||||
|
||||
: compute-phi-nodes ( -- )
|
||||
H{ } clone inserting-phi-nodes set
|
||||
defs-multi get defs get '[ _ at compute-phi-nodes-for ] assoc-each ;
|
||||
: compute-phis ( -- )
|
||||
H{ } clone inserting-phis set
|
||||
defs-multi get defs get '[ _ at compute-phis-for ] assoc-each ;
|
||||
|
||||
: insert-phi-nodes-in ( phis bb -- )
|
||||
[ append ] change-instructions drop ;
|
||||
! Maps vregs to ##phi instructions
|
||||
SYMBOL: phis
|
||||
|
||||
: insert-phi-nodes ( -- )
|
||||
inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ;
|
||||
! Worklist of used vregs, to calculate used phis
|
||||
SYMBOL: used-vregs
|
||||
|
||||
! Maps vregs to renaming stacks
|
||||
SYMBOLS: stacks pushed ;
|
||||
|
||||
: init-renaming ( -- )
|
||||
H{ } clone phis set
|
||||
<hashed-dlist> used-vregs set
|
||||
H{ } clone stacks set ;
|
||||
|
||||
: gen-name ( vreg -- vreg' )
|
||||
|
|
@ -84,8 +90,12 @@ SYMBOLS: stacks pushed ;
|
|||
[ conjoin stacks get push-at ]
|
||||
if ;
|
||||
|
||||
: (top-name) ( vreg -- vreg' )
|
||||
stacks get at [ f ] [ last ] if-empty ;
|
||||
|
||||
: top-name ( vreg -- vreg' )
|
||||
stacks get at last ;
|
||||
(top-name)
|
||||
dup [ dup used-vregs get push-front ] when ;
|
||||
|
||||
RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ]
|
||||
|
||||
|
|
@ -98,17 +108,22 @@ M: vreg-insn rename-insn
|
|||
[ ssa-rename-insn-defs ]
|
||||
bi ;
|
||||
|
||||
M: ##phi rename-insn
|
||||
ssa-rename-insn-defs ;
|
||||
: rename-phis ( bb -- )
|
||||
inserting-phis get at [
|
||||
[
|
||||
[ ssa-rename-insn-defs ]
|
||||
[ dup dst>> phis get set-at ] bi
|
||||
] each
|
||||
] when* ;
|
||||
|
||||
: rename-insns ( bb -- )
|
||||
instructions>> [ rename-insn ] each ;
|
||||
|
||||
: rename-successor-phi ( phi bb -- )
|
||||
swap inputs>> [ top-name ] change-at ;
|
||||
swap inputs>> [ (top-name) ] change-at ;
|
||||
|
||||
: rename-successor-phis ( succ bb -- )
|
||||
[ inserting-phi-nodes get at ] dip
|
||||
[ inserting-phis get at ] dip
|
||||
'[ _ rename-successor-phi ] each ;
|
||||
|
||||
: rename-successors-phis ( bb -- )
|
||||
|
|
@ -119,26 +134,56 @@ M: ##phi rename-insn
|
|||
|
||||
: rename-in-block ( bb -- )
|
||||
H{ } clone pushed set
|
||||
[ rename-insns ]
|
||||
[ rename-successors-phis ]
|
||||
[
|
||||
pushed get
|
||||
[ dom-children [ rename-in-block ] each ] dip
|
||||
pushed set
|
||||
] tri
|
||||
{
|
||||
[ rename-phis ]
|
||||
[ rename-insns ]
|
||||
[ rename-successors-phis ]
|
||||
[
|
||||
pushed get
|
||||
[ dom-children [ rename-in-block ] each ] dip
|
||||
pushed set
|
||||
]
|
||||
} cleave
|
||||
pop-stacks ;
|
||||
|
||||
: rename ( cfg -- )
|
||||
init-renaming
|
||||
entry>> rename-in-block ;
|
||||
|
||||
! Live phis
|
||||
SYMBOL: live-phis
|
||||
|
||||
: live-phi? ( ##phi -- ? )
|
||||
dst>> live-phis get key? ;
|
||||
|
||||
: compute-live-phis ( -- )
|
||||
H{ } clone live-phis set
|
||||
used-vregs get [
|
||||
phis get at [
|
||||
[
|
||||
dst>>
|
||||
[ live-phis get conjoin ]
|
||||
[ phis get delete-at ]
|
||||
bi
|
||||
]
|
||||
[ inputs>> [ nip used-vregs get push-front ] assoc-each ] bi
|
||||
] when*
|
||||
] slurp-deque ;
|
||||
|
||||
: insert-phis-in ( phis bb -- )
|
||||
[ [ live-phi? ] filter! ] dip
|
||||
[ append ] change-instructions drop ;
|
||||
|
||||
: insert-phis ( -- )
|
||||
inserting-phis get
|
||||
[ swap insert-phis-in ] assoc-each ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: construct-ssa ( cfg -- cfg' )
|
||||
{
|
||||
[ compute-live-sets ]
|
||||
[ compute-merge-sets ]
|
||||
[ compute-defs compute-phi-nodes insert-phi-nodes ]
|
||||
[ rename ]
|
||||
[ compute-defs compute-phis ]
|
||||
[ rename compute-live-phis insert-phis ]
|
||||
[ ]
|
||||
} cleave ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue