compiler.cfg.coalescing: cleanups

db4
Slava Pestov 2009-07-28 08:47:03 -05:00
parent cf26800dbd
commit 3edf4a2b75
2 changed files with 34 additions and 50 deletions

View File

@ -4,10 +4,17 @@ USING: accessors assocs hashtables fry kernel make namespaces
sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ; sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ;
IN: compiler.cfg.coalescing.copies IN: compiler.cfg.coalescing.copies
ERROR: bad-copy ;
: compute-copies ( assoc -- assoc' ) : compute-copies ( assoc -- assoc' )
dup assoc-size <hashtable> [ dup assoc-size <hashtable> [
'[ '[
[ 2dup eq? [ 2drop ] [ _ 2dup key? [ "OOPS" throw ] [ set-at ] if ] if ] with each [
2dup eq? [ 2drop ] [
_ 2dup key?
[ bad-copy ] [ set-at ] if
] if
] with each
] assoc-each ] assoc-each
] keep ; ] keep ;

View File

@ -1,8 +1,7 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry kernel locals math math.order arrays USING: accessors assocs fry kernel locals math math.order arrays
namespaces sequences sorting sets combinators combinators.short-circuit namespaces sequences sorting sets combinators combinators.short-circuit make
dlists deques make
compiler.cfg.def-use compiler.cfg.def-use
compiler.cfg.instructions compiler.cfg.instructions
compiler.cfg.liveness compiler.cfg.liveness
@ -61,8 +60,6 @@ SYMBOLS: phi-union unioned-blocks ;
[ add-to-renaming-set ] [ add-to-renaming-set ]
} cond ; } cond ;
SYMBOLS: visited work-list ;
: node-is-live-in-of-child? ( node child -- ? ) : node-is-live-in-of-child? ( node child -- ? )
[ vreg>> ] [ bb>> live-in ] bi* key? ; [ vreg>> ] [ bb>> live-in ] bi* key? ;
@ -86,52 +83,31 @@ SYMBOLS: visited work-list ;
: add-interference ( ##phi node child -- ) : add-interference ( ##phi node child -- )
[ vreg>> ] bi@ 2array , drop ; [ vreg>> ] bi@ 2array , drop ;
: add-to-work-list ( child -- inserted? ) : process-df-child ( ##phi node child -- )
dup visited get key? [ drop f ] [ work-list get push-back t ] if ; {
{ [ 2dup node-is-live-out-of-child? ] [ insert-copies-for-parent ] }
: process-df-child ( ##phi node child -- inserted? ) { [ 2dup node-is-live-in-of-child? ] [ add-interference ] }
[ { [ 2dup defined-in-same-block? ] [ add-interference ] }
{ [ 3drop ]
{ [ 2dup node-is-live-out-of-child? ] [ insert-copies-for-parent ] } } cond ;
{ [ 2dup node-is-live-in-of-child? ] [ add-interference ] }
{ [ 2dup defined-in-same-block? ] [ add-interference ] }
[ 3drop ]
} cond
]
[ add-to-work-list ]
bi ;
: process-df-node ( ##phi node -- ) : process-df-node ( ##phi node -- )
dup visited get conjoin dup children>>
dup children>> [ process-df-child ] with with map [ [ process-df-child ] with with each ]
[ ] any? [ work-list get pop-back* ] unless ; [ nip [ process-df-node ] with each ]
3bi ;
: 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 -- ) : process-phi-union ( ##phi dom-forest -- )
H{ } clone visited set [ process-df-node ] with each ;
<dlist> [ push-all-front ] keep
[ work-list set ] [ process-df-nodes ] bi ;
:: add-local-interferences ( bb ##phi -- ) : add-local-interferences ( ##phi -- )
! bb contains the phi node. If the input is defined in the same [ phi-union get ] dip dst>> '[ drop _ 2array , ] assoc-each ;
! 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
] assoc-each ;
: compute-local-interferences ( bb ##phi -- pairs ) : compute-local-interferences ( ##phi -- pairs )
[ [
[ phi-union get keys compute-dom-forest process-phi-union drop ] [ phi-union get keys compute-dom-forest process-phi-union ]
[ add-local-interferences ] [ add-local-interferences ]
2bi bi
] { } make ; ] { } make ;
:: insert-copies-for-interference ( ##phi src -- ) :: insert-copies-for-interference ( ##phi src -- )
@ -146,16 +122,17 @@ SYMBOLS: visited work-list ;
] with each ; ] with each ;
: add-renaming-set ( ##phi -- ) : add-renaming-set ( ##phi -- )
dst>> phi-union get swap renaming-sets get set-at [ phi-union get ] dip dst>> renaming-sets get set-at
phi-union get [ drop processed-name ] assoc-each ; phi-union get [ drop processed-name ] assoc-each ;
:: process-phi ( bb ##phi -- ) : process-phi ( ##phi -- )
H{ } clone phi-union set H{ } clone phi-union set
H{ } clone unioned-blocks set H{ } clone unioned-blocks set
##phi inputs>> ##phi dst>> '[ _ process-phi-operand ] assoc-each [ [ inputs>> ] [ dst>> ] bi '[ _ process-phi-operand ] assoc-each ]
##phi bb ##phi compute-local-interferences process-local-interferences [ dup compute-local-interferences process-local-interferences ]
##phi add-renaming-set ; [ add-renaming-set ]
tri ;
: process-block ( bb -- ) : process-block ( bb -- )
dup instructions>> instructions>>
[ dup ##phi? [ process-phi t ] [ 2drop f ] if ] with all? drop ; [ dup ##phi? [ process-phi t ] [ drop f ] if ] all? drop ;