compiler.cfg: don't unbox the same value more than once per basic block

db4
Slava Pestov 2009-10-01 19:41:23 -05:00
parent b9577e2b0e
commit c3d81cefe9
2 changed files with 21 additions and 6 deletions

View File

@ -159,9 +159,12 @@ IN: compiler.cfg.builder.tests
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
] each ] each
: contains-insn? ( quot insn-check -- ? ) : count-insns ( quot insn-check -- ? )
[ test-mr [ instructions>> ] map ] dip [ test-mr [ instructions>> ] map ] dip
'[ _ any? ] any? ; inline '[ _ count ] sigma ; inline
: contains-insn? ( quot insn-check -- ? )
count-insns 0 > ; inline
[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test [ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
@ -197,14 +200,16 @@ IN: compiler.cfg.builder.tests
[ f t ] [ [ f t ] [
[ { byte-array fixnum } declare alien-cell 4 alien-float ] [ { byte-array fixnum } declare alien-cell 4 alien-float ]
[ [ ##box-alien? ] contains-insn? ] [ [ ##box-alien? ] contains-insn? ]
[ [ ##box-float? ] contains-insn? ] bi [ [ ##allot? ] contains-insn? ] bi
] unit-test ] unit-test
[ f t ] [ [ f t ] [
[ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ] [ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
[ [ ##box-alien? ] contains-insn? ] [ [ ##box-alien? ] contains-insn? ]
[ [ ##box-float? ] contains-insn? ] bi [ [ ##allot? ] contains-insn? ] bi
] unit-test ] unit-test
[ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
] when ] when
! Regression. Make sure everything is inlined correctly ! Regression. Make sure everything is inlined correctly

View File

@ -51,7 +51,7 @@ M:: vector-rep emit-box ( dst src rep -- )
dst byte-array-offset src rep ##set-alien-vector ; dst byte-array-offset src rep ##set-alien-vector ;
M: vector-rep emit-unbox M: vector-rep emit-unbox
byte-array-offset ##alien-vector ; [ byte-array-offset ] dip ##alien-vector ;
M:: scalar-rep emit-box ( dst src rep -- ) M:: scalar-rep emit-box ( dst src rep -- )
int-rep next-vreg-rep :> temp int-rep next-vreg-rep :> temp
@ -152,6 +152,9 @@ SYMBOL: costs
! Insert conversions. This introduces new temporaries, so we need ! Insert conversions. This introduces new temporaries, so we need
! to rename opearands too. ! to rename opearands too.
! Mapping from vreg,rep pairs to vregs
SYMBOL: alternatives
:: emit-def-conversion ( dst preferred required -- new-dst' ) :: emit-def-conversion ( dst preferred required -- new-dst' )
! If an instruction defines a register with representation 'required', ! If an instruction defines a register with representation 'required',
! but the register has preferred representation 'preferred', then ! but the register has preferred representation 'preferred', then
@ -164,7 +167,13 @@ SYMBOL: costs
! but the register has preferred representation 'preferred', then ! but the register has preferred representation 'preferred', then
! we rename the instruction's input to a new register, which ! we rename the instruction's input to a new register, which
! becomes the output of a conversion instruction. ! becomes the output of a conversion instruction.
required next-vreg-rep [ src required preferred emit-conversion ] keep ; preferred required eq? [ src ] [
src required alternatives get [
required next-vreg-rep :> new-src
[ new-src ] 2dip preferred emit-conversion
new-src
] 2cache
] if ;
SYMBOLS: renaming-set needs-renaming? ; SYMBOLS: renaming-set needs-renaming? ;
@ -245,6 +254,7 @@ M: insn conversions-for-insn , ;
dup kill-block? [ drop ] [ dup kill-block? [ drop ] [
[ [
[ [
H{ } clone alternatives set
[ conversions-for-insn ] each [ conversions-for-insn ] each
] V{ } make ] V{ } make
] change-instructions drop ] change-instructions drop