compiler.cfg.ssa: now builds pruned SSA form
Slava Pestov
parent
d864214119
commit
26a5d51d93
|
|
@ -5,9 +5,12 @@ compiler.cfg.registers cpu.architecture kernel namespaces sequences
|
|||
tools.test vectors ;
|
||||
IN: compiler.cfg.ssa.tests
|
||||
|
||||
! Reset counters so that results are deterministic w.r.t. hash order
|
||||
0 vreg-counter set-global
|
||||
0 basic-block set-global
|
||||
: reset-counters ( -- )
|
||||
! Reset counters so that results are deterministic w.r.t. hash order
|
||||
0 vreg-counter set-global
|
||||
0 basic-block set-global ;
|
||||
|
||||
reset-counters
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 1 100 }
|
||||
|
|
@ -38,7 +41,6 @@ V{
|
|||
: test-ssa ( -- )
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
compute-dominance
|
||||
construct-ssa
|
||||
drop ;
|
||||
|
||||
|
|
@ -67,6 +69,9 @@ 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 V int-regs 6 H{ { 1 V int-regs 4 } { 2 V int-regs 5 } } }
|
||||
|
|
@ -75,5 +80,34 @@ V{
|
|||
}
|
||||
] [
|
||||
3 get instructions>>
|
||||
[ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map
|
||||
clean-up-phis
|
||||
] unit-test
|
||||
|
||||
reset-counters
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
V{ T{ ##peek f V int-regs 0 D 0 } } 2 test-bb
|
||||
V{ T{ ##peek f V int-regs 0 D 0 } } 3 test-bb
|
||||
V{ T{ ##replace f V int-regs 0 D 0 } } 4 test-bb
|
||||
V{ } 5 test-bb
|
||||
V{ } 6 test-bb
|
||||
|
||||
0 get 1 get 5 get V{ } 2sequence >>successors drop
|
||||
1 get 2 get 3 get V{ } 2sequence >>successors drop
|
||||
2 get 4 get 1vector >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
4 get 6 get 1vector >>successors drop
|
||||
5 get 6 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-ssa ] unit-test
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##phi f V int-regs 3 H{ { 2 V int-regs 1 } { 3 V int-regs 2 } } }
|
||||
T{ ##replace f V int-regs 3 D 0 }
|
||||
}
|
||||
] [
|
||||
4 get instructions>>
|
||||
clean-up-phis
|
||||
] unit-test
|
||||
|
|
@ -1,19 +1,21 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces kernel accessors sequences fry dlists
|
||||
deques assocs sets math combinators sorting
|
||||
USING: namespaces kernel accessors sequences fry assocs
|
||||
sets math combinators
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.def-use
|
||||
compiler.cfg.renaming
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.dominance
|
||||
compiler.cfg.instructions ;
|
||||
IN: compiler.cfg.ssa
|
||||
|
||||
! SSA construction. Predecessors and dominance must be computed first.
|
||||
! SSA construction. Predecessors must be computed first.
|
||||
|
||||
! This is the classical algorithm based on dominance frontiers:
|
||||
! This is the classical algorithm based on dominance frontiers, except
|
||||
! we consult liveness information to build pruned SSA:
|
||||
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240
|
||||
|
||||
! Eventually might be worth trying something fancier:
|
||||
|
|
@ -32,45 +34,22 @@ SYMBOL: inserting-phi-nodes
|
|||
'[
|
||||
dup instructions>> [
|
||||
defs-vregs [
|
||||
_ push-at
|
||||
_ conjoin-at
|
||||
] with each
|
||||
] with each
|
||||
] each-basic-block ;
|
||||
|
||||
SYMBOLS: has-already ever-on-work-list work-list ;
|
||||
|
||||
: init-insert-phi-nodes ( bbs -- )
|
||||
H{ } clone has-already set
|
||||
[ unique ever-on-work-list set ]
|
||||
[ <hashed-dlist> [ push-all-front ] keep work-list set ] bi ;
|
||||
|
||||
: add-to-work-list ( bb -- )
|
||||
dup ever-on-work-list get key? [ drop ] [
|
||||
[ ever-on-work-list get conjoin ]
|
||||
[ work-list get push-front ]
|
||||
bi
|
||||
] if ;
|
||||
|
||||
: insert-phi-node-later ( vreg bb -- )
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
|
||||
inserting-phi-nodes get push-at ;
|
||||
|
||||
: compute-phi-node-in ( vreg bb -- )
|
||||
dup has-already get key? [ 2drop ] [
|
||||
[ insert-phi-node-later ]
|
||||
[ has-already get conjoin ]
|
||||
[ add-to-work-list ]
|
||||
tri
|
||||
] if ;
|
||||
2dup live-in key? [
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
|
||||
inserting-phi-nodes get push-at
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: compute-phi-nodes-for ( vreg bbs -- )
|
||||
dup length 2 >= [
|
||||
init-insert-phi-nodes
|
||||
work-list get [
|
||||
dom-frontier [
|
||||
compute-phi-node-in
|
||||
] with each
|
||||
] with slurp-deque
|
||||
keys dup length 2 >= [
|
||||
iterated-dom-frontier [
|
||||
insert-phi-node-later
|
||||
] with each
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: compute-phi-nodes ( -- )
|
||||
|
|
@ -143,4 +122,10 @@ M: ##phi rename-insn
|
|||
PRIVATE>
|
||||
|
||||
: construct-ssa ( cfg -- cfg' )
|
||||
dup [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] bi ;
|
||||
{
|
||||
[ ]
|
||||
[ compute-live-sets ]
|
||||
[ compute-dominance ]
|
||||
[ compute-defs compute-phi-nodes insert-phi-nodes ]
|
||||
[ rename ]
|
||||
} cleave ;
|
||||
Loading…
Reference in New Issue