steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2009-07-16 23:50:48 -05:00
parent 7692c5d219
commit 3fb4fc1bde
14 changed files with 120 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/cfg/hats/hats.factor
View File

@ -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

3
basis/compiler/cfg/instructions/instructions.factor
View File

@ -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 ;

33
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -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 ;

3
basis/compiler/cfg/two-operand/two-operand.factor
View File

@ -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 ;

6
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -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 ;

3
basis/compiler/cfg/value-numbering/simplify/simplify.factor
View File

@ -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 ;

3
basis/compiler/codegen/codegen.factor
View File

@ -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 ;

30
basis/compiler/tests/intrinsics.factor
View File

@ -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

5
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

@ -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 ]

8
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -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

18
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -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>> {

3
basis/cpu/architecture/architecture.factor
View File

@ -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 -- )

22
basis/cpu/x86/x86.factor
View File

@ -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 |

2
vm/math.cpp
View File

@ -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)