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

optimize fixnum*fast and fixnum-shift-fast

db4
Doug Coleman 2009-06-30 23:01:44 -05:00
parent ded1e29d2f
commit b1c7374175
2 changed files with 36 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -18,10 +18,14 @@ kernel.private math ;
[ 3 fixnum+fast ] [ 3 fixnum+fast ]
[ fixnum*fast ] [ fixnum*fast ]
[ 3 fixnum*fast ] [ 3 fixnum*fast ]
[ 3 swap fixnum*fast ]
[ fixnum-shift-fast ] [ fixnum-shift-fast ]
[ 10 fixnum-shift-fast ] [ 10 fixnum-shift-fast ]
[ -10 fixnum-shift-fast ] [ -10 fixnum-shift-fast ]
[ 0 fixnum-shift-fast ] [ 0 fixnum-shift-fast ]
[ 10 swap fixnum-shift-fast ]
[ -10 swap fixnum-shift-fast ]
[ 0 swap fixnum-shift-fast ]
[ fixnum-bitnot ] [ fixnum-bitnot ]
[ eq? ] [ eq? ]
[ "hi" eq? ] [ "hi" eq? ]

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

@ -52,17 +52,26 @@ IN: compiler.cfg.intrinsics.fixnum
ds-push ds-push
] ; inline ] ; inline
: emit-fixnum-shift-fast ( node -- ) : (emit-fixnum-shift-fast) ( obj node -- obj )
dup node-input-infos dup second value-info-small-fixnum? [ literal>> dup sgn {
nip
[ ds-drop ds-pop ] dip
second literal>> dup sgn {
{ -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] } { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
{ 0 [ drop ] } { 0 [ drop ] }
{ 1 [ ^^shl-imm ] } { 1 [ ^^shl-imm ] }
} case } case ;
ds-push
] [ drop emit-primitive ] if ; : emit-fixnum-shift-fast ( node -- )
dup node-input-infos dup first value-info-small-fixnum? [
nip
[ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push
] [
drop
dup node-input-infos dup second value-info-small-fixnum? [
nip
[ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push
] [
drop emit-primitive
] if
] if ;
: emit-fixnum-bitnot ( -- ) : emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ; ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@ -73,14 +82,21 @@ IN: compiler.cfg.intrinsics.fixnum
: (emit-fixnum*fast) ( -- dst ) : (emit-fixnum*fast) ( -- dst )
2inputs ^^untag-fixnum ^^mul ; 2inputs ^^untag-fixnum ^^mul ;
: (emit-fixnum*fast-imm) ( infos -- dst ) : (emit-fixnum*fast-imm1) ( infos -- dst )
ds-drop [ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ;
[ ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
: (emit-fixnum*fast-imm2) ( infos -- dst )
[ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
: emit-fixnum*fast ( node -- ) : emit-fixnum*fast ( node -- )
node-input-infos node-input-infos
dup first value-info-small-fixnum?
[
(emit-fixnum*fast-imm1)
] [
dup second value-info-small-fixnum? dup second value-info-small-fixnum?
[ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
] if
ds-push ; ds-push ;
: (emit-fixnum-comparison) ( cc -- quot1 quot2 ) : (emit-fixnum-comparison) ( cc -- quot1 quot2 )