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