Remove bignum>float VM primitive, and use bignum/f to implement >float on bignums instead, for a slight accuracy gain. Also, bignum/f now has a more efficient post-scaling algorithm to break the circular dependency on bignum>float

db4
Slava Pestov 2010-11-16 03:13:15 -08:00
parent ac0233ce7b
commit f27080498d
11 changed files with 29 additions and 66 deletions

View File

@ -3,9 +3,9 @@
USING: accessors arrays assocs byte-arrays byte-vectors classes USING: accessors arrays assocs byte-arrays byte-vectors classes
combinators definitions effects fry generic generic.single combinators definitions effects fry generic generic.single
generic.standard hashtables io.binary io.encodings generic.standard hashtables io.binary io.encodings
io.streams.string kernel kernel.private math io.streams.string kernel kernel.private math math.parser
math.integers.private math.parser namespaces parser sbufs namespaces parser sbufs sequences splitting splitting.private
sequences splitting splitting.private strings vectors words ; strings vectors words ;
IN: hints IN: hints
GENERIC: specializer-predicate ( spec -- quot ) GENERIC: specializer-predicate ( spec -- quot )
@ -130,6 +130,4 @@ M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-pr
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
\ bignum/f { { bignum bignum } { bignum fixnum } { fixnum bignum } { fixnum fixnum } } "specializer" set-word-prop
\ encode-string { string object object } "specializer" set-word-prop \ encode-string { string object object } "specializer" set-word-prop

View File

@ -338,7 +338,6 @@ M: object infer-call* \ call bad-macro-input ;
\ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable \ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable
\ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable \ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable
\ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable \ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable
\ bignum>float { bignum } { float } define-primitive \ bignum>float make-foldable
\ bits>double { integer } { float } define-primitive \ bits>double make-foldable \ bits>double { integer } { float } define-primitive \ bits>double make-foldable
\ bits>float { integer } { float } define-primitive \ bits>float make-foldable \ bits>float { integer } { float } define-primitive \ bits>float make-foldable
\ both-fixnums? { object object } { object } define-primitive \ both-fixnums? { object object } { object } define-primitive

View File

