steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.dcn: Implement height tracking

db4
Slava Pestov 2009-07-19 19:45:23 -05:00
parent 605b37a949
commit 0a95ddd105
5 changed files with 98 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
basis/compiler/cfg/dcn/dcn-tests.factor
View File

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

9
basis/compiler/cfg/dcn/global/global.factor
View File

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

10
basis/compiler/cfg/dcn/height/height.factor
View File

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

42
basis/compiler/cfg/dcn/local/local.factor
View File

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

6
basis/compiler/cfg/utilities/utilities.factor
View File

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