diff --git a/basis/compiler/cfg/coalescing/coalescing.factor b/basis/compiler/cfg/coalescing/coalescing.factor index 5a09b59749..05a67a230b 100644 --- a/basis/compiler/cfg/coalescing/coalescing.factor +++ b/basis/compiler/cfg/coalescing/coalescing.factor @@ -3,10 +3,13 @@ USING: accessors assocs fry kernel locals math math.order sequences compiler.cfg.rpo -compiler.cfg.instructions +compiler.cfg.utilities compiler.cfg.dominance +compiler.cfg.instructions compiler.cfg.coalescing.state compiler.cfg.coalescing.forest +compiler.cfg.coalescing.copies +compiler.cfg.coalescing.renaming compiler.cfg.coalescing.process-blocks ; IN: compiler.cfg.coalescing @@ -18,14 +21,8 @@ IN: compiler.cfg.coalescing : process-blocks ( cfg -- ) [ [ process-block ] if-has-phis ] each-basic-block ; -: schedule-copies ( bb -- ) drop ; - : break-interferences ( -- ) ; -: insert-copies ( cfg -- ) drop ; - -: perform-renaming ( cfg -- ) drop ; - : remove-phis-from-block ( bb -- ) instructions>> [ ##phi? not ] filter-here ; @@ -38,5 +35,5 @@ IN: compiler.cfg.coalescing dup process-blocks break-interferences dup insert-copies - dup perform-renaming + 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 c0a3ed8923..7293bcc802 100644 --- a/basis/compiler/cfg/coalescing/copies/copies.factor +++ b/basis/compiler/cfg/coalescing/copies/copies.factor @@ -1,8 +1,39 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: ; +USING: accessors assocs combinators fry kernel namespaces sequences +compiler.cfg.def-use compiler.cfg.dominance compiler.cfg.instructions +compiler.cfg.renaming ; IN: compiler.cfg.coalescing.copies -: schedule-copies ( bb -- ) drop ; +SYMBOLS: stacks visited pushed ; -: insert-copies ( cfg -- ) drop ; +: 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 ; + +: insert-copies ( cfg -- ) + entry>> (insert-copies) ; \ No newline at end of file diff --git a/basis/compiler/cfg/coalescing/forest/forest.factor b/basis/compiler/cfg/coalescing/forest/forest.factor index f1f8334975..fa0aa6e6d3 100644 --- a/basis/compiler/cfg/coalescing/forest/forest.factor +++ b/basis/compiler/cfg/coalescing/forest/forest.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs fry kernel math math.order namespaces sequences sorting vectors compiler.cfg.def-use -compiler.cfg.dominance ; +compiler.cfg.dominance compiler.cfg.registers ; IN: compiler.cfg.coalescing.forest TUPLE: dom-forest-node vreg bb children ; diff --git a/basis/compiler/cfg/coalescing/interference/interference.factor b/basis/compiler/cfg/coalescing/interference/interference.factor index 36dea6f0a0..9fdf06bcb4 100644 --- a/basis/compiler/cfg/coalescing/interference/interference.factor +++ b/basis/compiler/cfg/coalescing/interference/interference.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators combinators.short-circuit -kernel math namespaces sequences compiler.cfg.def-use -compiler.cfg.liveness ; +kernel math namespaces sequences locals compiler.cfg.def-use +compiler.cfg.liveness compiler.cfg.dominance ; IN: compiler.cfg.coalescing.interference ! Local interference testing. Requires live-out information @@ -27,30 +27,30 @@ SYMBOLS: def-index kill-index ; ! If first register is killed after second one is defined, they interfere [ kill-index get at ] [ def-index get at ] bi* >= ; -: interferes-same-block? ( vreg1 vreg2 -- ? ) +: interferes-same-block? ( vreg1 vreg2 bb1 bb2 -- ? ) ! If both are defined in the same basic block, they interfere if their ! local live ranges intersect. + drop compute-local-live-ranges { [ kill-after-def? ] [ swap kill-after-def? ] } 2|| ; -: interferes-first-dominates? ( vreg1 vreg2 -- ? ) +: interferes-first-dominates? ( vreg1 vreg2 bb1 bb2 -- ? ) ! If vreg1 dominates vreg2, then they interfere if vreg2's definition ! occurs before vreg1 is killed. + nip compute-local-live-ranges kill-after-def? ; -: interferes-second-dominates? ( vreg1 vreg2 -- ? ) +: interferes-second-dominates? ( vreg1 vreg2 bb1 bb2 -- ? ) ! If vreg2 dominates vreg1, then they interfere if vreg1's definition ! occurs before vreg2 is killed. + drop compute-local-live-ranges swap kill-after-def? ; PRIVATE> -SYMBOLS: +same-block+ +first-dominates+ +second-dominates+ ; - -: interferes? ( vreg1 vreg2 bb mode -- ? ) - ! local interference test - mode is one of the above symbols - [ compute-local-live-ranges ] dip - { - { +same-block+ [ interferes-same-block? ] } - { +first-dominates+ [ interferes-first-dominates? ] } - { +second-dominates+ [ interferes-second-dominates? ] } - } case ; \ No newline at end of file +: interferes? ( vreg1 vreg2 -- ? ) + 2dup [ def-of ] bi@ { + { [ 2dup eq? ] [ interferes-same-block? ] } + { [ 2dup dominates? ] [ interferes-first-dominates? ] } + { [ 2dup swap dominates? ] [ interferes-second-dominates? ] } + [ 2drop 2drop f ] + } cond ; diff --git a/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor b/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor index 6e73bb5e2f..005c71f357 100644 --- a/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor +++ b/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor @@ -12,6 +12,11 @@ compiler.cfg.coalescing.forest compiler.cfg.coalescing.interference ; IN: compiler.cfg.coalescing.process-blocks +! phi-union maps a vreg to the predecessor block +! that carries it to the phi node's block + +! unioned-blocks is a set of bb's which defined +! the source vregs above SYMBOLS: phi-union unioned-blocks ; :: operand-live-into-phi-node's-block? ( bb src dst -- ? ) @@ -46,7 +51,7 @@ SYMBOLS: phi-union unioned-blocks ; src used-by-another get push ; :: add-to-renaming-set ( bb src dst -- ) - src phi-union get conjoin + bb src phi-union get set-at src def-of unioned-blocks get conjoin ; : process-phi-operand ( bb src dst -- ) @@ -101,12 +106,22 @@ SYMBOLS: visited work-list ; dup children>> [ process-df-child ] with with map [ ] any? [ work-list get pop-back* ] unless ; +: process-df-nodes ( ##phi work-list -- ) + dup deque-empty? [ 2drop ] [ + [ peek-back process-df-node ] + [ process-df-nodes ] + 2bi + ] if ; + : process-phi-union ( ##phi dom-forest -- ) H{ } clone visited set [ push-all-front ] keep - [ work-list set ] [ [ process-df-node ] with slurp-deque ] bi ; + [ work-list set ] [ process-df-nodes ] bi ; :: add-local-interferences ( bb ##phi -- ) + ! bb contains the phi node. If the input is defined in the same + ! block as the phi node, we have to check for interference. + ! This can only happen if the value is carried by a back edge. phi-union get [ drop dup def-of bb eq? [ ##phi dst>> 2array , ] [ drop ] if @@ -114,7 +129,7 @@ SYMBOLS: visited work-list ; : compute-local-interferences ( bb ##phi -- pairs ) [ - [ phi-union get compute-dom-forest process-phi-union drop ] + [ phi-union get keys compute-dom-forest process-phi-union drop ] [ add-local-interferences ] 2bi ] { } make ; @@ -124,25 +139,10 @@ SYMBOLS: visited work-list ; src src' eq? [ bb src ##phi dst>> insert-copy ] when ] assoc-each ; -:: same-block ( ##phi vreg1 vreg2 bb1 bb2 -- ) - vreg1 vreg2 bb1 +same-block+ interferes? - [ ##phi vreg1 insert-copies-for-interference ] when ; - -:: first-dominates ( ##phi vreg1 vreg2 bb1 bb2 -- ) - vreg1 vreg2 bb2 +first-dominates+ interferes? - [ ##phi vreg1 insert-copies-for-interference ] when ; - -:: second-dominates ( ##phi vreg1 vreg2 bb1 bb2 -- ) - vreg1 vreg2 bb1 +second-dominates+ interferes? - [ ##phi vreg1 insert-copies-for-interference ] when ; - : process-local-interferences ( ##phi pairs -- ) [ - first2 2dup [ def-of ] bi@ { - { [ 2dup eq? ] [ same-block ] } - { [ 2dup dominates? ] [ first-dominates ] } - [ second-dominates ] - } cond + first2 2dup interferes? + [ drop insert-copies-for-interference ] [ 3drop ] if ] with each ; : add-renaming-set ( ##phi -- ) @@ -150,11 +150,12 @@ SYMBOLS: visited work-list ; phi-union get [ drop processed-name ] assoc-each ; :: process-phi ( bb ##phi -- ) - H{ } phi-union set - H{ } unioned-blocks set + H{ } clone phi-union set + H{ } clone unioned-blocks set ##phi inputs>> ##phi dst>> '[ _ process-phi-operand ] assoc-each ##phi bb ##phi compute-local-interferences process-local-interferences ##phi add-renaming-set ; : process-block ( bb -- ) - dup [ dup ##phi? [ process-phi t ] [ 2drop f ] if ] with all? drop ; + dup instructions>> + [ dup ##phi? [ process-phi t ] [ 2drop f ] if ] with all? drop ; diff --git a/basis/compiler/cfg/coalescing/renaming/renaming.factor b/basis/compiler/cfg/coalescing/renaming/renaming.factor new file mode 100644 index 0000000000..3b26c09738 --- /dev/null +++ b/basis/compiler/cfg/coalescing/renaming/renaming.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel ; +IN: compiler.cfg.coalescing.renaming + +: perform-renaming ( -- ) + renaming-sets get [ + ! XXX + 2drop + ] assoc-each ; diff --git a/basis/compiler/cfg/coalescing/state/state.factor b/basis/compiler/cfg/coalescing/state/state.factor index b2c2f59e45..6174945ccb 100644 --- a/basis/compiler/cfg/coalescing/state/state.factor +++ b/basis/compiler/cfg/coalescing/state/state.factor @@ -6,6 +6,7 @@ IN: compiler.cfg.coalescing.state SYMBOLS: processed-names waiting used-by-another renaming-sets ; : init-coalescing ( -- ) + H{ } clone renaming-sets set H{ } clone processed-names set H{ } clone waiting set V{ } clone used-by-another set ; diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index 6a73b349de..6eeeacd6f1 100644 --- a/basis/compiler/cfg/dominance/dominance.factor +++ b/basis/compiler/cfg/dominance/dominance.factor @@ -118,10 +118,14 @@ PRIVATE> SYMBOLS: preorder maxpreorder ; +PRIVATE> + : pre-of ( bb -- n ) [ preorder get at ] [ -1/0. ] if* ; : maxpre-of ( bb -- n ) [ maxpreorder get at ] [ 1/0. ] if* ; + ] bi* [ - [ uses-vregs [ over conjoin ] each ] + [ dup ##phi? [ drop ] [ uses-vregs [ over conjoin ] each ] if ] [ defs-vregs [ over delete-at ] each ] bi ] each ; : local-live-in ( instructions -- live-set ) - [ ##phi? not ] filter [ H{ } ] dip transfer-liveness keys ; + [ H{ } ] dip transfer-liveness keys ; M: live-analysis transfer-set drop instructions>> transfer-liveness ; diff --git a/basis/compiler/cfg/liveness/ssa/ssa.factor b/basis/compiler/cfg/liveness/ssa/ssa.factor new file mode 100644 index 0000000000..9fa22d22b1 --- /dev/null +++ b/basis/compiler/cfg/liveness/ssa/ssa.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces deques accessors sets sequences assocs fry +hashtables dlists compiler.cfg.def-use compiler.cfg.instructions +compiler.cfg.rpo compiler.cfg.liveness ; +IN: compiler.cfg.liveness.ssa + +! TODO: merge with compiler.cfg.liveness + +! Assoc mapping basic blocks to sequences of sets of vregs; each sequence +! is in conrrespondence with a predecessor +SYMBOL: phi-live-ins + +: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ; + +SYMBOL: work-list + +: add-to-work-list ( basic-blocks -- ) + work-list get '[ _ push-front ] each ; + +: compute-live-in ( basic-block -- live-in ) + [ live-out ] keep instructions>> transfer-liveness ; + +: compute-phi-live-in ( basic-block -- phi-live-in ) + instructions>> [ ##phi? ] filter [ f ] [ + H{ } clone [ + '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each + ] keep + ] if-empty ; + +: update-live-in ( basic-block -- changed? ) + [ [ compute-live-in ] keep live-ins get maybe-set-at ] + [ [ compute-phi-live-in ] keep phi-live-ins get maybe-set-at ] + bi and ; + +: compute-live-out ( basic-block -- live-out ) + [ successors>> [ live-in ] map ] + [ dup successors>> [ phi-live-in ] with map ] bi + append assoc-combine ; + +: update-live-out ( basic-block -- changed? ) + [ compute-live-out ] keep + live-outs get maybe-set-at ; + +: liveness-step ( basic-block -- ) + dup update-live-out [ + dup update-live-in + [ predecessors>> add-to-work-list ] [ drop ] if + ] [ drop ] if ; + +: compute-ssa-live-sets ( cfg -- cfg' ) + work-list set + H{ } clone live-ins set + H{ } clone phi-live-ins set + H{ } clone live-outs set + dup post-order add-to-work-list + work-list get [ liveness-step ] slurp-deque ;