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

math.bitwise: hotrod nonintrinsic fixnum-bit-count

db4
Joe Groff 2011-11-11 22:49:09 -08:00
parent d79b462f75
commit 706c9ee3b9
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/math/bitwise/bitwise.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators combinators.smart fry kernel USING: arrays assocs combinators combinators.smart fry kernel
macros math math.bits sequences sequences.private words macros math math.bits sequences sequences.private words
byte-arrays alien alien.c-types alien.data specialized-arrays ; byte-arrays alien alien.c-types alien.data specialized-arrays
kernel.private layouts ;
SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: uchar
IN: math.bitwise IN: math.bitwise
@ -86,15 +87,20 @@ DEFER: byte-bit-count
GENERIC: (bit-count) ( x -- n ) GENERIC: (bit-count) ( x -- n )
: fixnum-bit-count ( x -- n ) : fixnum-bit-count ( x -- n )
0 swap [ { fixnum } declare
dup 0 > [ byte-bit-count ] keep
] [ [ -8 shift byte-bit-count + ] keep
[ 8 bits byte-bit-count ] [ -8 shift ] bi [ -8 shift byte-bit-count + ] keep
[ + ] dip [ -8 shift byte-bit-count + ] keep
] while drop ; cell 8 = [
[ -8 shift byte-bit-count + ] keep
[ -8 shift byte-bit-count + ] keep
[ -8 shift byte-bit-count + ] keep
-8 shift byte-bit-count + >fixnum
] [ drop ] if ;
M: fixnum (bit-count) M: fixnum (bit-count)
fixnum-bit-count ; inline fixnum-bit-count { fixnum } declare ; inline
M: bignum (bit-count) M: bignum (bit-count)
dup 0 = [ drop 0 ] [ dup 0 = [ drop 0 ] [