steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.coalescing: more work done

db4
Slava Pestov 2009-07-27 00:31:21 -05:00
parent 501629cf75
commit a32cbdd231
10 changed files with 155 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/compiler/cfg/coalescing/coalescing.factor
View File

@ -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 ;

37
basis/compiler/cfg/coalescing/copies/copies.factor
View File

@ -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) ;

2
basis/compiler/cfg/coalescing/forest/forest.factor
View File

@ -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 ;

30
basis/compiler/cfg/coalescing/interference/interference.factor
View File

@ -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 ;
: 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 ;

47
basis/compiler/cfg/coalescing/process-blocks/process-blocks.factor
View File

@ -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
<dlist> [ 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 ;

10
basis/compiler/cfg/coalescing/renaming/renaming.factor Normal file
View File

@ -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 ;

1
basis/compiler/cfg/coalescing/state/state.factor
View File

@ -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 ;

4
basis/compiler/cfg/dominance/dominance.factor
View File

@ -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* ;
<PRIVATE
: (compute-dfs) ( n bb -- n )
[ 1 + ] dip
[ dupd preorder get set-at ]

6
basis/compiler/cfg/liveness/liveness.factor
View File

@ -10,14 +10,16 @@ IN: compiler.cfg.liveness
BACKWARD-ANALYSIS: live
GENERIC: insn-liveness ( live-set insn -- )
: transfer-liveness ( live-set instructions -- live-set' )
[ clone ] [ <reversed> ] 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 ;

57
basis/compiler/cfg/liveness/ssa/ssa.factor Normal file
View File

@ -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' )
<hashed-dlist> 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 ;