compiler.cfg.ssa.destruction: fix bug in trivial-interference heuristic, and type error in code path that didn't run before

db4
Slava Pestov 2009-08-01 20:22:31 -05:00
parent ee82d5a19f
commit 20ec574965
2 changed files with 23 additions and 15 deletions

View File

@ -18,29 +18,29 @@ IN: compiler.cfg.ssa.destruction.process-blocks
! the source vregs above
SYMBOLS: phi-union unioned-blocks ;
:: operand-live-into-phi-node's-block? ( bb src dst -- ? )
src bb live-in? ;
: operand-live-into-phi-node's-block? ( src dst -- ? )
def-of live-in? ;
:: phi-node-is-live-out-of-operand's-block? ( bb src dst -- ? )
dst src def-of live-out? ;
: phi-node-is-live-out-of-operand's-block? ( src dst -- ? )
swap def-of live-out? ;
:: operand-is-phi-node-and-live-into-operand's-block? ( bb src dst -- ? )
{ [ src insn-of ##phi? ] [ src src def-of live-in? ] } 0&& ;
: operand-is-phi-node-and-live-into-operand's-block? ( src dst -- ? )
drop { [ insn-of ##phi? ] [ dup def-of live-in? ] } 1&& ;
:: operand-being-renamed? ( bb src dst -- ? )
src processed-names get key? ;
: operand-being-renamed? ( src dst -- ? )
drop processed-names get key? ;
:: two-operands-in-same-block? ( bb src dst -- ? )
src def-of unioned-blocks get key? ;
: two-operands-in-same-block? ( src dst -- ? )
drop def-of unioned-blocks get key? ;
: trivial-interference? ( bb src dst -- ? )
: trivial-interference? ( src dst -- ? )
{
[ operand-live-into-phi-node's-block? ]
[ phi-node-is-live-out-of-operand's-block? ]
[ operand-is-phi-node-and-live-into-operand's-block? ]
[ operand-being-renamed? ]
[ two-operands-in-same-block? ]
} 3|| ;
} 2|| ;
: don't-coalesce ( bb src dst -- )
2nip processed-name ;
@ -56,7 +56,7 @@ SYMBOLS: phi-union unioned-blocks ;
: process-phi-operand ( bb src dst -- )
{
{ [ 2dup eq? ] [ don't-coalesce ] }
{ [ 3dup trivial-interference? ] [ trivial-interference ] }
{ [ 2dup trivial-interference? ] [ trivial-interference ] }
[ add-to-renaming-set ]
} cond ;
@ -70,7 +70,7 @@ SYMBOLS: phi-union unioned-blocks ;
bb src dst trivial-interference
src phi-union get delete-at ;
:: insert-copy-for-parent ( bb src node dst -- )
:: insert-copy-for-parent ( bb src dst node -- )
src node vreg>> eq? [ bb src dst insert-copy ] when ;
: insert-copies-for-parent ( ##phi node child -- )

View File

@ -358,4 +358,12 @@ cell 4 = [
[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test
[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 0 7 "hello" coalescing-bug-1 ] unit-test
[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 3 2 "hello" coalescing-bug-1 ] unit-test
[ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
[ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
! Another one, found by Dan
: coalescing-bug-2 ( a -- b )
dup dup 10 fixnum< [ 1 fixnum+fast ] when
fixnum+fast 2 fixnum*fast 2 fixnum-fast 2 fixnum*fast 2 fixnum+fast ;
[ 10 ] [ 1 coalescing-bug-2 ] unit-test
[ 86 ] [ 11 coalescing-bug-2 ] unit-test