compiler.cfg.dominance: fix idom computation, compute dominator tree, compute dominance frontiers, add some tests
Slava Pestov
parent
fd9a353fd6
commit
3136549f48
|
|
@ -0,0 +1,77 @@
|
|||
IN: compiler.cfg.dominance.tests
|
||||
USING: tools.test sequences vectors namespaces kernel accessors assocs sets
|
||||
math.ranges arrays compiler.cfg compiler.cfg.dominance compiler.cfg.debugger
|
||||
compiler.cfg.predecessors ;
|
||||
|
||||
: test-dominance ( -- )
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
compute-dominance
|
||||
drop ;
|
||||
|
||||
! Example with no back edges
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
V{ } 2 test-bb
|
||||
V{ } 3 test-bb
|
||||
V{ } 4 test-bb
|
||||
V{ } 5 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
1 get 3 get 1vector >>successors drop
|
||||
2 get 4 get 1vector >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
4 get 5 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-dominance ] unit-test
|
||||
|
||||
[ t ] [ 0 get dom-parent 0 get eq? ] unit-test
|
||||
[ t ] [ 1 get dom-parent 0 get eq? ] unit-test
|
||||
[ t ] [ 2 get dom-parent 0 get eq? ] unit-test
|
||||
[ t ] [ 4 get dom-parent 0 get eq? ] unit-test
|
||||
[ t ] [ 3 get dom-parent 1 get eq? ] unit-test
|
||||
[ t ] [ 5 get dom-parent 4 get eq? ] unit-test
|
||||
|
||||
[ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
|
||||
|
||||
[ t ] [ 4 get 1 get dom-frontier key? ] unit-test
|
||||
[ f ] [ 3 get 1 get dom-frontier key? ] unit-test
|
||||
[ t ] [ 4 get 2 get dom-frontier key? ] unit-test
|
||||
[ t ] [ 0 get dom-frontier assoc-empty? ] unit-test
|
||||
[ t ] [ 4 get dom-frontier assoc-empty? ] unit-test
|
||||
|
||||
! Example from the paper
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
V{ } 2 test-bb
|
||||
V{ } 3 test-bb
|
||||
V{ } 4 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
1 get 3 get 1vector >>successors drop
|
||||
2 get 4 get 1vector >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
4 get 3 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-dominance ] unit-test
|
||||
|
||||
[ t ] [ 0 4 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
||||
|
||||
! The other example from the paper
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
V{ } 2 test-bb
|
||||
V{ } 3 test-bb
|
||||
V{ } 4 test-bb
|
||||
V{ } 5 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
1 get 5 get 1vector >>successors drop
|
||||
2 get 4 get 3 get V{ } 2sequence >>successors drop
|
||||
5 get 4 get 1vector >>successors drop
|
||||
4 get 5 get 3 get V{ } 2sequence >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-dominance ] unit-test
|
||||
|
||||
[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators compiler.cfg.rpo
|
||||
USING: accessors assocs combinators sets math compiler.cfg.rpo
|
||||
compiler.cfg.stack-analysis fry kernel math.order namespaces
|
||||
sequences ;
|
||||
IN: compiler.cfg.dominance
|
||||
|
|
@ -11,31 +11,83 @@ IN: compiler.cfg.dominance
|
|||
! Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy
|
||||
! http://www.cs.rice.edu/~keith/EMBED/dom.pdf
|
||||
|
||||
SYMBOL: idoms
|
||||
|
||||
: idom ( bb -- bb' ) idoms get at ;
|
||||
! Also, a nice overview is given in these lecture notes:
|
||||
! http://llvm.cs.uiuc.edu/~vadve/CS526/public_html/Notes/4ssa.4up.pdf
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: set-idom ( idom bb -- changed? ) idoms get maybe-set-at ;
|
||||
! Maps bb -> idom(bb)
|
||||
SYMBOL: dom-parents
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: dom-parent ( bb -- bb' ) dom-parents get at ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: set-idom ( idom bb -- changed? )
|
||||
dom-parents get maybe-set-at ;
|
||||
|
||||
: intersect ( finger1 finger2 -- bb )
|
||||
2dup [ number>> ] compare {
|
||||
{ +lt+ [ [ idom ] dip intersect ] }
|
||||
{ +gt+ [ idom intersect ] }
|
||||
{ +gt+ [ [ dom-parent ] dip intersect ] }
|
||||
{ +lt+ [ dom-parent intersect ] }
|
||||
[ 2drop ]
|
||||
} case ;
|
||||
|
||||
: compute-idom ( bb -- idom )
|
||||
predecessors>> [ idom ] map sift
|
||||
predecessors>> [ dom-parent ] filter
|
||||
[ ] [ intersect ] map-reduce ;
|
||||
|
||||
: iterate ( rpo -- changed? )
|
||||
[ [ compute-idom ] keep set-idom ] map [ ] any? ;
|
||||
|
||||
: compute-dom-parents ( cfg -- )
|
||||
H{ } clone dom-parents set
|
||||
reverse-post-order
|
||||
unclip dup set-idom drop '[ _ iterate ] loop ;
|
||||
|
||||
! Maps bb -> {bb' | idom(bb') = bb}
|
||||
SYMBOL: dom-childrens
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: compute-dominance ( cfg -- cfg )
|
||||
H{ } clone idoms set
|
||||
dup reverse-post-order
|
||||
unclip dup set-idom drop '[ _ iterate ] loop ;
|
||||
: dom-children ( bb -- seq ) dom-childrens get at ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: compute-dom-children ( -- )
|
||||
dom-parents get H{ } clone
|
||||
[ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
|
||||
dom-childrens set ;
|
||||
|
||||
! Maps bb -> DF(bb)
|
||||
SYMBOL: dom-frontiers
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: dom-frontier ( bb -- set ) dom-frontiers get at ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: compute-dom-frontier ( bb pred -- )
|
||||
2dup [ dom-parent ] dip eq? [ 2drop ] [
|
||||
[ dom-frontiers get conjoin-at ]
|
||||
[ dom-parent compute-dom-frontier ] 2bi
|
||||
] if ;
|
||||
|
||||
: compute-dom-frontiers ( cfg -- )
|
||||
H{ } clone dom-frontiers set
|
||||
[
|
||||
dup predecessors>> dup length 2 >= [
|
||||
[ compute-dom-frontier ] with each
|
||||
] [ 2drop ] if
|
||||
] each-basic-block ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: compute-dominance ( cfg -- cfg' )
|
||||
[ compute-dom-parents compute-dom-children ]
|
||||
[ compute-dom-frontiers ]
|
||||
[ ]
|
||||
tri ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue