From ba696b68b82c15a6ebb8cc200e7c0dc3c169673c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 27 Jul 2009 02:20:45 -0500 Subject: [PATCH] compiler.cfg.coalescing: more or less complete, now needs debugging --- .../compiler/cfg/coalescing/coalescing.factor | 26 ++++++++-- .../cfg/coalescing/copies/copies.factor | 48 ++++++------------- .../cfg/coalescing/renaming/renaming.factor | 35 +++++++++++--- basis/compiler/cfg/dominance/dominance.factor | 20 ++++---- basis/compiler/cfg/optimizer/optimizer.factor | 6 +-- basis/compiler/cfg/ssa/ssa.factor | 1 + basis/disjoint-sets/disjoint-sets.factor | 4 ++ 7 files changed, 84 insertions(+), 56 deletions(-) diff --git a/basis/compiler/cfg/coalescing/coalescing.factor b/basis/compiler/cfg/coalescing/coalescing.factor index 05a67a230b..fe6166302f 100644 --- a/basis/compiler/cfg/coalescing/coalescing.factor +++ b/basis/compiler/cfg/coalescing/coalescing.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs fry kernel locals math math.order -sequences +sequences namespaces sets compiler.cfg.rpo +compiler.cfg.def-use compiler.cfg.utilities compiler.cfg.dominance compiler.cfg.instructions @@ -21,7 +22,24 @@ IN: compiler.cfg.coalescing : process-blocks ( cfg -- ) [ [ process-block ] if-has-phis ] each-basic-block ; -: break-interferences ( -- ) ; +SYMBOL: seen + +:: visit-renaming ( dst assoc src bb -- ) + src seen get key? [ + src dst bb waiting-for push-at + src assoc delete-at + ] [ src seen get conjoin ] if ; + +:: break-interferences ( -- ) + V{ } clone seen set + renaming-sets get [| dst assoc | + assoc [| src bb | + src seen get key? + [ dst assoc src bb visit-renaming ] + [ src seen get conjoin ] + if + ] assoc-each + ] assoc-each ; : remove-phis-from-block ( bb -- ) instructions>> [ ##phi? not ] filter-here ; @@ -31,9 +49,11 @@ IN: compiler.cfg.coalescing : coalesce ( cfg -- cfg' ) init-coalescing + dup compute-def-use + dup compute-dominance dup compute-dfs dup process-blocks break-interferences dup insert-copies - perform-renaming + dup perform-renaming dup remove-phis ; \ No newline at end of file diff --git a/basis/compiler/cfg/coalescing/copies/copies.factor b/basis/compiler/cfg/coalescing/copies/copies.factor index 7293bcc802..86f9e12423 100644 --- a/basis/compiler/cfg/coalescing/copies/copies.factor +++ b/basis/compiler/cfg/coalescing/copies/copies.factor @@ -1,39 +1,21 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs combinators fry kernel namespaces sequences -compiler.cfg.def-use compiler.cfg.dominance compiler.cfg.instructions -compiler.cfg.renaming ; +USING: accessors assocs hashtables fry kernel make namespaces +sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ; IN: compiler.cfg.coalescing.copies -SYMBOLS: stacks visited pushed ; - -: compute-renaming ( insn -- assoc ) - uses-vregs stacks get - '[ dup dup _ at [ nip last ] unless-empty ] - H{ } map>assoc ; - -: rename-operands ( bb -- ) - instructions>> [ - dup ##phi? [ drop ] [ - dup compute-renaming renamings set - [ rename-insn-uses ] [ rename-insn-defs ] bi - ] if - ] each ; - -: schedule-copies ( bb -- ) - ! FIXME - drop ; - -: pop-stacks ( -- ) - pushed get stacks get '[ drop _ at pop* ] assoc-each ; - -: (insert-copies) ( bb -- ) - H{ } clone pushed [ - [ rename-operands ] - [ schedule-copies ] - [ dom-children [ (insert-copies) ] each ] tri - pop-stacks - ] with-variable ; +: compute-copies ( assoc -- assoc' ) + dup assoc-size [ + '[ + [ _ set-at ] with each + ] assoc-each + ] keep ; : insert-copies ( cfg -- ) - entry>> (insert-copies) ; \ No newline at end of file + waiting get [ + [ instructions>> building ] dip '[ + building get pop + _ compute-copies parallel-copy + , + ] with-variable + ] assoc-each ; \ No newline at end of file diff --git a/basis/compiler/cfg/coalescing/renaming/renaming.factor b/basis/compiler/cfg/coalescing/renaming/renaming.factor index 3b26c09738..bad74807d0 100644 --- a/basis/compiler/cfg/coalescing/renaming/renaming.factor +++ b/basis/compiler/cfg/coalescing/renaming/renaming.factor @@ -1,10 +1,33 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel ; +USING: accessors assocs fry kernel namespaces sequences +compiler.cfg.coalescing.state compiler.cfg.renaming compiler.cfg.rpo +disjoint-sets ; IN: compiler.cfg.coalescing.renaming -: perform-renaming ( -- ) - renaming-sets get [ - ! XXX - 2drop - ] assoc-each ; +: update-congruence-class ( dst assoc disjoint-set -- ) + [ keys swap ] dip + [ nip add-atoms ] + [ add-atom drop ] + [ equate-all-with ] 3tri ; + +: build-congruence-classes ( -- disjoint-set ) + renaming-sets get + [ + '[ + _ update-congruence-class + ] assoc-each + ] keep ; + +: compute-renaming ( disjoint-set -- assoc ) + [ parents>> ] keep + '[ drop dup _ representative ] assoc-map ; + +: perform-renaming ( cfg -- ) + build-congruence-classes compute-renaming renamings set + [ + instructions>> [ + [ rename-insn-defs ] + [ rename-insn-uses ] bi + ] each + ] each-basic-block ; diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index 6eeeacd6f1..ebd3a981d7 100644 --- a/basis/compiler/cfg/dominance/dominance.factor +++ b/basis/compiler/cfg/dominance/dominance.factor @@ -60,21 +60,26 @@ PRIVATE> [ '[ 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 keys ; +: compute-dominance ( cfg -- ) + compute-dom-parents compute-dom-children ; DF(bb) +SYMBOL: dom-frontiers + : compute-dom-frontier ( bb pred -- ) 2dup [ dom-parent ] dip eq? [ 2drop ] [ [ dom-frontiers get conjoin-at ] [ dom-parent compute-dom-frontier ] 2bi ] if ; +PRIVATE> + +: dom-frontier ( bb -- set ) dom-frontiers get at keys ; + : compute-dom-frontiers ( cfg -- ) H{ } clone dom-frontiers set [ @@ -83,13 +88,6 @@ PRIVATE> ] [ 2drop ] if ] each-basic-block ; -PRIVATE> - -: compute-dominance ( cfg -- ) - [ compute-dom-parents compute-dom-children ] - [ compute-dom-frontiers ] - bi ; - [ ] [ compute-live-sets ] [ compute-dominance ] + [ compute-dom-frontiers ] [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] } cleave ; \ No newline at end of file diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index a3e5c7ceb7..80ab2f58bf 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -35,6 +35,8 @@ TUPLE: disjoint-set : representative? ( a disjoint-set -- ? ) dupd parent = ; inline +PRIVATE> + GENERIC: representative ( a disjoint-set -- p ) M: disjoint-set representative @@ -42,6 +44,8 @@ M: disjoint-set representative [ [ parent ] keep representative dup ] 2keep set-parent ] if ; +