compiler.cfg.dcn: Fixing various bugs, hook up with optimizer
Slava Pestov
parent
cfb584ed8d
commit
e49de006c4
|
|
@ -1,12 +1,14 @@
|
|||
IN: compiler.cfg.dcn.tests
|
||||
USING: tools.test kernel accessors namespaces assocs
|
||||
cpu.architecture vectors sequences
|
||||
USING: tools.test kernel accessors namespaces assocs math
|
||||
cpu.architecture vectors sequences classes
|
||||
compiler.cfg
|
||||
compiler.cfg.utilities
|
||||
compiler.cfg.debugger
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.predecessors
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.checker
|
||||
compiler.cfg.dcn
|
||||
compiler.cfg.dcn.height
|
||||
compiler.cfg.dcn.local
|
||||
compiler.cfg.dcn.local.private
|
||||
|
|
@ -19,12 +21,19 @@ compiler.cfg.dcn.rewrite ;
|
|||
[ local-analysis ] keep
|
||||
instructions>> ;
|
||||
|
||||
: inserting-peeks' ( from to -- assoc )
|
||||
[ inserting-peeks ] keep untranslate-locs keys ;
|
||||
|
||||
: inserting-replaces' ( from to -- assoc )
|
||||
[ inserting-replaces ] keep untranslate-locs remove-dead-stores keys ;
|
||||
|
||||
[
|
||||
V{
|
||||
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 }
|
||||
T{ ##branch }
|
||||
}
|
||||
] [
|
||||
V{
|
||||
|
|
@ -38,6 +47,7 @@ compiler.cfg.dcn.rewrite ;
|
|||
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 }
|
||||
T{ ##branch }
|
||||
} test-local-dcn
|
||||
] unit-test
|
||||
|
||||
|
|
@ -68,11 +78,10 @@ compiler.cfg.dcn.rewrite ;
|
|||
: test-global-dcn ( -- )
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
[ compute-heights ]
|
||||
[ compute-local-sets ]
|
||||
[ compute-global-sets ] tri ;
|
||||
deconcatenatize
|
||||
check-cfg ;
|
||||
|
||||
V{ T{ ##return } } 0 test-bb
|
||||
V{ T{ ##epilogue } T{ ##return } } 0 test-bb
|
||||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
|
|
@ -84,7 +93,9 @@ V{
|
|||
V{
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
T{ ##load-immediate f V int-regs 1 100 }
|
||||
T{ ##replace f V int-regs 1 D 2 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
|
|
@ -108,13 +119,13 @@ V{
|
|||
|
||||
[ f ] [ D 0 0 get avail-out key? ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { D 0 } ] [ 0 get 1 get inserting-peeks' ] unit-test
|
||||
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
|
||||
|
||||
[ { } ] [ 0 get 1 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
|
||||
|
||||
[ { D 2 } ] [ 1 get 2 get inserting-replaces keys ] unit-test
|
||||
[ { D 2 } ] [ 1 get 2 get inserting-replaces' ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -123,21 +134,29 @@ V{
|
|||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 1 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##branch }
|
||||
} 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
|
||||
|
||||
[ t ] [ D 1 2 get peek-in key? ] unit-test
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks keys ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks keys ] unit-test
|
||||
[ { D 1 } ] [ 0 get 1 get inserting-peeks' ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-peeks' ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -184,16 +203,16 @@ V{
|
|||
[ 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
|
||||
[ { 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 } ] [ 1 get 4 get inserting-peeks' ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces' ] unit-test
|
||||
[ { } ] [ 4 get 5 get inserting-peeks' ] unit-test
|
||||
[ { D 1 } ] [ 4 get 5 get inserting-replaces' ] unit-test
|
||||
|
||||
[ t ] [ D 0 1 get peek-out key? ] unit-test
|
||||
[ f ] [ D 1 1 get peek-out key? ] unit-test
|
||||
|
|
@ -219,6 +238,7 @@ V{
|
|||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 2 100 }
|
||||
T{ ##replace f V int-regs 2 D 1 }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##peek f V int-regs 4 D 1 }
|
||||
|
|
@ -226,6 +246,7 @@ V{
|
|||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 3 100 }
|
||||
T{ ##replace f V int-regs 3 D 0 }
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
|
@ -248,16 +269,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 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
|
||||
[ { 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 0 } ] [ 4 get 5 get inserting-replaces' ] unit-test
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -281,9 +302,14 @@ V{
|
|||
|
||||
V{
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##return }
|
||||
T{ ##branch }
|
||||
} 4 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 5 test-bb
|
||||
|
||||
[ t ] [ 0 get kill-block? ] unit-test
|
||||
[ t ] [ 3 get kill-block? ] unit-test
|
||||
|
||||
|
|
@ -291,6 +317,7 @@ V{
|
|||
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
|
||||
|
||||
|
|
@ -299,11 +326,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 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
|
||||
[ { 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
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -315,7 +342,7 @@ V{
|
|||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{ T{ ##return } } 2 test-bb
|
||||
V{ T{ ##epilogue } T{ ##return } } 2 test-bb
|
||||
|
||||
V{ T{ ##branch } } 3 test-bb
|
||||
|
||||
|
|
@ -327,10 +354,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 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
|
||||
[ { 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
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -374,13 +401,13 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] 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
|
||||
[ { } ] [ 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
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -392,6 +419,7 @@ V{
|
|||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 1 100 }
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
|
@ -419,16 +447,16 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] 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
|
||||
[ { } ] [ 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
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
|
|
@ -440,11 +468,13 @@ V{
|
|||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 1 100 }
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate f V int-regs 2 100 }
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
|
@ -466,11 +496,11 @@ V{
|
|||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 2 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 2 get 4 get inserting-replaces' ] unit-test
|
||||
|
||||
[ { } ] [ 3 get 4 get inserting-replaces keys ] unit-test
|
||||
[ { } ] [ 3 get 4 get inserting-replaces' ] unit-test
|
||||
|
||||
[ { D 0 } ] [ 4 get 5 get inserting-replaces keys ] unit-test
|
||||
[ { D 0 } ] [ 4 get 5 get inserting-replaces' ] unit-test
|
||||
|
||||
! Dead replace elimination
|
||||
V{
|
||||
|
|
@ -483,10 +513,12 @@ V{
|
|||
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 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d f -2 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
|
|
@ -500,6 +532,90 @@ V{
|
|||
|
||||
[ ] [ 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
|
||||
[ { } ] [ 0 get 1 get inserting-replaces' ] unit-test
|
||||
[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
|
||||
[ { } ] [ 2 get 3 get inserting-replaces' ] unit-test
|
||||
|
||||
! More dead replace elimination tests
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek { dst V int-regs 10 } { loc D 0 } }
|
||||
T{ ##inc-d { n -1 } }
|
||||
T{ ##inc-r { n 1 } }
|
||||
T{ ##replace { src V int-regs 10 } { loc R 0 } }
|
||||
T{ ##peek { dst V int-regs 12 } { loc R 0 } }
|
||||
T{ ##inc-r { n -1 } }
|
||||
T{ ##inc-d { n 1 } }
|
||||
T{ ##replace { src V int-regs 12 } { loc D 0 } }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ { } ] [ 1 get 2 get inserting-replaces' ] unit-test
|
||||
|
||||
! Check that retain stack usage works
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##inc-d f -1 }
|
||||
T{ ##inc-r f 1 }
|
||||
T{ ##replace f V int-regs 0 R 0 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##call f + -1 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 R 0 }
|
||||
T{ ##inc-r f -1 }
|
||||
T{ ##inc-d f 1 }
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 4 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 1vector >>successors drop
|
||||
2 get 3 get 1vector >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
|
||||
[ ] [ test-global-dcn ] unit-test
|
||||
|
||||
[ ##replace D 0 ] [
|
||||
3 get successors>> first instructions>> first
|
||||
[ class ] [ loc>> ] bi
|
||||
] unit-test
|
||||
|
||||
[ ##replace R 0 ] [
|
||||
1 get successors>> first instructions>> first
|
||||
[ class ] [ loc>> ] bi
|
||||
] unit-test
|
||||
|
||||
[ ##peek R 0 ] [
|
||||
2 get successors>> first instructions>> first
|
||||
[ class ] [ loc>> ] bi
|
||||
] unit-test
|
||||
|
|
@ -53,16 +53,6 @@ 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 -- )
|
||||
|
|
@ -75,8 +65,18 @@ PRIVATE>
|
|||
[ compute-ds-height ] bi
|
||||
] each-basic-block ;
|
||||
|
||||
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* - <rs-loc> ;
|
||||
|
||||
: translate-locs ( assoc bb -- assoc' )
|
||||
'[ [ _ translate-loc ] dip ] assoc-map ;
|
||||
|
||||
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* + <rs-loc> ;
|
||||
|
||||
: untranslate-locs ( assoc bb -- assoc' )
|
||||
'[ [ _ untranslate-loc ] dip ] assoc-map ;
|
||||
|
|
|
|||
|
|
@ -61,20 +61,24 @@ M: ##copy visit
|
|||
ds-height get dup 0 = [ drop ] [ ##inc-d ] if
|
||||
rs-height get dup 0 = [ drop ] [ ##inc-r ] if ;
|
||||
|
||||
: init-local-analysis ( -- )
|
||||
0 ds-height set
|
||||
0 rs-height set
|
||||
H{ } clone copies set
|
||||
H{ } clone reads-locations set
|
||||
H{ } clone writes-locations set ;
|
||||
|
||||
: 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
|
||||
init-local-analysis
|
||||
[
|
||||
[
|
||||
[ visit ] each
|
||||
unclip-last-slice [ [ visit ] each ] dip
|
||||
insert-height-changes
|
||||
,
|
||||
] V{ } make
|
||||
] change-instructions drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -11,32 +11,35 @@ IN: compiler.cfg.dcn.rewrite
|
|||
! vreg. SSA is reconstructed afterwards.
|
||||
|
||||
: inserting-peeks ( from to -- assoc )
|
||||
[
|
||||
peek-in swap [ peek-out ] [ avail-out ] bi
|
||||
assoc-union assoc-diff
|
||||
] keep untranslate-locs ;
|
||||
peek-in swap [ peek-out ] [ avail-out ] bi
|
||||
assoc-union assoc-diff ;
|
||||
|
||||
: remove-dead-stores ( assoc -- assoc' )
|
||||
[ drop n>> 0 >= ] assoc-filter ;
|
||||
|
||||
: inserting-replaces ( from to -- assoc )
|
||||
[
|
||||
[ replace-out ] [ [ kill-in ] [ replace-in ] bi ] bi*
|
||||
assoc-union assoc-diff
|
||||
] keep untranslate-locs remove-dead-stores ;
|
||||
[ replace-out ] [ [ kill-in ] [ replace-in ] bi ] bi*
|
||||
assoc-union assoc-diff ;
|
||||
|
||||
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
|
||||
: each-insertion ( assoc bb quot: ( vreg loc -- ) -- )
|
||||
'[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
|
||||
|
||||
ERROR: bad-peek dst loc ;
|
||||
|
||||
: insert-peeks ( from to -- )
|
||||
[ inserting-peeks ] keep
|
||||
[ dup n>> 0 < [ bad-peek ] [ ##peek ] if ] each-insertion ;
|
||||
|
||||
: insert-replaces ( from to -- )
|
||||
[ inserting-replaces ] keep
|
||||
[ dup n>> 0 < [ 2drop ] [ ##replace ] if ] each-insertion ;
|
||||
|
||||
: visit-edge ( from to -- )
|
||||
2dup [
|
||||
[ inserting-peeks [ ##peek ] each-insertion ]
|
||||
[ inserting-replaces [ ##replace ] each-insertion ] 2bi
|
||||
] V{ } make
|
||||
2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
|
||||
[ 2drop ] [ <simple-block> insert-basic-block ] if-empty ;
|
||||
|
||||
: visit-edges ( bb -- )
|
||||
|
|
|
|||
|
|
@ -5,6 +5,9 @@ compiler.cfg.tco
|
|||
compiler.cfg.predecessors
|
||||
compiler.cfg.useless-conditionals
|
||||
compiler.cfg.stack-analysis
|
||||
compiler.cfg.dcn
|
||||
compiler.cfg.dominance
|
||||
compiler.cfg.ssa
|
||||
compiler.cfg.branch-splitting
|
||||
compiler.cfg.block-joining
|
||||
compiler.cfg.alias-analysis
|
||||
|
|
@ -24,17 +27,24 @@ SYMBOL: check-optimizer?
|
|||
dup check-cfg
|
||||
] when ;
|
||||
|
||||
SYMBOL: new-optimizer?
|
||||
|
||||
: optimize-cfg ( cfg -- cfg' )
|
||||
! Note that compute-predecessors has to be called several times.
|
||||
! The passes that need this document it.
|
||||
[
|
||||
optimize-tail-calls
|
||||
delete-useless-conditionals
|
||||
new-optimizer? get [ delete-useless-conditionals ] unless
|
||||
compute-predecessors
|
||||
split-branches
|
||||
new-optimizer? get [ split-branches ] unless
|
||||
new-optimizer? get [
|
||||
deconcatenatize
|
||||
compute-dominance
|
||||
construct-ssa
|
||||
] when
|
||||
join-blocks
|
||||
compute-predecessors
|
||||
stack-analysis
|
||||
new-optimizer? get [ stack-analysis ] unless
|
||||
compute-liveness
|
||||
alias-analysis
|
||||
value-numbering
|
||||
|
|
|
|||
Loading…
Reference in New Issue