fix bug in linear-scan.resolve by rewriting entire algorithm

db4
Doug Coleman 2009-06-28 16:43:17 -05:00
parent 1cb6bc99da
commit 3b0954f63e
2 changed files with 110 additions and 119 deletions

View File

@ -65,83 +65,15 @@ T{ live-interval
1 get test-live-interval-2 reload-from 1 get test-live-interval-2 reload-from
] unit-test ] unit-test
[
{
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
}
] [
{
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
} trace-chains
] unit-test
[
{
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
}
] [
{
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
} trace-chains
] unit-test
[
{
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
}
] [
{
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
} trace-chains
] unit-test
[
{
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
}
] [
{
T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
} trace-chains
] unit-test
[
{
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->memory { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
}
] [
{
T{ register->memory { from 1 } { to 2 } { reg-class int-regs } }
T{ register->register { from 2 } { to 3 } { reg-class int-regs } }
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
} trace-chains
] unit-test
[ [
{ {
T{ _copy { dst 5 } { src 4 } { class int-regs } } T{ _copy { dst 5 } { src 4 } { class int-regs } }
T{ _spill { src 1 } { class int-regs } { n 6 } } T{ _spill { src 0 } { class int-regs } { n 6 } }
T{ _copy { dst 1 } { src 0 } { class int-regs } } T{ _copy { dst 0 } { src 1 } { class int-regs } }
T{ _reload { dst 0 } { class int-regs } { n 6 } } T{ _reload { dst 1 } { class int-regs } { n 6 } }
T{ _spill { src 1 } { class float-regs } { n 7 } } T{ _spill { src 0 } { class float-regs } { n 7 } }
T{ _copy { dst 1 } { src 0 } { class float-regs } } T{ _copy { dst 0 } { src 1 } { class float-regs } }
T{ _reload { dst 0 } { class float-regs } { n 7 } } T{ _reload { dst 1 } { class float-regs } { n 7 } }
} }
] [ ] [
{ {
@ -155,10 +87,10 @@ T{ live-interval
[ [
{ {
T{ _spill { src 1 } { class int-regs } { n 3 } } T{ _spill { src 0 } { class int-regs } { n 3 } }
T{ _copy { dst 1 } { src 0 } { class int-regs } }
T{ _copy { dst 0 } { src 2 } { class int-regs } } T{ _copy { dst 0 } { src 2 } { class int-regs } }
T{ _reload { dst 2 } { class int-regs } { n 3 } } T{ _copy { dst 2 } { src 1 } { class int-regs } }
T{ _reload { dst 1 } { class int-regs } { n 3 } }
} }
] [ ] [
{ {
@ -170,10 +102,10 @@ T{ live-interval
[ [
{ {
T{ _spill { src 1 } { class int-regs } { n 3 } } T{ _spill { src 0 } { class int-regs } { n 3 } }
T{ _copy { dst 1 } { src 0 } { class int-regs } }
T{ _copy { dst 0 } { src 2 } { class int-regs } } T{ _copy { dst 0 } { src 2 } { class int-regs } }
T{ _reload { dst 2 } { class int-regs } { n 3 } } T{ _copy { dst 2 } { src 1 } { class int-regs } }
T{ _reload { dst 1 } { class int-regs } { n 3 } }
} }
] [ ] [
{ {
@ -210,3 +142,58 @@ T{ live-interval
T{ register->memory { from 4 } { to 4 } { reg-class int-regs } } T{ register->memory { from 4 } { to 4 } { reg-class int-regs } }
} mapping-instructions } mapping-instructions
] unit-test ] unit-test
[
{
T{ _copy { dst 1 } { src 0 } { class int-regs } }
T{ _copy { dst 2 } { src 0 } { class int-regs } }
T{ _copy { dst 0 } { src 3 } { class int-regs } }
}
] [
{
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
} mapping-instructions
] unit-test
[
{
T{ _copy { dst 1 } { src 0 } { class int-regs } }
T{ _copy { dst 2 } { src 0 } { class int-regs } }
T{ _spill { src 3 } { class int-regs } { n 5 } }
T{ _copy { dst 4 } { src 0 } { class int-regs } }
T{ _copy { dst 3 } { src 4 } { class int-regs } }
T{ _reload { dst 0 } { class int-regs } { n 5 } }
}
] [
{
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
T{ register->register { from 4 } { to 3 } { reg-class int-regs } }
T{ register->register { from 0 } { to 4 } { reg-class int-regs } }
} mapping-instructions
] unit-test
[
{
T{ _copy { dst 2 } { src 0 } { class int-regs } }
T{ _copy { dst 9 } { src 1 } { class int-regs } }
T{ _copy { dst 1 } { src 0 } { class int-regs } }
T{ _spill { src 3 } { class int-regs } { n 10 } }
T{ _copy { dst 4 } { src 0 } { class int-regs } }
T{ _copy { dst 3 } { src 4 } { class int-regs } }
T{ _reload { dst 0 } { class int-regs } { n 10 } }
}
] [
{
T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
T{ register->register { from 1 } { to 9 } { reg-class int-regs } }
T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
T{ register->register { from 4 } { to 3 } { reg-class int-regs } }
T{ register->register { from 0 } { to 4 } { reg-class int-regs } }
} mapping-instructions
] unit-test

View File

@ -3,9 +3,9 @@
USING: accessors arrays assocs classes.parser classes.tuple USING: accessors arrays assocs classes.parser classes.tuple
combinators combinators.short-circuit compiler.cfg.instructions combinators combinators.short-circuit compiler.cfg.instructions
compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness
fry hashtables histogram kernel locals make math math.order fry hashtables kernel locals make math math.order
namespaces parser prettyprint random sequences sets namespaces parser prettyprint random sequences sets
sorting.functor sorting.slots words ; sorting.functor sorting.slots words io ;
IN: compiler.cfg.linear-scan.resolve IN: compiler.cfg.linear-scan.resolve
<< <<
@ -114,38 +114,40 @@ M: register->register to-loc drop register ;
: to-reg ( operation -- seq ) : to-reg ( operation -- seq )
[ to-loc ] [ to>> ] [ reg-class>> ] tri 3array ; [ to-loc ] [ to>> ] [ reg-class>> ] tri 3array ;
: (trace-chain) ( pair -- )
to-reg froms get at [
dup length 1 = [
first [ , ] [ (trace-chain) ] bi
] [
drop
] if
] when* ;
: trace-chain ( pair -- seq )
[ [ , ] [ (trace-chain) ] bi ] { } make reverse ;
: start? ( operations -- pair ) : start? ( operations -- pair )
from-reg tos get key? not ; from-reg tos get key? not ;
: independent-assignment? ( operations -- pair )
to-reg froms get key? not ;
: init-temp-spill ( operations -- ) : init-temp-spill ( operations -- )
[ [ to>> ] [ from>> ] bi max ] [ max ] map-reduce [ [ to>> ] [ from>> ] bi max ] [ max ] map-reduce
1 + temp-spill set ; 1 + temp-spill set ;
: set-tos/froms ( operations -- ) : set-tos/froms ( operations -- )
{ {
[ [ from-reg ] collect-values froms set ] [ [ [ from-reg ] keep ] H{ } map>assoc froms set ]
[ [ to-reg ] collect-values tos set ] [ [ [ to-reg ] keep ] H{ } map>assoc tos set ]
} cleave ; } cleave ;
: trace-chains ( operations -- operations' ) :: (trace-chain) ( obj hashtable -- )
[ set-tos/froms ] obj to-reg froms get at* [
[ [ start? ] filter [ trace-chain ] map concat ] bi ; obj over hashtable clone [ maybe-set-at ] keep swap
[ (trace-chain) ] [ , drop ] if
] [
drop hashtable ,
] if ;
: trace-chain ( obj -- seq )
[
dup dup associate (trace-chain)
] { } make [ keys ] map concat reverse ;
: trace-chains ( seq -- seq' )
[ trace-chain ] map concat ;
: break-cycle-n ( operations -- operations' ) : break-cycle-n ( operations -- operations' )
unclip [ trace-chains ] dip unclip [
[
[ from>> temp-spill get ] [ from>> temp-spill get ]
[ reg-class>> ] bi \ register->memory boa [ reg-class>> ] bi \ register->memory boa
] [ ] [
@ -155,32 +157,30 @@ M: register->register to-loc drop register ;
: break-cycle ( operations -- operations' ) : break-cycle ( operations -- operations' )
dup length { dup length {
{ 1 [ drop { } ] } { 1 [ ] }
[ drop break-cycle-n ] [ drop break-cycle-n ]
} case ; } case ;
: follow-cycle ( obj -- seq )
dup dup associate [
[ to-reg froms get at first dup dup ] dip
[ maybe-set-at ] keep swap
] loop nip keys ;
: (group-cycles) ( seq -- ) : (group-cycles) ( seq -- )
[ [
unclip follow-cycle [ diff ] keep , (group-cycles) dup set-tos/froms
unclip trace-chain
[ diff ] keep , (group-cycles)
] unless-empty ; ] unless-empty ;
: group-cycles ( seq -- seqs ) : group-cycles ( seq -- seqs )
[ (group-cycles) ] { } make ; [ (group-cycles) ] { } make ;
: partition-mappings ( mappings -- no-cycles cycles ) : remove-dead-mappings ( seq -- seq' )
[ start? not ] partition prune [ [ from-reg ] [ to-reg ] bi = not ] filter ;
[ trace-chain ] map concat tuck diff ;
: parallel-mappings ( operations -- seq ) : parallel-mappings ( operations -- seq )
partition-mappings [ [
group-cycles [ break-cycle ] map concat append [ independent-assignment? not ] partition %
] unless-empty ; [ start? not ] partition
[ trace-chain ] map concat dup %
diff group-cycles [ break-cycle ] map concat %
] { } make remove-dead-mappings ;
: mapping-instructions ( mappings -- insns ) : mapping-instructions ( mappings -- insns )
[ [
@ -191,15 +191,19 @@ M: register->register to-loc drop register ;
] with-scope ; ] with-scope ;
: fork? ( from to -- ? ) : fork? ( from to -- ? )
[ successors>> length 1 >= ] {
[ predecessors>> length 1 = ] bi* and ; inline [ drop successors>> length 1 >= ]
[ nip predecessors>> length 1 = ]
} 2&& ; inline
: insert-position/fork ( from to -- before after ) : insert-position/fork ( from to -- before after )
nip instructions>> [ >array ] [ dup delete-all ] bi swap ; nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
: join? ( from to -- ? ) : join? ( from to -- ? )
[ successors>> length 1 = ] {
[ predecessors>> length 1 >= ] bi* and ; inline [ drop successors>> length 1 = ]
[ nip predecessors>> length 1 >= ]
} 2&& ; inline
: insert-position/join ( from to -- before after ) : insert-position/join ( from to -- before after )
drop instructions>> dup pop 1array ; drop instructions>> dup pop 1array ;