From fd9a353fd6cce01933e81db1727cc5772159a6ca Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Jul 2009 03:02:06 -0500 Subject: [PATCH 1/2] Move conjoin-at from compiler.cfg.liveness to sets --- basis/compiler/cfg/liveness/liveness.factor | 3 --- core/sets/sets-docs.factor | 5 +++++ core/sets/sets.factor | 3 +++ 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index 8a46b32070..9dc320660c 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/basis/compiler/cfg/liveness/liveness.factor @@ -43,9 +43,6 @@ SYMBOL: work-list [ nip kill-set ] 2bi assoc-diff ; -: conjoin-at ( value key assoc -- ) - [ dupd ?set-at ] change-at ; - : compute-phi-live-in ( basic-block -- phi-live-in ) instructions>> [ ##phi? ] filter [ f ] [ H{ } clone [ diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 0fce78dd68..cec3d65d3c 100755 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -23,6 +23,7 @@ $nl "Adding elements to sets:" { $subsection adjoin } { $subsection conjoin } +{ $subsection conjoin-at } { $see-also member? memq? any? all? "assocs-sets" } ; ABOUT: "sets" @@ -54,6 +55,10 @@ HELP: conjoin } { $side-effects "assoc" } ; +HELP: conjoin-at +{ $values { "value" object } { "key" object } { "assoc" assoc } } +{ $description "Adds " { $snippet "value" } " to the set stored at " { $snippet "key" } " of " { $snippet "assoc" } "." } ; + HELP: unique { $values { "seq" "a sequence" } { "assoc" assoc } } { $description "Outputs a new assoc where the keys and values are equal." } diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 062b624e8f..c7b834297a 100755 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -7,6 +7,9 @@ IN: sets : conjoin ( elt assoc -- ) dupd set-at ; +: conjoin-at ( value key assoc -- ) + [ dupd ?set-at ] change-at ; + : (prune) ( elt hash vec -- ) 3dup drop key? [ 3drop ] [ [ drop conjoin ] [ nip push ] 3bi From 3136549f489cc573b53c461700e92a12b9190989 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Jul 2009 03:02:45 -0500 Subject: [PATCH 2/2] compiler.cfg.dominance: fix idom computation, compute dominator tree, compute dominance frontiers, add some tests --- .../cfg/dominance/dominance-tests.factor | 77 +++++++++++++++++++ basis/compiler/cfg/dominance/dominance.factor | 76 +++++++++++++++--- 2 files changed, 141 insertions(+), 12 deletions(-) create mode 100644 basis/compiler/cfg/dominance/dominance-tests.factor diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor new file mode 100644 index 0000000000..e3e0d09cfc --- /dev/null +++ b/basis/compiler/cfg/dominance/dominance-tests.factor @@ -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 diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index 750a46ee6c..8b8d006560 100644 --- a/basis/compiler/cfg/dominance/dominance.factor +++ b/basis/compiler/cfg/dominance/dominance.factor @@ -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 idom(bb) +SYMBOL: dom-parents + +PRIVATE> + +: dom-parent ( bb -- bb' ) dom-parents get at ; + +> ] 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 ; \ No newline at end of file +: dom-children ( bb -- seq ) dom-childrens get at ; + + DF(bb) +SYMBOL: dom-frontiers + +PRIVATE> + +: dom-frontier ( bb -- set ) dom-frontiers get at ; + +> 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 ;