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
: 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 ;
dup process-blocks
break-interferences
dup insert-copies
- dup perform-renaming
+ perform-renaming
dup remove-phis ;
\ No newline at end of file
! 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
! 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 ;
! 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
! 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 ;
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 -- ? )
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 -- )
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
: 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 ;
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 -- )
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 ;
--- /dev/null
+! 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 ;
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 ;
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 ]
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 ;
--- /dev/null
+! 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 ;
projects / factor.git / commitdiff