compiler.cfg: don't unbox the same value more than once per basic block
parent
b9577e2b0e
commit
c3d81cefe9
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue