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 }
: test-ssa ( -- )
cfg new 0 get >>entry
compute-predecessors
- compute-dominance
construct-ssa
drop ;
}
] [ 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 } } }
}
] [
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
\ No newline at end of file
! 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:
'[
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 ( -- )
PRIVATE>
: construct-ssa ( cfg -- cfg' )
- dup [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] bi ;
\ No newline at end of file
+ {
+ [ ]
+ [ compute-live-sets ]
+ [ compute-dominance ]
+ [ compute-defs compute-phi-nodes insert-phi-nodes ]
+ [ rename ]
+ } cleave ;
\ No newline at end of file