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

Fix conflict

db4
Slava Pestov 2009-06-29 01:59:53 -05:00
parent 0f68ee3e9a
commit 82bfaca188
2 changed files with 109 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
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

80
basis/compiler/cfg/linear-scan/resolve/resolve.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.parser classes.tuple USING: accessors arrays assocs classes.parser classes.tuple
combinators combinators.short-circuit fry hashtables kernel locals combinators combinators.short-circuit fry hashtables kernel locals
make math math.order namespaces sequences sets words parser histogram make math math.order namespaces sequences sets words parser
compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals
compiler.cfg.liveness ; compiler.cfg.liveness ;
IN: compiler.cfg.linear-scan.resolve IN: compiler.cfg.linear-scan.resolve
@ -113,37 +113,39 @@ 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 ]
bi ; bi ;
: 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
] [ ] [
@ -153,32 +155,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 )
[ [
@ -189,15 +189,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 ;