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

math.functions: whoops, back out mistaken commit.

db4
John Benediktsson 2013-07-24 14:55:13 -07:00
parent c75fc48f23
commit 519652d862
1 changed files with 5 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -187,22 +187,13 @@ M: real absq sq ; inline
: >=1? ( x -- ? ) : >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline dup complex? [ drop f ] [ 1 >= ] if ; inline
<PRIVATE
: fp-normalize ( x -- y exp )
dup abs 0x1.0p-1022 < [ 52 2^ * -52 ] [ 0 ] if ; inline
PRIVATE>
GENERIC: frexp ( x -- y exp ) GENERIC: frexp ( x -- y exp )
M: float frexp M: float frexp
dup fp-special? [ dup zero? ] unless* [ 0 ] [ dup fp-special? [ dup zero? ] unless* [ 0 ] [
fp-normalize [
double>bits double>bits
[ 0x800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ] [ 0x800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
[ -52 shift 0x7ff bitand 1022 - ] bi [ -52 shift 0x7ff bitand 1022 - ] bi
] dip +
] if ; inline ] if ; inline
M: integer frexp M: integer frexp
@ -219,9 +210,8 @@ GENERIC# ldexp 1 ( x exp -- y )
M: float ldexp M: float ldexp
over fp-special? [ over zero? ] unless* [ drop ] [ over fp-special? [ over zero? ] unless* [ drop ] [
[ fp-normalize ] dip [ double>bits dup -52 shift 0x7ff bitand 1023 - ] dip +
[ double>bits dup -52 shift 0x7ff bitand 1023 - ] {
[ + ] [ + ] tri* {
{ [ dup -1074 < ] [ drop 0 copysign ] } { [ dup -1074 < ] [ drop 0 copysign ] }
{ [ dup 1023 > ] [ drop 0 < -1/0. 1/0. ? ] } { [ dup 1023 > ] [ drop 0 < -1/0. 1/0. ? ] }
[ [