diff --git a/basis/compiler/cfg/coalescing/coalescing.factor b/basis/compiler/cfg/coalescing/coalescing.factor index 5deb375572..86dee8a3be 100644 --- a/basis/compiler/cfg/coalescing/coalescing.factor +++ b/basis/compiler/cfg/coalescing/coalescing.factor @@ -1,17 +1,17 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs fry kernel locals math math.order -sequences namespaces sets make +sequences namespaces sets compiler.cfg.rpo compiler.cfg.def-use compiler.cfg.utilities compiler.cfg.dominance compiler.cfg.instructions compiler.cfg.liveness.ssa -compiler.cfg.parallel-copy compiler.cfg.critical-edges compiler.cfg.coalescing.state compiler.cfg.coalescing.forest +compiler.cfg.coalescing.copies compiler.cfg.coalescing.renaming compiler.cfg.coalescing.live-ranges compiler.cfg.coalescing.process-blocks ; @@ -29,7 +29,7 @@ SYMBOL: seen :: visit-renaming ( dst assoc src bb -- ) src seen get key? [ - dst src bb waiting-for set-at + src dst bb waiting-for push-at src assoc delete-at ] [ src seen get conjoin ] if ; @@ -41,15 +41,6 @@ SYMBOL: seen ] assoc-each ] assoc-each ; -: insert-copies ( -- ) - waiting get [ - [ instructions>> building ] dip '[ - building get pop - _ parallel-copy - , - ] with-variable - ] assoc-each ; - : remove-phis-from-block ( bb -- ) instructions>> [ ##phi? not ] filter-here ; diff --git a/basis/compiler/cfg/coalescing/copies/copies.factor b/basis/compiler/cfg/coalescing/copies/copies.factor new file mode 100644 index 0000000000..5df2684f72 --- /dev/null +++ b/basis/compiler/cfg/coalescing/copies/copies.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs hashtables fry kernel make namespaces +sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ; +IN: compiler.cfg.coalescing.copies + +: compute-copies ( assoc -- assoc' ) + dup assoc-size [ + '[ + [ 2dup eq? [ 2drop ] [ _ 2dup key? [ "OOPS" throw ] [ set-at ] if ] if ] with each + ] assoc-each + ] keep ; + +: insert-copies ( -- ) + 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/process-blocks/process-blocks.factor b/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor index cc7b923105..005c71f357 100644 --- a/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor +++ b/basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor @@ -47,7 +47,7 @@ SYMBOLS: phi-union unioned-blocks ; 2nip processed-name ; :: trivial-interference ( bb src dst -- ) - src dst bb waiting-for set-at + dst src bb waiting-for push-at src used-by-another get push ; :: add-to-renaming-set ( bb src dst -- ) @@ -118,21 +118,20 @@ SYMBOLS: visited work-list ; [ push-all-front ] keep [ work-list set ] [ process-df-nodes ] bi ; -: add-local-interferences ( ##phi -- ) +:: 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. - - ! XXX: in the LLVM version they only add an interference if - ! the operand is defined in the same block as the ##phi, but - ! this doesn't work here. Investigate - [ phi-union get ] dip dst>> '[ drop _ 2array , ] assoc-each ; + phi-union get [ + drop dup def-of bb eq? + [ ##phi dst>> 2array , ] [ drop ] if + ] assoc-each ; -: compute-local-interferences ( ##phi -- pairs ) +: compute-local-interferences ( bb ##phi -- pairs ) [ - [ phi-union get keys compute-dom-forest process-phi-union ] + [ phi-union get keys compute-dom-forest process-phi-union drop ] [ add-local-interferences ] - bi + 2bi ] { } make ; :: insert-copies-for-interference ( ##phi src -- ) @@ -150,14 +149,13 @@ SYMBOLS: visited work-list ; dst>> phi-union get swap renaming-sets get set-at phi-union get [ drop processed-name ] assoc-each ; -: process-phi ( ##phi -- ) +:: process-phi ( bb ##phi -- ) H{ } clone phi-union set H{ } clone unioned-blocks set - [ [ inputs>> ] [ dst>> ] bi '[ _ process-phi-operand ] assoc-each ] - [ dup compute-local-interferences process-local-interferences ] - [ add-renaming-set ] - tri ; + ##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 -- ) - instructions>> - [ dup ##phi? [ process-phi t ] [ drop f ] if ] 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 index 15062d17c4..848d0a4df0 100644 --- a/basis/compiler/cfg/coalescing/renaming/renaming.factor +++ b/basis/compiler/cfg/coalescing/renaming/renaming.factor @@ -37,7 +37,7 @@ IN: compiler.cfg.coalescing.renaming : rename-copies ( -- ) waiting renamings get '[ [ - [ [ _ ?at drop ] bi@ ] assoc-map + [ _ [ ?at drop ] [ '[ _ ?at drop ] map ] bi-curry bi* ] assoc-map ] assoc-map ] change ;