compiler.cfg.dcn: Implement height tracking
parent
605b37a949
commit
0a95ddd105
|
@ -23,18 +23,20 @@ compiler.cfg.dcn.rewrite ;
|
|||
T{ ##copy f V int-regs 1 V int-regs 0 }
|
||||
T{ ##copy f V int-regs 3 V int-regs 2 }
|
||||
T{ ##copy f V int-regs 5 V int-regs 4 }
|
||||
T{ ##inc-d f -1 }
|
||||
}
|
||||
] [
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##peek f V int-regs 2 D 1 }
|
||||
T{ ##peek f V int-regs 3 D 1 }
|
||||
T{ ##replace f V int-regs 2 D 1 }
|
||||
T{ ##replace f V int-regs 4 D 2 }
|
||||
T{ ##peek f V int-regs 5 D 2 }
|
||||
T{ ##replace f V int-regs 5 D 2 }
|
||||
T{ ##replace f V int-regs 6 D 0 }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek f V int-regs 2 D 0 }
|
||||
T{ ##peek f V int-regs 3 D 0 }
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##replace f V int-regs 4 D 1 }
|
||||
T{ ##peek f V int-regs 5 D 1 }
|
||||
T{ ##replace f V int-regs 5 D 1 }
|
||||
T{ ##replace f V int-regs 6 D -1 }
|
||||
} test-local-dcn
|
||||
] unit-test
|
||||
|
||||
|
@ -79,8 +81,9 @@ V{
|
|||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##replace f V int-regs 1 D 1 }
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
T{ ##replace f V int-regs 1 D 2 }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
|
@ -117,12 +120,36 @@ V{
|
|||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
} 2 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 1vector >>successors drop
|
||||
|
||||
[ ] [ 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
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
|
@ -134,7 +161,8 @@ V{
|
|||
V{
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##peek f V int-regs 2 D 1 }
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace f V int-regs 2 D 1 }
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
||||
|
@ -180,17 +208,19 @@ V{
|
|||
|
||||
V{
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 2 D 1 }
|
||||
T{ ##peek f V int-regs 4 D 2 }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek f V int-regs 4 D 1 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 3 D 1 }
|
||||
T{ ##replace f V int-regs 3 D 0 }
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
||||
|
@ -229,16 +259,17 @@ V{
|
|||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##call f drop }
|
||||
T{ ##call f drop -1 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
|
@ -257,16 +288,16 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ t ] [ D 0 2 get avail-out key? ] unit-test
|
||||
[ f ] [ D 0 3 get peek-out key? ] unit-test
|
||||
[ f ] [ D 0 3 get avail-out key? ] unit-test
|
||||
[ f ] [ D 0 4 get avail-in key? ] unit-test
|
||||
[ t ] [ D 1 2 get avail-out key? ] unit-test
|
||||
[ f ] [ D 1 3 get peek-out key? ] unit-test
|
||||
[ f ] [ D 1 3 get avail-out key? ] unit-test
|
||||
[ f ] [ D 1 4 get avail-in key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks ] 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 0 } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
[ { D 1 } ] [ 3 get 4 get inserting-peeks ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
|
@ -2,17 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs deques dlists fry kernel namespaces sequences
|
||||
combinators combinators.short-circuit compiler.cfg.instructions
|
||||
compiler.cfg.dcn.local compiler.cfg.rpo compiler.cfg ;
|
||||
compiler.cfg.dcn.local compiler.cfg.rpo compiler.cfg.utilities
|
||||
compiler.cfg ;
|
||||
IN: compiler.cfg.dcn.global
|
||||
|
||||
<PRIVATE
|
||||
|
||||
PREDICATE: kill-block < basic-block
|
||||
instructions>> {
|
||||
[ length 2 = ]
|
||||
[ first kill-vreg-insn? ]
|
||||
} 1&& ;
|
||||
|
||||
: assoc-refine ( seq -- assoc )
|
||||
[ f ] [ [ ] [ assoc-intersect ] map-reduce ] if-empty ;
|
||||
|
||||
|
|
|
@ -19,7 +19,7 @@ M: ##inc-d ds-height-change n>> ;
|
|||
|
||||
M: ##call ds-height-change height>> ;
|
||||
|
||||
: alien-node-height ( node -- )
|
||||
: alien-node-height ( node -- n )
|
||||
params>> [ out-d>> length ] [ in-d>> length ] bi - ;
|
||||
|
||||
M: ##alien-invoke ds-height-change alien-node-height ;
|
||||
|
@ -67,13 +67,13 @@ PRIVATE>
|
|||
|
||||
GENERIC# translate-in-loc 1 ( loc bb -- loc' )
|
||||
|
||||
M: ds-loc translate-in-loc n>> in-ds-heights get at + <ds-loc> ;
|
||||
M: rs-loc translate-in-loc n>> in-rs-heights get at + <ds-loc> ;
|
||||
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 + <ds-loc> ;
|
||||
M: rs-loc translate-out-loc n>> out-rs-heights get at + <ds-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 ;
|
||||
|
|
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel make
|
||||
namespaces sequences
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.instructions ;
|
||||
USING: accessors assocs kernel make namespaces sequences math
|
||||
compiler.cfg.rpo compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.dcn.height ;
|
||||
IN: compiler.cfg.dcn.local
|
||||
|
||||
<PRIVATE
|
||||
|
@ -20,15 +19,29 @@ SYMBOLS: reads-locations writes-locations ;
|
|||
dup writes-locations get at
|
||||
[ ] [ reads-locations get at ] ?if ;
|
||||
|
||||
SYMBOL: ds-height
|
||||
|
||||
SYMBOL: rs-height
|
||||
|
||||
GENERIC: translate-loc ( loc -- loc' )
|
||||
|
||||
M: ds-loc translate-loc n>> ds-height get - <ds-loc> ;
|
||||
|
||||
M: rs-loc translate-loc n>> rs-height get - <rs-loc> ;
|
||||
|
||||
GENERIC: visit ( insn -- )
|
||||
|
||||
M: insn visit , ;
|
||||
|
||||
M: ##inc-d visit n>> ds-height [ + ] change ;
|
||||
|
||||
M: ##inc-r visit n>> rs-height [ + ] change ;
|
||||
|
||||
M: ##peek visit
|
||||
! If location is in a register already, copy existing
|
||||
! register to destination. Otherwise, associate the
|
||||
! location with the register.
|
||||
[ dst>> ] [ loc>> ] bi dup loc>vreg
|
||||
[ dst>> ] [ loc>> translate-loc ] bi dup loc>vreg
|
||||
[ [ record-copy ] [ ##copy ] 2bi ]
|
||||
[ reads-locations get set-at ]
|
||||
?if ;
|
||||
|
@ -36,7 +49,7 @@ M: ##peek visit
|
|||
M: ##replace visit
|
||||
! If location already contains the same value, do nothing.
|
||||
! Otherwise, associate the location with the register.
|
||||
[ src>> resolve-copy ] [ loc>> ] bi 2dup loc>vreg =
|
||||
[ src>> resolve-copy ] [ loc>> translate-loc ] bi 2dup loc>vreg =
|
||||
[ 2drop ] [ writes-locations get set-at ] if ;
|
||||
|
||||
M: ##copy visit
|
||||
|
@ -44,22 +57,33 @@ M: ##copy visit
|
|||
! on input to dcn pass, but in the future it might.
|
||||
[ dst>> ] [ src>> resolve-copy ] bi record-copy ;
|
||||
|
||||
: insert-height-changes ( -- )
|
||||
ds-height get dup 0 = [ drop ] [ ##inc-d ] if
|
||||
rs-height get dup 0 = [ drop ] [ ##inc-r ] if ;
|
||||
|
||||
: local-analysis ( bb -- )
|
||||
! Removes all ##peek and ##replace from the basic block.
|
||||
! Conceptually, moves all ##peeks to the start
|
||||
! (reads-locations assoc) and all ##replaces to the end
|
||||
! (writes-locations assoc).
|
||||
0 ds-height set
|
||||
0 rs-height set
|
||||
H{ } clone copies set
|
||||
H{ } clone reads-locations set
|
||||
H{ } clone writes-locations set
|
||||
[ [ [ visit ] each ] V{ } make ] change-instructions drop ;
|
||||
[
|
||||
[
|
||||
[ visit ] each
|
||||
insert-height-changes
|
||||
] V{ } make
|
||||
] change-instructions drop ;
|
||||
|
||||
SYMBOLS: peeks replaces ;
|
||||
|
||||
: visit-block ( bb -- )
|
||||
[ local-analysis ]
|
||||
[ [ reads-locations get ] dip peeks get set-at ]
|
||||
[ [ writes-locations get ] dip replaces get set-at ]
|
||||
[ [ reads-locations get ] dip [ translate-in-set ] keep peeks get set-at ]
|
||||
[ [ writes-locations get ] dip [ translate-in-set ] keep replaces get set-at ]
|
||||
tri ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
@ -51,6 +51,12 @@ IN: compiler.cfg.utilities
|
|||
begin-basic-block
|
||||
basic-block get '[ [ _ swap successors>> push ] when* ] each ;
|
||||
|
||||
PREDICATE: kill-block < basic-block
|
||||
instructions>> {
|
||||
[ length 2 = ]
|
||||
[ first kill-vreg-insn? ]
|
||||
} 1&& ;
|
||||
|
||||
: back-edge? ( from to -- ? )
|
||||
[ number>> ] bi@ >= ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue