clean up math.floating-point

db4
Doug Coleman 2008-11-11 13:05:48 -06:00
parent 5c03aad985
commit 4caf275b1f
1 changed files with 26 additions and 18 deletions

View File

@ -1,32 +1,40 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences ;
USING: kernel math sequences prettyprint math.parser io
math.functions ;
IN: math.floating-point
: float-sign ( float -- ? )
float>bits -31 shift { 1 -1 } nth ;
: (double-sign) ( bits -- n ) -63 shift ; inline
: double-sign ( double -- n ) double>bits (double-sign) ;
: double-sign ( float -- ? )
double>bits -63 shift { 1 -1 } nth ;
: float-exponent-bits ( float -- n )
float>bits -23 shift 8 2^ 1- bitand ;
: (double-exponent-bits) ( bits -- n )
-52 shift 11 2^ 1- bitand ; inline
: double-exponent-bits ( double -- n )
double>bits -52 shift 11 2^ 1- bitand ;
double>bits (double-exponent-bits) ;
: float-mantissa-bits ( float -- n )
float>bits 23 2^ 1- bitand ;
: (double-mantissa-bits) ( double -- n )
52 2^ 1- bitand ;
: double-mantissa-bits ( double -- n )
double>bits 52 2^ 1- bitand ;
double>bits (double-mantissa-bits) ;
: float-e ( -- float ) 127 ; inline
: double-e ( -- float ) 1023 ; inline
: >double ( S E M -- frac )
[ 52 shift ] dip
[ 63 shift ] 2dip bitor bitor bits>double ;
! : calculate-float ( S M E -- float )
! float-e - 2^ * * ; ! bits>float ;
: >double< ( double -- S E M )
double>bits
[ (double-sign) ]
[ (double-exponent-bits) ]
[ (double-mantissa-bits) ] tri ;
! : calculate-double ( S M E -- frac )
! double-e - 2^ swap 52 2^ /f 1+ * * ;
: double. ( double -- )
double>bits
[ (double-sign) .b ]
[ (double-exponent-bits) >bin 11 CHAR: 0 pad-left bl print ]
[
(double-mantissa-bits) >bin 52 CHAR: 0 pad-left
11 [ bl ] times print
] tri ;