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 ]
[ fixnum*fast ]
[ 3 fixnum*fast ]
[ 3 swap fixnum*fast ]
[ fixnum-shift-fast ]
[ 10 fixnum-shift-fast ]
[ -10 fixnum-shift-fast ]
[ 0 fixnum-shift-fast ]
[ 10 swap fixnum-shift-fast ]
[ -10 swap fixnum-shift-fast ]
[ 0 swap fixnum-shift-fast ]
[ fixnum-bitnot ]
[ eq? ]
[ "hi" eq? ]

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

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