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

math.functions: inline 'on-bits' per Joe Groff's suggestion.

db4
John Benediktsson 2011-09-22 13:44:30 -07:00
parent aa880f46ca
commit 96c710a7b7
1 changed files with 2 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/math/functions/functions.factor
View File

@ -156,24 +156,19 @@ M: real absq sq ; inline
: >=1? ( x -- ? ) : >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline dup complex? [ drop f ] [ 1 >= ] if ; inline
<PRIVATE
! to avoid circular dependency on math.bitwise
: on-bits ( m -- n ) 2^ 1 - ; inline
PRIVATE>
GENERIC: frexp ( x -- y exp ) GENERIC: frexp ( x -- y exp )
M: float frexp M: float frexp
dup { [ fp-special? ] [ zero? ] } 1|| [ 0 ] [ dup { [ fp-special? ] [ zero? ] } 1|| [ 0 ] [
double>bits double>bits
[ HEX: 800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ] [ HEX: 800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
[ -52 shift 11 on-bits bitand 1022 - ] bi [ -52 shift HEX: 7ff bitand 1022 - ] bi
] if ; inline ] if ; inline
M: integer frexp M: integer frexp
[ 0.0 0 ] [ [ 0.0 0 ] [
dup 0 > [ 1 ] [ abs -1 ] if swap dup log2 [ dup 0 > [ 1 ] [ abs -1 ] if swap dup log2 [
52 swap - shift 52 on-bits bitand 52 swap - shift HEX: 000f,ffff,ffff,ffff bitand
0.5 double>bits bitor bits>double 0.5 double>bits bitor bits>double
] [ 1 + ] bi [ * ] dip ] [ 1 + ] bi [ * ] dip
] if-zero ; inline ] if-zero ; inline