Improve code generation for shift word: add intrinsics for fixnum-shift-fast in the case where the shift count is not constant, transform 1 swap shift into a more overflow check with open-coded fast case, transform bitand into fixnum-bitand in more cases
parent
7692c5d219
commit
3fb4fc1bde
|
@ -27,6 +27,7 @@ IN: compiler.cfg.hats
|
|||
: ^^add-imm ( src1 src2 -- dst ) ^^i2 ##add-imm ; inline
|
||||
: ^^sub ( src1 src2 -- dst ) ^^i2 ##sub ; inline
|
||||
: ^^sub-imm ( src1 src2 -- dst ) ^^i2 ##sub-imm ; inline
|
||||
: ^^neg ( src -- dst ) [ 0 ^^load-literal ] dip ^^sub ; inline
|
||||
: ^^mul ( src1 src2 -- dst ) ^^i2 ##mul ; inline
|
||||
: ^^mul-imm ( src1 src2 -- dst ) ^^i2 ##mul-imm ; inline
|
||||
: ^^and ( input mask -- output ) ^^i2 ##and ; inline
|
||||
|
@ -35,8 +36,11 @@ IN: compiler.cfg.hats
|
|||
: ^^or-imm ( src1 src2 -- dst ) ^^i2 ##or-imm ; inline
|
||||
: ^^xor ( src1 src2 -- dst ) ^^i2 ##xor ; inline
|
||||
: ^^xor-imm ( src1 src2 -- dst ) ^^i2 ##xor-imm ; inline
|
||||
: ^^shl ( src1 src2 -- dst ) ^^i2 ##shl ; inline
|
||||
: ^^shl-imm ( src1 src2 -- dst ) ^^i2 ##shl-imm ; inline
|
||||
: ^^shr ( src1 src2 -- dst ) ^^i2 ##shr ; inline
|
||||
: ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline
|
||||
: ^^sar ( src1 src2 -- dst ) ^^i2 ##sar ; inline
|
||||
: ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline
|
||||
: ^^not ( src -- dst ) ^^i1 ##not ; inline
|
||||
: ^^log2 ( src -- dst ) ^^i1 ##log2 ; inline
|
||||
|
|
|
@ -86,8 +86,11 @@ INSN: ##or < ##commutative ;
|
|||
INSN: ##or-imm < ##commutative-imm ;
|
||||
INSN: ##xor < ##commutative ;
|
||||
INSN: ##xor-imm < ##commutative-imm ;
|
||||
INSN: ##shl < ##binary ;
|
||||
INSN: ##shl-imm < ##binary-imm ;
|
||||
INSN: ##shr < ##binary ;
|
||||
INSN: ##shr-imm < ##binary-imm ;
|
||||
INSN: ##sar < ##binary ;
|
||||
INSN: ##sar-imm < ##binary-imm ;
|
||||
INSN: ##not < ##unary ;
|
||||
INSN: ##log2 < ##unary ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences accessors layouts kernel math namespaces
|
||||
combinators fry arrays
|
||||
USING: sequences accessors layouts kernel math math.intervals
|
||||
namespaces combinators fry arrays
|
||||
compiler.tree.propagation.info
|
||||
compiler.cfg.hats
|
||||
compiler.cfg.stacks
|
||||
|
@ -21,20 +21,27 @@ IN: compiler.cfg.intrinsics.fixnum
|
|||
: tag-literal ( n -- tagged )
|
||||
literal>> [ tag-fixnum ] [ \ f tag-number ] if* ;
|
||||
|
||||
: emit-fixnum-op ( insn -- dst )
|
||||
: emit-fixnum-op ( insn -- )
|
||||
[ 2inputs ] dip call ds-push ; inline
|
||||
|
||||
: emit-fixnum-left-shift ( -- )
|
||||
[ ^^untag-fixnum ^^shl ] emit-fixnum-op ;
|
||||
|
||||
: emit-fixnum-right-shift ( -- )
|
||||
[ ^^untag-fixnum ^^neg ^^sar dup tag-mask get ^^and-imm ^^xor ] emit-fixnum-op ;
|
||||
|
||||
: emit-fixnum-shift-general ( -- )
|
||||
D 0 ^^peek 0 cc> ##compare-imm-branch
|
||||
[ emit-fixnum-left-shift ] with-branch
|
||||
[ emit-fixnum-right-shift ] with-branch
|
||||
2array emit-conditional ;
|
||||
|
||||
: emit-fixnum-shift-fast ( node -- )
|
||||
dup node-input-infos dup second value-info-small-fixnum? [
|
||||
nip
|
||||
[ ds-drop ds-pop ] dip
|
||||
second literal>> dup sgn {
|
||||
{ -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
|
||||
{ 0 [ drop ] }
|
||||
{ 1 [ ^^shl-imm ] }
|
||||
} case
|
||||
ds-push
|
||||
] [ drop emit-primitive ] if ;
|
||||
node-input-infos second interval>> {
|
||||
{ [ dup 0 [a,inf] interval-subset? ] [ drop emit-fixnum-left-shift ] }
|
||||
{ [ dup 0 [-inf,a] interval-subset? ] [ drop emit-fixnum-right-shift ] }
|
||||
[ drop emit-fixnum-shift-general ]
|
||||
} cond ;
|
||||
|
||||
: emit-fixnum-bitnot ( -- )
|
||||
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
|
||||
|
|
|
@ -40,8 +40,11 @@ M: ##or convert-two-operand* convert-two-operand/integer ;
|
|||
M: ##or-imm convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##xor convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##xor-imm convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##shl convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##shl-imm convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##shr convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##shr-imm convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##sar convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##sar-imm convert-two-operand* convert-two-operand/integer ;
|
||||
|
||||
M: ##fixnum-overflow convert-two-operand* convert-two-operand/integer ;
|
||||
|
|
|
@ -348,3 +348,9 @@ M: ##and rewrite* \ ##and-imm rewrite-arithmetic-commutative ;
|
|||
M: ##or rewrite* \ ##or-imm rewrite-arithmetic-commutative ;
|
||||
|
||||
M: ##xor rewrite* \ ##xor-imm rewrite-arithmetic-commutative ;
|
||||
|
||||
M: ##shl rewrite* \ ##shl-imm rewrite-arithmetic ;
|
||||
|
||||
M: ##shr rewrite* \ ##shr-imm rewrite-arithmetic ;
|
||||
|
||||
M: ##sar rewrite* \ ##sar-imm rewrite-arithmetic ;
|
||||
|
|
|
@ -109,8 +109,11 @@ M: binary-expr simplify*
|
|||
{ \ ##or-imm [ simplify-or ] }
|
||||
{ \ ##xor [ simplify-xor ] }
|
||||
{ \ ##xor-imm [ simplify-xor ] }
|
||||
{ \ ##shr [ simplify-shr ] }
|
||||
{ \ ##shr-imm [ simplify-shr ] }
|
||||
{ \ ##sar [ simplify-shr ] }
|
||||
{ \ ##sar-imm [ simplify-shr ] }
|
||||
{ \ ##shl [ simplify-shl ] }
|
||||
{ \ ##shl-imm [ simplify-shl ] }
|
||||
[ 2drop f ]
|
||||
} case ;
|
||||
|
|
|
@ -165,8 +165,11 @@ M: ##or generate-insn dst/src1/src2 %or ;
|
|||
M: ##or-imm generate-insn dst/src1/src2 %or-imm ;
|
||||
M: ##xor generate-insn dst/src1/src2 %xor ;
|
||||
M: ##xor-imm generate-insn dst/src1/src2 %xor-imm ;
|
||||
M: ##shl generate-insn dst/src1/src2 %shl ;
|
||||
M: ##shl-imm generate-insn dst/src1/src2 %shl-imm ;
|
||||
M: ##shr generate-insn dst/src1/src2 %shr ;
|
||||
M: ##shr-imm generate-insn dst/src1/src2 %shr-imm ;
|
||||
M: ##sar generate-insn dst/src1/src2 %sar ;
|
||||
M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
|
||||
M: ##not generate-insn dst/src %not ;
|
||||
M: ##log2 generate-insn dst/src %log2 ;
|
||||
|
|
|
@ -213,12 +213,25 @@ IN: compiler.tests.intrinsics
|
|||
[ -1 ] [ [ -123 -64 fixnum-shift ] compile-call ] unit-test
|
||||
[ -1 ] [ -123 -64 [ fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ HEX: 10000000 ] [ HEX: 1000000 HEX: 10 [ fixnum* ] compile-call ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-call 1 28 fixnum-shift = ] unit-test
|
||||
[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
|
||||
[ 8 ] [ 1 3 [ fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ 8 ] [ 1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ 8 ] [ 1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ 8 ] [ [ 1 3 fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ -8 ] [ -1 3 [ fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ -8 ] [ -1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ -8 ] [ -1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ -8 ] [ [ -1 3 fixnum-shift-fast ] compile-call ] unit-test
|
||||
|
||||
[ 2 ] [ 8 -2 [ fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ 2 ] [ 8 2 [ 15 bitand neg fixnum-shift-fast ] compile-call ] unit-test
|
||||
[ 2 ] [ 8 [ -2 fixnum-shift-fast ] compile-call ] unit-test
|
||||
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
|
@ -227,6 +240,13 @@ IN: compiler.tests.intrinsics
|
|||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ HEX: 10000000 ] [ HEX: 1000000 HEX: 10 [ fixnum* ] compile-call ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-call 1 28 fixnum-shift = ] unit-test
|
||||
[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-call 1 40 shift = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-call 1 40 shift neg = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-call 1 40 shift = ] unit-test
|
||||
|
|
|
@ -242,6 +242,11 @@ M: float detect-float ;
|
|||
{ fixnum-shift-fast } inlined?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ 1 swap 7 bitand shift ]
|
||||
{ shift fixnum-shift } inlined?
|
||||
] unit-test
|
||||
|
||||
cell-bits 32 = [
|
||||
[ t ] [
|
||||
[ { fixnum fixnum } declare 1 swap 31 bitand shift ]
|
||||
|
|
|
@ -84,9 +84,9 @@ IN: compiler.tree.propagation.tests
|
|||
|
||||
[ float ] [ [ { float float } declare mod ] final-math-class ] unit-test
|
||||
|
||||
[ V{ integer } ] [ [ 255 bitand ] final-classes ] unit-test
|
||||
[ V{ fixnum } ] [ [ 255 bitand ] final-classes ] unit-test
|
||||
|
||||
[ V{ integer } ] [
|
||||
[ V{ fixnum } ] [
|
||||
[ [ 255 bitand ] [ 65535 bitand ] bi + ] final-classes
|
||||
] unit-test
|
||||
|
||||
|
@ -640,6 +640,10 @@ MIXIN: empty-mixin
|
|||
[ { bignum integer } declare [ shift ] keep ] final-classes
|
||||
] unit-test
|
||||
|
||||
[ V{ fixnum } ] [ [ >fixnum 15 bitand 1 swap shift ] final-classes ] unit-test
|
||||
|
||||
[ V{ fixnum } ] [ [ 15 bitand 1 swap shift ] final-classes ] unit-test
|
||||
|
||||
[ V{ fixnum } ] [
|
||||
[ { fixnum } declare log2 ] final-classes
|
||||
] unit-test
|
||||
|
|
|
@ -6,8 +6,7 @@ classes.tuple.private math math.partial-dispatch math.private
|
|||
math.intervals layouts math.order vectors hashtables
|
||||
combinators effects generalizations assocs sets
|
||||
combinators.short-circuit sequences.private locals
|
||||
stack-checker
|
||||
compiler.tree.propagation.info ;
|
||||
stack-checker namespaces compiler.tree.propagation.info ;
|
||||
IN: compiler.tree.propagation.transforms
|
||||
|
||||
\ equal? [
|
||||
|
@ -43,6 +42,7 @@ IN: compiler.tree.propagation.transforms
|
|||
bitand-integer-integer
|
||||
bitand-integer-fixnum
|
||||
bitand-fixnum-integer
|
||||
bitand
|
||||
} [
|
||||
[
|
||||
in-d>> second value-info >literal< [
|
||||
|
@ -52,6 +52,20 @@ IN: compiler.tree.propagation.transforms
|
|||
] "custom-inlining" set-word-prop
|
||||
] each
|
||||
|
||||
! Speeds up 2^
|
||||
\ shift [
|
||||
in-d>> first value-info literal>> 1 = [
|
||||
cell-bits tag-bits get - 1 -
|
||||
'[
|
||||
>fixnum dup 0 < [ 2drop 0 ] [
|
||||
dup _ < [ fixnum-shift ] [
|
||||
fixnum-shift
|
||||
] if
|
||||
] if
|
||||
]
|
||||
] [ drop f ] if
|
||||
] "custom-inlining" set-word-prop
|
||||
|
||||
! Generate more efficient code for common idiom
|
||||
\ clone [
|
||||
in-d>> first value-info literal>> {
|
||||
|
|
|
@ -76,8 +76,11 @@ HOOK: %or cpu ( dst src1 src2 -- )
|
|||
HOOK: %or-imm cpu ( dst src1 src2 -- )
|
||||
HOOK: %xor cpu ( dst src1 src2 -- )
|
||||
HOOK: %xor-imm cpu ( dst src1 src2 -- )
|
||||
HOOK: %shl cpu ( dst src1 src2 -- )
|
||||
HOOK: %shl-imm cpu ( dst src1 src2 -- )
|
||||
HOOK: %shr cpu ( dst src1 src2 -- )
|
||||
HOOK: %shr-imm cpu ( dst src1 src2 -- )
|
||||
HOOK: %sar cpu ( dst src1 src2 -- )
|
||||
HOOK: %sar-imm cpu ( dst src1 src2 -- )
|
||||
HOOK: %not cpu ( dst src -- )
|
||||
HOOK: %log2 cpu ( dst src -- )
|
||||
|
|
|
@ -351,6 +351,28 @@ M: x86.64 small-reg-native small-reg-8 ;
|
|||
[ quot call ] with-save/restore
|
||||
] if ; inline
|
||||
|
||||
: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
|
||||
|
||||
:: emit-shift ( dst src1 src2 quot -- )
|
||||
src2 shift-count? [
|
||||
dst CL quot call
|
||||
] [
|
||||
dst shift-count? [
|
||||
dst src2 XCHG
|
||||
src2 CL quot call
|
||||
dst src2 XCHG
|
||||
] [
|
||||
ECX small-reg-native [
|
||||
CL src2 MOV
|
||||
drop dst CL quot call
|
||||
] with-save/restore
|
||||
] if
|
||||
] if ; inline
|
||||
|
||||
M: x86 %shl [ SHL ] emit-shift ;
|
||||
M: x86 %shr [ SHR ] emit-shift ;
|
||||
M: x86 %sar [ SAR ] emit-shift ;
|
||||
|
||||
M:: x86 %string-nth ( dst src index temp -- )
|
||||
"end" define-label
|
||||
dst { src index temp } [| new-dst |
|
||||
|
|
|
@ -67,7 +67,7 @@ static inline fixnum branchless_abs(fixnum x)
|
|||
|
||||
PRIMITIVE(fixnum_shift)
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop()); \
|
||||
fixnum y = untag_fixnum(dpop());
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
|
||||
if(x == 0)
|
||||
|
|
Loading…
Reference in New Issue