compiler.cfg.dcn: flesh out rewrite pass

db4
Slava Pestov 2009-07-21 01:24:19 -05:00
parent fdef772d67
commit e16acae2f5
5 changed files with 225 additions and 75 deletions

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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>

View File

@ -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 ;