compiler.cfg.dcn: flesh out rewrite pass
Slava Pestov
parent
fdef772d67
commit
e16acae2f5
basis/compiler/cfg/dcn
|
|
@ -108,13 +108,13 @@ V{
|
|||
|
||||
[ f ] [ D 0 0 get avail-out key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
|
||||
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces keys ] unit-test
|
||||
|
||||
[ { D 1 } ] [ 1 get 2 get inserting-replaces ] unit-test
|
||||
[ { D 2 } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -136,8 +136,8 @@ V{
|
|||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ t ] [ D 1 2 get peek-in key? ] unit-test
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -179,16 +179,21 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
|
||||
[ { D 1 } ] [ 2 get 4 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 4 get 5 get inserting-replaces ] unit-test
|
||||
[ f ] [ D 0 1 get avail-out key? ] unit-test
|
||||
[ f ] [ D 1 1 get avail-out key? ] unit-test
|
||||
[ t ] [ D 0 4 get peek-in key? ] unit-test
|
||||
[ t ] [ D 1 4 get peek-in key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces keys ] unit-test
|
||||
[ { D 1 } ] [ 1 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks keys ] unit-test
|
||||
[ { D 1 } ] [ 4 get 5 get inserting-replaces keys ] unit-test
|
||||
|
||||
[ t ] [ D 0 1 get peek-out key? ] unit-test
|
||||
[ f ] [ D 1 1 get peek-out key? ] unit-test
|
||||
|
|
@ -243,16 +248,16 @@ V{
|
|||
[ t ] [ D 1 2 get peek-in key? ] unit-test
|
||||
[ f ] [ D 1 3 get peek-in key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces ] unit-test
|
||||
[ { D 1 } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
|
||||
[ { D 2 } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-replaces ] unit-test
|
||||
[ { D 1 } ] [ 4 get 5 get inserting-replaces ] unit-test
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces keys ] unit-test
|
||||
[ { D 1 } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
[ { D 2 } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { D 0 } ] [ 4 get 5 get inserting-replaces keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -294,11 +299,11 @@ V{
|
|||
[ f ] [ D 1 3 get avail-out key? ] unit-test
|
||||
[ f ] [ D 1 4 get avail-in key? ] unit-test
|
||||
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 1 } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { D 0 } ] [ 3 get 4 get inserting-peeks keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -322,10 +327,10 @@ V{ T{ ##branch } } 3 test-bb
|
|||
|
||||
[ t ] [ D 0 1 get avail-out key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 3 get 1 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 3 get 1 get inserting-peeks keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -369,13 +374,13 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 0 get 1 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 2 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 5 get 6 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { D 0 } ] [ 2 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { D 0 } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 5 get 6 get inserting-peeks keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -414,13 +419,87 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 1 get 2 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces ] unit-test
|
||||
[ { D 0 } ] [ 1 get 3 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 0 } ] [ 2 get 4 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-replaces ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
[ { D 0 } ] [ 1 get 3 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 3 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { D 0 } ] [ 2 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-replaces keys ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 5 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 3 get V{ } 2sequence >>successors drop
|
||||
2 get 4 get 1vector >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
4 get 5 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 2 get 4 get inserting-replaces keys ] unit-test
|
||||
|
||||
[ { } ] [ 3 get 4 get inserting-replaces keys ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 4 get 5 get inserting-replaces keys ] unit-test
|
||||
|
||||
! Dead replace elimination
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##replace f V int-regs 0 D 1 }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d f -2 }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 3 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 1vector >>successors drop
|
||||
2 get 3 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 0 get 1 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 2 get 3 get inserting-replaces keys ] unit-test
|
||||
|
|
@ -1,6 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ;
|
||||
USING: combinators
|
||||
compiler.cfg
|
||||
compiler.cfg.dcn.height
|
||||
compiler.cfg.dcn.local
|
||||
compiler.cfg.dcn.global
|
||||
compiler.cfg.dcn.rewrite ;
|
||||
IN: compiler.cfg.dcn
|
||||
|
||||
! "DeConcatenatizatioN" -- dataflow analysis to recover registers
|
||||
|
|
@ -27,4 +32,13 @@ IN: compiler.cfg.dcn
|
|||
! On every edge [pred --> b], insert a peek for each location in
|
||||
! P_in(b) - (P_out(pred) \/ A_out(pred))
|
||||
|
||||
! Locations are height-normalized.
|
||||
! Locations are height-normalized.
|
||||
|
||||
: deconcatenatize ( cfg -- cfg' )
|
||||
{
|
||||
[ compute-heights ]
|
||||
[ compute-local-sets ]
|
||||
[ compute-global-sets ]
|
||||
[ rewrite ]
|
||||
[ cfg-changed ]
|
||||
} cleave ;
|
||||
|
|
@ -53,6 +53,16 @@ M: ##inc-r rs-height-change n>> ;
|
|||
: compute-rs-height ( bb -- )
|
||||
in-rs-heights out-rs-heights [ rs-height-change ] compute-height ;
|
||||
|
||||
GENERIC# translate-loc 1 ( loc bb -- loc' )
|
||||
|
||||
M: ds-loc translate-loc [ n>> ] [ in-ds-heights get at ] bi* - <ds-loc> ;
|
||||
M: rs-loc translate-loc [ n>> ] [ in-rs-heights get at ] bi* - <ds-loc> ;
|
||||
|
||||
GENERIC# untranslate-loc 1 ( loc bb -- loc' )
|
||||
|
||||
M: ds-loc untranslate-loc [ n>> ] [ in-ds-heights get at ] bi* + <ds-loc> ;
|
||||
M: rs-loc untranslate-loc [ n>> ] [ in-rs-heights get at ] bi* + <ds-loc> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: compute-heights ( cfg -- )
|
||||
|
|
@ -65,18 +75,8 @@ PRIVATE>
|
|||
[ compute-ds-height ] bi
|
||||
] each-basic-block ;
|
||||
|
||||
GENERIC# translate-in-loc 1 ( loc bb -- loc' )
|
||||
: translate-locs ( assoc bb -- assoc' )
|
||||
'[ [ _ translate-loc ] dip ] assoc-map ;
|
||||
|
||||
M: ds-loc translate-in-loc [ n>> ] [ in-ds-heights get at ] bi* - <ds-loc> ;
|
||||
M: rs-loc translate-in-loc [ n>> ] [ in-rs-heights get at ] bi* - <ds-loc> ;
|
||||
|
||||
GENERIC# translate-out-loc 1 ( loc bb -- loc' )
|
||||
|
||||
M: ds-loc translate-out-loc [ n>> ] [ out-ds-heights get at ] bi* + <ds-loc> ;
|
||||
M: rs-loc translate-out-loc [ n>> ] [ out-rs-heights get at ] bi* + <ds-loc> ;
|
||||
|
||||
: translate-in-set ( assoc bb -- assoc' )
|
||||
'[ [ _ translate-in-loc ] dip ] assoc-map ;
|
||||
|
||||
: translate-out-set ( assoc bb -- assoc' )
|
||||
'[ [ _ translate-out-loc ] dip ] assoc-map ;
|
||||
: untranslate-locs ( assoc bb -- assoc' )
|
||||
'[ [ _ untranslate-loc ] dip ] assoc-map ;
|
||||
|
|
|
|||
|
|
@ -82,8 +82,8 @@ SYMBOLS: peeks replaces ;
|
|||
|
||||
: visit-block ( bb -- )
|
||||
[ local-analysis ]
|
||||
[ [ reads-locations get ] dip [ translate-in-set ] keep peeks get set-at ]
|
||||
[ [ writes-locations get ] dip [ translate-in-set ] keep replaces get set-at ]
|
||||
[ [ reads-locations get ] dip [ translate-locs ] keep peeks get set-at ]
|
||||
[ [ writes-locations get ] dip [ translate-locs ] keep replaces get set-at ]
|
||||
tri ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
|||
|
|
@ -1,10 +1,67 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces assocs kernel compiler.cfg.dcn.global ;
|
||||
USING: namespaces assocs kernel fry accessors sequences make math
|
||||
combinators compiler.cfg compiler.cfg.hats compiler.cfg.instructions
|
||||
compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.dcn.local
|
||||
compiler.cfg.dcn.global compiler.cfg.dcn.height ;
|
||||
IN: compiler.cfg.dcn.rewrite
|
||||
|
||||
: inserting-peeks ( from to -- seq )
|
||||
peek-in swap [ peek-out ] [ avail-out ] bi assoc-union assoc-diff keys ;
|
||||
! This pass inserts peeks, replaces, and copies. All stack locations
|
||||
! are loaded to canonical vregs, with a 1-1 mapping from location to
|
||||
! vreg. SSA is reconstructed afterwards.
|
||||
|
||||
: inserting-replaces ( from to -- seq )
|
||||
[ replace-out ] [ kill-in ] bi* assoc-diff keys ;
|
||||
: inserting-peeks ( from to -- assoc )
|
||||
[
|
||||
peek-in swap [ peek-out ] [ avail-out ] bi
|
||||
assoc-union assoc-diff
|
||||
] keep untranslate-locs ;
|
||||
|
||||
: inserting-replaces ( from to -- assoc )
|
||||
[
|
||||
[ replace-out ] [ [ kill-in ] [ replace-in ] bi ] bi*
|
||||
assoc-union assoc-diff
|
||||
] keep
|
||||
untranslate-locs
|
||||
[ drop n>> 0 >= ] assoc-filter ;
|
||||
|
||||
SYMBOL: locs>vregs
|
||||
|
||||
: loc>vreg ( loc -- vreg ) locs>vregs get [ drop i ] cache ;
|
||||
|
||||
: each-insertion ( assoc quot: ( vreg loc -- ) -- )
|
||||
'[ drop [ loc>vreg ] keep @ ] assoc-each ; inline
|
||||
|
||||
: visit-edge ( from to -- )
|
||||
2dup [
|
||||
[ inserting-peeks [ ##peek ] each-insertion ]
|
||||
[ inserting-replaces [ ##replace ] each-insertion ] 2bi
|
||||
] V{ } make
|
||||
[ 2drop ] [ <simple-block> insert-basic-block ] if-empty ;
|
||||
|
||||
: visit-edges ( bb -- )
|
||||
[ predecessors>> ] keep '[ _ visit-edge ] each ;
|
||||
|
||||
: insert-in-copies ( bb -- )
|
||||
peek [ swap loc>vreg ##copy ] assoc-each ;
|
||||
|
||||
: insert-out-copies ( bb -- )
|
||||
replace [ swap loc>vreg swap ##copy ] assoc-each ;
|
||||
|
||||
: rewrite-instructions ( bb -- )
|
||||
[
|
||||
[
|
||||
{
|
||||
[ insert-in-copies ]
|
||||
[ instructions>> but-last-slice % ]
|
||||
[ insert-out-copies ]
|
||||
[ instructions>> last , ]
|
||||
} cleave
|
||||
] V{ } make
|
||||
] keep (>>instructions) ;
|
||||
|
||||
: visit-block ( bb -- )
|
||||
[ visit-edges ] [ rewrite-instructions ] bi ;
|
||||
|
||||
: rewrite ( cfg -- )
|
||||
H{ } clone locs>vregs set
|
||||
[ visit-block ] each-basic-block ;
|
||||
Loading…
Reference in New Issue