@ -491,7 +491,6 @@ tuple
{ "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) } { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
{ "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) } { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
{ "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) } { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
{ "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) }
{ "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) } { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
{ "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) } { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
{ "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) } { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }

View File

@ -7,9 +7,6 @@ IN: math.floats.private
: float-min ( x y -- z ) [ float< ] most ; foldable : float-min ( x y -- z ) [ float< ] most ; foldable
: float-max ( x y -- z ) [ float> ] most ; foldable : float-max ( x y -- z ) [ float> ] most ; foldable
M: fixnum >float fixnum>float ; inline
M: bignum >float bignum>float ; inline
M: float >fixnum float>fixnum ; inline M: float >fixnum float>fixnum ; inline
M: float >bignum float>bignum ; inline M: float >bignum float>bignum ; inline
M: float >float ; inline M: float >float ; inline

View File

@ -14,6 +14,7 @@ M: integer denominator drop 1 ; inline
M: fixnum >fixnum ; inline M: fixnum >fixnum ; inline
M: fixnum >bignum fixnum>bignum ; inline M: fixnum >bignum fixnum>bignum ; inline
M: fixnum >integer ; inline M: fixnum >integer ; inline
M: fixnum >float fixnum>float ; inline
M: fixnum hashcode* nip ; inline M: fixnum hashcode* nip ; inline
M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
@ -37,16 +38,6 @@ M: fixnum - fixnum- ; inline
M: fixnum * fixnum* ; inline M: fixnum * fixnum* ; inline
M: fixnum /i fixnum/i ; inline M: fixnum /i fixnum/i ; inline
DEFER: bignum/f
CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
: fixnum/f ( m n -- m/n )
[ >float ] bi@ float/f ; inline
M: fixnum /f
2dup [ abs bignum/f-threshold >= ] either?
[ bignum/f ] [ fixnum/f ] if ; inline
M: fixnum mod fixnum-mod ; inline M: fixnum mod fixnum-mod ; inline
M: fixnum /mod fixnum/mod ; inline M: fixnum /mod fixnum/mod ; inline
@ -130,15 +121,12 @@ M: bignum (log2) bignum-log2 ; inline
[ /mod ] dip ; inline [ /mod ] dip ; inline
! Third step: post-scaling ! Third step: post-scaling
: unscaled-float ( mantissa -- n ) : scaled-float ( mantissa scale -- n )
52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline [ 52 2^ 1 - bitand ] dip 1022 + 52 shift bitor bits>double ; inline
: scale-float ( mantissa scale -- float' )
dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline
: post-scale ( mantissa scale -- n ) : post-scale ( mantissa scale -- n )
[ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
[ unscaled-float ] dip scale-float ; inline scaled-float ; inline
: round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' ) : round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
over odd? over odd?
@ -157,7 +145,21 @@ M: bignum (log2) bignum-log2 ; inline
] if ; inline ] if ; inline
: bignum/f ( m n -- f ) : bignum/f ( m n -- f )
[ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; inline
M: bignum /f ( m n -- f ) M: bignum /f ( m n -- f ) { bignum bignum } declare bignum/f ;
bignum/f ;
CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
: fixnum/f ( m n -- m/n )
[ >float ] bi@ float/f ; inline
M: fixnum /f
{ fixnum fixnum } declare
2dup [ abs bignum/f-threshold >= ] either?
[ bignum/f ] [ fixnum/f ] if ; inline
: bignum>float ( bignum -- float )
{ bignum } declare 1 >bignum bignum/f ;
M: bignum >float bignum>float ; inline

View File

@ -59,11 +59,7 @@ PRIVATE>
ERROR: log2-expects-positive x ; ERROR: log2-expects-positive x ;
: log2 ( x -- n ) : log2 ( x -- n )
dup 0 <= [ dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline
log2-expects-positive
] [
(log2)
] if ; inline
: zero? ( x -- ? ) 0 number= ; inline : zero? ( x -- ? ) 0 number= ; inline
: 2/ ( x -- y ) -1 shift ; inline : 2/ ( x -- y ) -1 shift ; inline
@ -74,8 +70,8 @@ ERROR: log2-expects-positive x ;
: ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline : ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline
: rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable : rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable
: 2^ ( n -- 2^n ) 1 swap shift ; inline : 2^ ( n -- 2^n ) 1 swap shift ; inline
: even? ( n -- ? ) 1 bitand zero? ; : even? ( n -- ? ) 1 bitand zero? ; inline
: odd? ( n -- ? ) 1 bitand 1 number= ; : odd? ( n -- ? ) 1 bitand 1 number= ; inline
: if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b ) : if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b )
[ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline

View File

@ -381,25 +381,11 @@ FOO_TO_BIGNUM(ulong_long,u64,s64,u64)
} \ } \
} }
BIGNUM_TO_FOO(cell,cell,fixnum,cell); BIGNUM_TO_FOO(cell,cell,fixnum,cell)
BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell); BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell)
BIGNUM_TO_FOO(long_long,s64,s64,u64) BIGNUM_TO_FOO(long_long,s64,s64,u64)
BIGNUM_TO_FOO(ulong_long,u64,s64,u64) BIGNUM_TO_FOO(ulong_long,u64,s64,u64)
double factor_vm::bignum_to_double(bignum * bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (0);
{
double accumulator = 0;
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
while (start < scan)
accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
}
}
#define DTB_WRITE_DIGIT(factor) \ #define DTB_WRITE_DIGIT(factor) \
{ \ { \
significand *= (factor); \ significand *= (factor); \

View File

@ -255,11 +255,6 @@ void factor_vm::primitive_fixnum_to_float()
ctx->replace(allot_float(fixnum_to_float(ctx->peek()))); ctx->replace(allot_float(fixnum_to_float(ctx->peek())));
} }
void factor_vm::primitive_bignum_to_float()
{
ctx->replace(allot_float(bignum_to_float(ctx->peek())));
}
void factor_vm::primitive_format_float() void factor_vm::primitive_format_float()
{ {
byte_array *array = allot_byte_array(100); byte_array *array = allot_byte_array(100);

View File

@ -33,11 +33,6 @@ inline bignum *factor_vm::float_to_bignum(cell tagged)
return double_to_bignum(untag_float(tagged)); return double_to_bignum(untag_float(tagged));
} }
inline double factor_vm::bignum_to_float(cell tagged)
{
return bignum_to_double(untag<bignum>(tagged));
}
inline double factor_vm::untag_float(cell tagged) inline double factor_vm::untag_float(cell tagged)
{ {
return untag<boxed_float>(tagged)->n; return untag<boxed_float>(tagged)->n;

View File

@ -27,7 +27,6 @@ namespace factor
_(bignum_shift) \ _(bignum_shift) \
_(bignum_subtract) \ _(bignum_subtract) \
_(bignum_to_fixnum) \ _(bignum_to_fixnum) \
_(bignum_to_float) \
_(bignum_xor) \ _(bignum_xor) \
_(bits_double) \ _(bits_double) \
_(bits_float) \ _(bits_float) \

View File

@ -192,7 +192,6 @@ struct factor_vm
fixnum bignum_to_fixnum(bignum * bignum); fixnum bignum_to_fixnum(bignum * bignum);
s64 bignum_to_long_long(bignum * bignum); s64 bignum_to_long_long(bignum * bignum);
u64 bignum_to_ulong_long(bignum * bignum); u64 bignum_to_ulong_long(bignum * bignum);
double bignum_to_double(bignum * bignum);
bignum *double_to_bignum(double x); bignum *double_to_bignum(double x);
int bignum_equal_p_unsigned(bignum * x, bignum * y); int bignum_equal_p_unsigned(bignum * x, bignum * y);
enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y); enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y);
@ -457,7 +456,6 @@ struct factor_vm
inline cell unbox_array_size(); inline cell unbox_array_size();
cell unbox_array_size_slow(); cell unbox_array_size_slow();
void primitive_fixnum_to_float(); void primitive_fixnum_to_float();
void primitive_bignum_to_float();
void primitive_format_float(); void primitive_format_float();
void primitive_float_eq(); void primitive_float_eq();
void primitive_float_add(); void primitive_float_add();
@ -487,7 +485,6 @@ struct factor_vm
inline cell from_unsigned_cell(cell x); inline cell from_unsigned_cell(cell x);
inline cell allot_float(double n); inline cell allot_float(double n);
inline bignum *float_to_bignum(cell tagged); inline bignum *float_to_bignum(cell tagged);
inline double bignum_to_float(cell tagged);
inline double untag_float(cell tagged); inline double untag_float(cell tagged);
inline double untag_float_check(cell tagged); inline double untag_float_check(cell tagged);
inline fixnum float_to_fixnum(cell tagged); inline fixnum float_to_fixnum(cell tagged);