! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry kernel locals math math.order
-sequences
+sequences namespaces sets
compiler.cfg.rpo
+compiler.cfg.def-use
compiler.cfg.utilities
compiler.cfg.dominance
compiler.cfg.instructions
: process-blocks ( cfg -- )
[ [ process-block ] if-has-phis ] each-basic-block ;
-: break-interferences ( -- ) ;
+SYMBOL: seen
+
+:: visit-renaming ( dst assoc src bb -- )
+ src seen get key? [
+ src dst bb waiting-for push-at
+ src assoc delete-at
+ ] [ src seen get conjoin ] if ;
+
+:: break-interferences ( -- )
+ V{ } clone seen set
+ renaming-sets get [| dst assoc |
+ assoc [| src bb |
+ src seen get key?
+ [ dst assoc src bb visit-renaming ]
+ [ src seen get conjoin ]
+ if
+ ] assoc-each
+ ] assoc-each ;
: remove-phis-from-block ( bb -- )
instructions>> [ ##phi? not ] filter-here ;
: coalesce ( cfg -- cfg' )
init-coalescing
+ dup compute-def-use
+ dup compute-dominance
dup compute-dfs
dup process-blocks
break-interferences
dup insert-copies
- perform-renaming
+ dup 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: accessors assocs combinators fry kernel namespaces sequences
-compiler.cfg.def-use compiler.cfg.dominance compiler.cfg.instructions
-compiler.cfg.renaming ;
+USING: accessors assocs hashtables fry kernel make namespaces
+sequences compiler.cfg.coalescing.state compiler.cfg.parallel-copy ;
IN: compiler.cfg.coalescing.copies
-SYMBOLS: stacks visited pushed ;
-
-: 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 ;
+: compute-copies ( assoc -- assoc' )
+ dup assoc-size <hashtable> [
+ '[
+ [ _ set-at ] with each
+ ] assoc-each
+ ] keep ;
: insert-copies ( cfg -- )
- entry>> (insert-copies) ;
\ No newline at end of file
+ waiting get [
+ [ instructions>> building ] dip '[
+ building get pop
+ _ compute-copies parallel-copy
+ ,
+ ] with-variable
+ ] assoc-each ;
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel ;
+USING: accessors assocs fry kernel namespaces sequences
+compiler.cfg.coalescing.state compiler.cfg.renaming compiler.cfg.rpo
+disjoint-sets ;
IN: compiler.cfg.coalescing.renaming
-: perform-renaming ( -- )
- renaming-sets get [
- ! XXX
- 2drop
- ] assoc-each ;
+: update-congruence-class ( dst assoc disjoint-set -- )
+ [ keys swap ] dip
+ [ nip add-atoms ]
+ [ add-atom drop ]
+ [ equate-all-with ] 3tri ;
+
+: build-congruence-classes ( -- disjoint-set )
+ renaming-sets get
+ <disjoint-set> [
+ '[
+ _ update-congruence-class
+ ] assoc-each
+ ] keep ;
+
+: compute-renaming ( disjoint-set -- assoc )
+ [ parents>> ] keep
+ '[ drop dup _ representative ] assoc-map ;
+
+: perform-renaming ( cfg -- )
+ build-congruence-classes compute-renaming renamings set
+ [
+ instructions>> [
+ [ rename-insn-defs ]
+ [ rename-insn-uses ] bi
+ ] each
+ ] each-basic-block ;
[ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
dom-childrens set ;
-! Maps bb -> DF(bb)
-SYMBOL: dom-frontiers
-
PRIVATE>
-: dom-frontier ( bb -- set ) dom-frontiers get at keys ;
+: compute-dominance ( cfg -- )
+ compute-dom-parents compute-dom-children ;
<PRIVATE
+! Maps bb -> DF(bb)
+SYMBOL: dom-frontiers
+
: compute-dom-frontier ( bb pred -- )
2dup [ dom-parent ] dip eq? [ 2drop ] [
[ dom-frontiers get conjoin-at ]
[ dom-parent compute-dom-frontier ] 2bi
] if ;
+PRIVATE>
+
+: dom-frontier ( bb -- set ) dom-frontiers get at keys ;
+
: compute-dom-frontiers ( cfg -- )
H{ } clone dom-frontiers set
[
] [ 2drop ] if
] each-basic-block ;
-PRIVATE>
-
-: compute-dominance ( cfg -- )
- [ compute-dom-parents compute-dom-children ]
- [ compute-dom-frontiers ]
- bi ;
-
<PRIVATE
SYMBOLS: work-list visited ;
compiler.cfg.copy-prop
compiler.cfg.dce
compiler.cfg.write-barrier
-compiler.cfg.phi-elimination
+compiler.cfg.coalescing
compiler.cfg.empty-blocks
compiler.cfg.predecessors
compiler.cfg.rpo
optimize-tail-calls
delete-useless-conditionals
compute-predecessors
- split-branches
+ ! split-branches
join-blocks
compute-predecessors
construct-ssa
copy-propagation
eliminate-dead-code
eliminate-write-barriers
- eliminate-phis
+ coalesce
delete-empty-blocks
?check
] with-scope ;
[ ]
[ compute-live-sets ]
[ compute-dominance ]
+ [ compute-dom-frontiers ]
[ compute-defs compute-phi-nodes insert-phi-nodes ]
[ rename ]
} cleave ;
\ No newline at end of file
: representative? ( a disjoint-set -- ? )
dupd parent = ; inline
+PRIVATE>
+
GENERIC: representative ( a disjoint-set -- p )
M: disjoint-set representative
[ [ parent ] keep representative dup ] 2keep set-parent
] if ;
+<PRIVATE
+
: representatives ( a b disjoint-set -- r r )
[ representative ] curry bi@ ; inline