compiler.cfg.linear-scan.resolve: get it to work on CFGs with critical edges

db4
Slava Pestov 2009-07-12 23:00:33 -05:00
parent 608fb054f2
commit 8ff473e42c
5 changed files with 21 additions and 53 deletions

View File

@ -1509,6 +1509,7 @@ SYMBOL: linear-scan-result
compute-liveness
dup reverse-post-order
{ { int-regs regs } } (linear-scan)
cfg-changed
flatten-cfg 1array mr.
] with-scope ;
@ -1803,7 +1804,7 @@ test-diamond
[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
[ _spill ] [ 2 get instructions>> first class ] unit-test
[ _spill ] [ 2 get successors>> first instructions>> first class ] unit-test
[ _spill ] [ 3 get instructions>> second class ] unit-test
@ -1859,7 +1860,7 @@ V{
[ t ] [ 2 get instructions>> [ _spill? ] any? ] unit-test
[ t ] [ 3 get instructions>> [ _spill? ] any? ] unit-test
[ t ] [ 3 get predecessors>> first instructions>> [ _spill? ] any? ] unit-test
[ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test
@ -1926,7 +1927,7 @@ V{
[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> ] map ] unit-test
! Resolve pass should insert this
[ _reload ] [ 5 get instructions>> first class ] unit-test
[ _reload ] [ 5 get predecessors>> first instructions>> first class ] unit-test
! Some random bug
V{
@ -2484,7 +2485,7 @@ test-diamond
[ 1 ] [ 2 get instructions>> [ _spill? ] count ] unit-test
[ 1 ] [ 3 get instructions>> [ _spill? ] count ] unit-test
[ 1 ] [ 3 get predecessors>> first instructions>> [ _spill? ] count ] unit-test
[ 1 ] [ 4 get instructions>> [ _reload? ] count ] unit-test

View File

@ -40,4 +40,5 @@ IN: compiler.cfg.linear-scan
init-mapping
dup reverse-post-order machine-registers (linear-scan)
spill-counts get >>spill-counts
cfg-changed
] with-scope ;

View File

@ -1,7 +0,0 @@
USING: arrays compiler.cfg.linear-scan.resolve kernel
tools.test ;
IN: compiler.cfg.linear-scan.resolve.tests
[ { 1 2 3 4 5 6 } ] [
{ 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
] unit-test

View File

@ -3,6 +3,7 @@
USING: accessors arrays assocs combinators
combinators.short-circuit fry kernel locals
make math sequences
compiler.cfg.utilities
compiler.cfg.instructions
compiler.cfg.linear-scan.assignment
compiler.cfg.linear-scan.mapping compiler.cfg.liveness ;
@ -30,42 +31,14 @@ IN: compiler.cfg.linear-scan.resolve
[ resolve-value-data-flow ] with with each
] { } make ;
: fork? ( from to -- ? )
{
[ drop successors>> length 1 >= ]
[ nip predecessors>> length 1 = ]
} 2&& ; inline
: insert-position/fork ( from to -- before after )
nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
: join? ( from to -- ? )
{
[ drop successors>> length 1 = ]
[ nip predecessors>> length 1 >= ]
} 2&& ; inline
: insert-position/join ( from to -- before after )
drop instructions>> dup pop 1array ;
: insert-position ( bb to -- before after )
{
{ [ 2dup fork? ] [ insert-position/fork ] }
{ [ 2dup join? ] [ insert-position/join ] }
} cond ;
: 3append-here ( seq2 seq1 seq3 -- )
#! Mutate seq1
swap '[ _ push-all ] bi@ ;
: perform-mappings ( mappings bb to -- )
pick empty? [ 3drop ] [
[ mapping-instructions ] 2dip
insert-position 3append-here
: perform-mappings ( bb to mappings -- )
dup empty? [ 3drop ] [
mapping-instructions <simple-block>
insert-basic-block
] if ;
: resolve-edge-data-flow ( bb to -- )
[ compute-mappings ] [ perform-mappings ] 2bi ;
2dup compute-mappings perform-mappings ;
: resolve-block-data-flow ( bb -- )
dup successors>> [ resolve-edge-data-flow ] with each ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators combinators.short-circuit
compiler.cfg compiler.cfg.instructions cpu.architecture kernel
layouts locals make math namespaces sequences sets vectors ;
layouts locals make math namespaces sequences sets vectors fry ;
IN: compiler.cfg.utilities
: value-info-small-fixnum? ( value-info -- ? )
@ -74,12 +74,12 @@ SYMBOL: added-instructions
to predecessors>> [ dup from eq? [ drop bb ] when ] change-each
from successors>> [ dup to eq? [ drop bb ] when ] change-each ;
:: insert-basic-blocks ( bb -- )
added-instructions get
[| predecessor instructions |
\ ##branch new-insn instructions push
predecessor bb
<basic-block> instructions >>instructions
insert-basic-block
] assoc-each ;
: <simple-block> ( insns -- bb )
<basic-block>
swap >vector
\ ##branch new-insn over push
>>instructions ;
: insert-basic-blocks ( bb -- )
[ added-instructions get ] dip
'[ [ _ ] dip <simple-block> insert-basic-block ] assoc-each ;