compiler.cfg.coalescing: work in progress
Slava Pestov
parent
e9935b6aad
commit
a5e5510615
|
|
@ -0,0 +1,42 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors assocs fry kernel locals math math.order
|
||||||
|
sequences
|
||||||
|
compiler.cfg.rpo
|
||||||
|
compiler.cfg.instructions
|
||||||
|
compiler.cfg.dominance
|
||||||
|
compiler.cfg.coalescing.state
|
||||||
|
compiler.cfg.coalescing.forest
|
||||||
|
compiler.cfg.coalescing.process-blocks ;
|
||||||
|
IN: compiler.cfg.coalescing
|
||||||
|
|
||||||
|
! Fast Copy Coalescing and Live-Range Identification
|
||||||
|
! http://www.cs.ucsd.edu/classes/sp02/cse231/kenpldi.pdf
|
||||||
|
|
||||||
|
! Dominance, liveness and def-use need to be computed
|
||||||
|
|
||||||
|
: 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 ;
|
||||||
|
|
||||||
|
: remove-phis ( cfg -- )
|
||||||
|
[ [ remove-phis-from-block ] if-has-phis ] each-basic-block ;
|
||||||
|
|
||||||
|
: coalesce ( cfg -- cfg' )
|
||||||
|
init-coalescing
|
||||||
|
dup compute-dfs
|
||||||
|
dup process-blocks
|
||||||
|
break-interferences
|
||||||
|
dup insert-copies
|
||||||
|
dup perform-renaming
|
||||||
|
dup remove-phis ;
|
||||||
|
|
@ -0,0 +1,8 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: ;
|
||||||
|
IN: compiler.cfg.coalescing.copies
|
||||||
|
|
||||||
|
: schedule-copies ( bb -- ) drop ;
|
||||||
|
|
||||||
|
: insert-copies ( cfg -- ) drop ;
|
||||||
|
|
@ -0,0 +1,87 @@
|
||||||
|
USING: accessors compiler.cfg compiler.cfg.coalescing.forest
|
||||||
|
compiler.cfg.debugger compiler.cfg.dominance compiler.cfg.instructions
|
||||||
|
compiler.cfg.predecessors compiler.cfg.registers compiler.cfg.def-use
|
||||||
|
cpu.architecture kernel namespaces sequences tools.test vectors sorting
|
||||||
|
math.order ;
|
||||||
|
IN: compiler.cfg.coalescing.forest.tests
|
||||||
|
|
||||||
|
V{ T{ ##peek f V int-regs 0 D 0 } } clone 0 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 1 D 0 } } clone 1 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 2 D 0 } } clone 2 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 3 D 0 } } clone 3 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 4 D 0 } } clone 4 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 5 D 0 } } clone 5 test-bb
|
||||||
|
V{ T{ ##peek f V int-regs 6 D 0 } } clone 6 test-bb
|
||||||
|
|
||||||
|
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||||
|
2 get 3 get 4 get V{ } 2sequence >>successors drop
|
||||||
|
3 get 5 get 1vector >>successors drop
|
||||||
|
4 get 5 get 1vector >>successors drop
|
||||||
|
1 get 6 get 1vector >>successors drop
|
||||||
|
5 get 6 get 1vector >>successors drop
|
||||||
|
|
||||||
|
: clean-up-forest ( forest -- forest' )
|
||||||
|
[ [ vreg>> n>> ] compare ] sort
|
||||||
|
[
|
||||||
|
[ clean-up-forest ] change-children
|
||||||
|
[ number>> ] change-bb
|
||||||
|
] V{ } map-as ;
|
||||||
|
|
||||||
|
: test-dom-forest ( vregs -- forest )
|
||||||
|
cfg new 0 get >>entry
|
||||||
|
compute-predecessors
|
||||||
|
dup compute-dominance
|
||||||
|
dup compute-def-use
|
||||||
|
compute-dfs
|
||||||
|
compute-dom-forest
|
||||||
|
clean-up-forest ;
|
||||||
|
|
||||||
|
[ V{ } ] [ { } test-dom-forest ] unit-test
|
||||||
|
|
||||||
|
[ V{ T{ dom-forest-node f V int-regs 0 0 V{ } } } ]
|
||||||
|
[ { V int-regs 0 } test-dom-forest ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
V{
|
||||||
|
T{ dom-forest-node
|
||||||
|
f
|
||||||
|
V int-regs 0
|
||||||
|
0
|
||||||
|
V{ T{ dom-forest-node f V int-regs 1 1 V{ } } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
[ { V int-regs 0 V int-regs 1 } test-dom-forest ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
V{
|
||||||
|
T{ dom-forest-node
|
||||||
|
f
|
||||||
|
V int-regs 1
|
||||||
|
1
|
||||||
|
V{ }
|
||||||
|
}
|
||||||
|
T{ dom-forest-node
|
||||||
|
f
|
||||||
|
V int-regs 2
|
||||||
|
2
|
||||||
|
V{
|
||||||
|
T{ dom-forest-node f V int-regs 3 3 V{ } }
|
||||||
|
T{ dom-forest-node f V int-regs 4 4 V{ } }
|
||||||
|
T{ dom-forest-node f V int-regs 5 5 V{ } }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
T{ dom-forest-node
|
||||||
|
f
|
||||||
|
V int-regs 6
|
||||||
|
6
|
||||||
|
V{ }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
[
|
||||||
|
{ V int-regs 1 V int-regs 6 V int-regs 2 V int-regs 3 V int-regs 4 V int-regs 5 }
|
||||||
|
test-dom-forest
|
||||||
|
] unit-test
|
||||||
|
|
@ -0,0 +1,39 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! 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 ;
|
||||||
|
IN: compiler.cfg.coalescing.forest
|
||||||
|
|
||||||
|
TUPLE: dom-forest-node vreg bb children ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: sort-vregs-by-bb ( vregs -- alist )
|
||||||
|
defs-1 get
|
||||||
|
'[ dup _ at ] { } map>assoc
|
||||||
|
[ [ second pre-of ] compare ] sort ;
|
||||||
|
|
||||||
|
: <dom-forest-node> ( vreg bb parent -- node )
|
||||||
|
[ V{ } clone dom-forest-node boa dup ] dip children>> push ;
|
||||||
|
|
||||||
|
: <virtual-root> ( -- node )
|
||||||
|
f f V{ } clone dom-forest-node boa ;
|
||||||
|
|
||||||
|
: find-parent ( pre stack -- parent )
|
||||||
|
2dup last vreg>> def-of maxpre-of > [
|
||||||
|
dup pop* find-parent
|
||||||
|
] [ nip last ] if ;
|
||||||
|
|
||||||
|
: (compute-dom-forest) ( vreg bb stack -- )
|
||||||
|
[ dup pre-of ] dip [ find-parent <dom-forest-node> ] keep push ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: compute-dom-forest ( vregs -- forest )
|
||||||
|
! compute-dfs must be called on the CFG first
|
||||||
|
<virtual-root> [
|
||||||
|
1vector
|
||||||
|
[ sort-vregs-by-bb ] dip
|
||||||
|
'[ _ (compute-dom-forest) ] assoc-each
|
||||||
|
] keep children>> ;
|
||||||
|
|
@ -0,0 +1,56 @@
|
||||||
|
! 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 ;
|
||||||
|
IN: compiler.cfg.coalescing.interference
|
||||||
|
|
||||||
|
! Local interference testing. Requires live-out information
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
SYMBOLS: def-index kill-index ;
|
||||||
|
|
||||||
|
: compute-local-live-ranges ( bb -- )
|
||||||
|
H{ } clone def-index set
|
||||||
|
H{ } clone kill-index set
|
||||||
|
[
|
||||||
|
instructions>> [
|
||||||
|
[ swap defs-vregs [ def-index get set-at ] with each ]
|
||||||
|
[ swap uses-vregs [ kill-index get set-at ] with each ]
|
||||||
|
2bi
|
||||||
|
] each-index
|
||||||
|
]
|
||||||
|
[ live-out keys [ [ 1/0. ] dip kill-index get set-at ] each ]
|
||||||
|
bi ;
|
||||||
|
|
||||||
|
: kill-after-def? ( vreg1 vreg2 -- ? )
|
||||||
|
! 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 -- ? )
|
||||||
|
! If both are defined in the same basic block, they interfere if their
|
||||||
|
! local live ranges intersect.
|
||||||
|
{ [ kill-after-def? ] [ swap kill-after-def? ] } 2|| ;
|
||||||
|
|
||||||
|
: interferes-first-dominates? ( vreg1 vreg2 -- ? )
|
||||||
|
! If vreg1 dominates vreg2, then they interfere if vreg2's definition
|
||||||
|
! occurs before vreg1 is killed.
|
||||||
|
kill-after-def? ;
|
||||||
|
|
||||||
|
: interferes-second-dominates? ( vreg1 vreg2 -- ? )
|
||||||
|
! If vreg2 dominates vreg1, then they interfere if vreg1's definition
|
||||||
|
! occurs before vreg2 is killed.
|
||||||
|
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 ;
|
||||||
|
|
@ -0,0 +1,160 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors assocs fry kernel locals math math.order arrays
|
||||||
|
namespaces sequences sorting sets combinators combinators.short-circuit
|
||||||
|
dlists deques make
|
||||||
|
compiler.cfg.def-use
|
||||||
|
compiler.cfg.instructions
|
||||||
|
compiler.cfg.liveness
|
||||||
|
compiler.cfg.dominance
|
||||||
|
compiler.cfg.coalescing.state
|
||||||
|
compiler.cfg.coalescing.forest
|
||||||
|
compiler.cfg.coalescing.interference ;
|
||||||
|
IN: compiler.cfg.coalescing.process-blocks
|
||||||
|
|
||||||
|
SYMBOLS: phi-union unioned-blocks ;
|
||||||
|
|
||||||
|
:: operand-live-into-phi-node's-block? ( bb src dst -- ? )
|
||||||
|
src bb live-in key? ;
|
||||||
|
|
||||||
|
:: phi-node-is-live-out-of-operand's-block? ( bb src dst -- ? )
|
||||||
|
dst src def-of live-out key? ;
|
||||||
|
|
||||||
|
:: operand-is-phi-node-and-live-into-operand's-block? ( bb src dst -- ? )
|
||||||
|
{ [ src insn-of ##phi? ] [ src src def-of live-in key? ] } 0&& ;
|
||||||
|
|
||||||
|
:: operand-being-renamed? ( bb src dst -- ? )
|
||||||
|
src processed-names get key? ;
|
||||||
|
|
||||||
|
:: two-operands-in-same-block? ( bb src dst -- ? )
|
||||||
|
src def-of unioned-blocks get key? ;
|
||||||
|
|
||||||
|
: trivial-interference? ( bb src dst -- ? )
|
||||||
|
{
|
||||||
|
[ operand-live-into-phi-node's-block? ]
|
||||||
|
[ phi-node-is-live-out-of-operand's-block? ]
|
||||||
|
[ operand-is-phi-node-and-live-into-operand's-block? ]
|
||||||
|
[ operand-being-renamed? ]
|
||||||
|
[ two-operands-in-same-block? ]
|
||||||
|
} 3|| ;
|
||||||
|
|
||||||
|
: don't-coalesce ( bb src dst -- )
|
||||||
|
2nip processed-name ;
|
||||||
|
|
||||||
|
:: trivial-interference ( bb src dst -- )
|
||||||
|
dst src bb waiting-for push-at
|
||||||
|
src used-by-another get push ;
|
||||||
|
|
||||||
|
:: add-to-renaming-set ( bb src dst -- )
|
||||||
|
src phi-union get conjoin
|
||||||
|
src def-of unioned-blocks get conjoin ;
|
||||||
|
|
||||||
|
: process-phi-operand ( bb src dst -- )
|
||||||
|
{
|
||||||
|
{ [ 2dup eq? ] [ don't-coalesce ] }
|
||||||
|
{ [ 3dup trivial-interference? ] [ trivial-interference ] }
|
||||||
|
[ add-to-renaming-set ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
SYMBOLS: visited work-list ;
|
||||||
|
|
||||||
|
: node-is-live-in-of-child? ( node child -- ? )
|
||||||
|
[ vreg>> ] [ bb>> live-in ] bi* key? ;
|
||||||
|
|
||||||
|
: node-is-live-out-of-child? ( node child -- ? )
|
||||||
|
[ vreg>> ] [ bb>> live-out ] bi* key? ;
|
||||||
|
|
||||||
|
:: insert-copy ( bb src dst -- )
|
||||||
|
bb src dst trivial-interference
|
||||||
|
src phi-union get delete-at ;
|
||||||
|
|
||||||
|
:: insert-copy-for-parent ( bb src node dst -- )
|
||||||
|
src node vreg>> eq? [ bb src dst insert-copy ] when ;
|
||||||
|
|
||||||
|
: insert-copies-for-parent ( ##phi node child -- )
|
||||||
|
drop
|
||||||
|
[ [ inputs>> ] [ dst>> ] bi ] dip
|
||||||
|
'[ _ _ insert-copy-for-parent ] assoc-each ;
|
||||||
|
|
||||||
|
: defined-in-same-block? ( node child -- ? ) [ bb>> ] bi@ eq? ;
|
||||||
|
|
||||||
|
: add-interference ( ##phi node child -- )
|
||||||
|
[ vreg>> ] bi@ 2array , drop ;
|
||||||
|
|
||||||
|
: add-to-work-list ( child -- inserted? )
|
||||||
|
dup visited get key? [ drop f ] [ work-list get push-back t ] if ;
|
||||||
|
|
||||||
|
: process-df-child ( ##phi node child -- inserted? )
|
||||||
|
[
|
||||||
|
{
|
||||||
|
{ [ 2dup node-is-live-out-of-child? ] [ insert-copies-for-parent ] }
|
||||||
|
{ [ 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 -- )
|
||||||
|
dup visited get conjoin
|
||||||
|
dup children>> [ process-df-child ] with with map
|
||||||
|
[ ] any? [ work-list get pop-back* ] unless ;
|
||||||
|
|
||||||
|
: 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 ;
|
||||||
|
|
||||||
|
:: add-local-interferences ( bb ##phi -- )
|
||||||
|
phi-union get [
|
||||||
|
drop dup def-of bb eq?
|
||||||
|
[ ##phi dst>> 2array , ] [ drop ] if
|
||||||
|
] assoc-each ;
|
||||||
|
|
||||||
|
: compute-local-interferences ( bb ##phi -- pairs )
|
||||||
|
[
|
||||||
|
[ phi-union get compute-dom-forest process-phi-union drop ]
|
||||||
|
[ add-local-interferences ]
|
||||||
|
2bi
|
||||||
|
] { } make ;
|
||||||
|
|
||||||
|
:: insert-copies-for-interference ( ##phi src -- )
|
||||||
|
##phi inputs>> [| bb src' |
|
||||||
|
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
|
||||||
|
] with each ;
|
||||||
|
|
||||||
|
: add-renaming-set ( ##phi -- )
|
||||||
|
dst>> phi-union get swap renaming-sets get set-at
|
||||||
|
phi-union get [ drop processed-name ] assoc-each ;
|
||||||
|
|
||||||
|
:: process-phi ( bb ##phi -- )
|
||||||
|
H{ } phi-union set
|
||||||
|
H{ } 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 ;
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: namespaces sets kernel assocs ;
|
||||||
|
IN: compiler.cfg.coalescing.state
|
||||||
|
|
||||||
|
SYMBOLS: processed-names waiting used-by-another renaming-sets ;
|
||||||
|
|
||||||
|
: init-coalescing ( -- )
|
||||||
|
H{ } clone processed-names set
|
||||||
|
H{ } clone waiting set
|
||||||
|
V{ } clone used-by-another set ;
|
||||||
|
|
||||||
|
: processed-name ( vreg -- ) processed-names get conjoin ;
|
||||||
|
|
||||||
|
: waiting-for ( bb -- assoc ) waiting get [ drop H{ } clone ] cache ;
|
||||||
Loading…
Reference in New Issue