* Added tests for bignum->flonum.
This commit is contained in:
parent
cde508d58c
commit
90feb453f5
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -150,48 +150,6 @@ ikrt_fixnum_to_flonum(ikp x, ikpcb* pcb){
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
ikp
|
|
||||||
ikrt_bignum_to_flonum(ikp x, ikpcb* pcb){
|
|
||||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
||||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
||||||
unsigned int fst = (unsigned int) ref(x, -vector_tag);
|
|
||||||
int limbs = (fst >> bignum_length_shift);
|
|
||||||
double fl;
|
|
||||||
if(limbs == 1){
|
|
||||||
fl = ((unsigned int)ref(x, disp_bignum_data - vector_tag));
|
|
||||||
} else if(limbs == 2){
|
|
||||||
fl = ((unsigned int)ref(x, wordsize+disp_bignum_data - vector_tag));
|
|
||||||
fl *= exp2(32);
|
|
||||||
fl += ((unsigned int)ref(x, disp_bignum_data - vector_tag));
|
|
||||||
} else {
|
|
||||||
fl =
|
|
||||||
((unsigned int)ref(x, limbs * wordsize - wordsize +
|
|
||||||
disp_bignum_data - vector_tag));
|
|
||||||
fl *= exp2(32);
|
|
||||||
fl += ((unsigned int)ref(x, limbs * wordsize - (wordsize*2) +
|
|
||||||
disp_bignum_data - vector_tag));
|
|
||||||
fl *= exp2(32);
|
|
||||||
fl += ((unsigned int)ref(x, limbs * wordsize - (wordsize*3) +
|
|
||||||
disp_bignum_data - vector_tag));
|
|
||||||
fl *= exp2(limbs*wordsize*8-wordsize*8*3);
|
|
||||||
}
|
|
||||||
if((fst & bignum_sign_mask) != 0){
|
|
||||||
fl = -fl;
|
|
||||||
}
|
|
||||||
flonum_data(r) = fl;
|
|
||||||
#if 0
|
|
||||||
{
|
|
||||||
int i;
|
|
||||||
unsigned char* p = (unsigned char*)(r+disp_flonum_data-vector_tag);
|
|
||||||
for(i=0; i<8; i++){
|
|
||||||
fprintf(stderr, "%02x ", p[7-i]);
|
|
||||||
}
|
|
||||||
fprintf(stderr, "\n");
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
return r;
|
|
||||||
}
|
|
||||||
|
|
||||||
ikp
|
ikp
|
||||||
ikrt_fl_equal(ikp x, ikp y){
|
ikrt_fl_equal(ikp x, ikp y){
|
||||||
if(flonum_data(x) == flonum_data(y)){
|
if(flonum_data(x) == flonum_data(y)){
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -2,7 +2,8 @@
|
||||||
|
|
||||||
(import (ikarus)
|
(import (ikarus)
|
||||||
(tests reader)
|
(tests reader)
|
||||||
(tests bytevectors))
|
(tests bytevectors)
|
||||||
|
(tests bignum-to-flonum))
|
||||||
|
|
||||||
(define (test-exact-integer-sqrt)
|
(define (test-exact-integer-sqrt)
|
||||||
(define (f i j inc)
|
(define (f i j inc)
|
||||||
|
@ -20,4 +21,5 @@
|
||||||
(test-reader)
|
(test-reader)
|
||||||
(test-bytevectors)
|
(test-bytevectors)
|
||||||
(test-exact-integer-sqrt)
|
(test-exact-integer-sqrt)
|
||||||
|
(test-bignum-to-flonum)
|
||||||
(printf "Happy Happy Joy Joy\n")
|
(printf "Happy Happy Joy Joy\n")
|
||||||
|
|
|
@ -0,0 +1,54 @@
|
||||||
|
|
||||||
|
(library (tests bignum-to-flonum)
|
||||||
|
(export test-bignum-to-flonum)
|
||||||
|
(import (ikarus) (tests framework))
|
||||||
|
(define (t x s)
|
||||||
|
(let ([fl (format "~a" (exact->inexact x))])
|
||||||
|
(unless (string=? s fl)
|
||||||
|
(error 'bignum->flonum
|
||||||
|
"incorrect result for ~s\n expected ~a, \n got ~a" x s fl))))
|
||||||
|
(define-syntax test*
|
||||||
|
(syntax-rules ()
|
||||||
|
[(_ name [num str] ...)
|
||||||
|
(define-tests name
|
||||||
|
[(lambda (x) (string=? str (number->string x))) (exact->inexact num)]
|
||||||
|
...)]))
|
||||||
|
(test* test-bignum-to-flonum
|
||||||
|
(1000000000 "1e9")
|
||||||
|
(2000000000 "2e9")
|
||||||
|
(4000000000 "4e9")
|
||||||
|
(-1000000000 "-1e9")
|
||||||
|
(-2000000000 "-2e9")
|
||||||
|
(-4000000000 "-4e9")
|
||||||
|
( 6000000000 "6e9")
|
||||||
|
(12000000000 "1.2e10")
|
||||||
|
(25000000000 "2.5e10")
|
||||||
|
(50000000000 "5e10")
|
||||||
|
(-6000000000 "-6e9")
|
||||||
|
(-12000000000 "-1.2e10")
|
||||||
|
(-25000000000 "-2.5e10")
|
||||||
|
(-50000000000 "-5e10")
|
||||||
|
(100000000000 "1e11")
|
||||||
|
(200000000000 "2e11")
|
||||||
|
(400000000000 "4e11")
|
||||||
|
(800000000000 "8e11")
|
||||||
|
(-100000000000 "-1e11")
|
||||||
|
(-200000000000 "-2e11")
|
||||||
|
(-400000000000 "-4e11")
|
||||||
|
(-800000000000 "-8e11")
|
||||||
|
(#x1FFFFFFFFFFFFF "9.007199254740991e15")
|
||||||
|
(#x3FFFFFFFFFFFFF "1.8014398509481984e16")
|
||||||
|
(#x7FFFFFFFFFFFFF "3.602879701896397e16")
|
||||||
|
(#xFFFFFFFFFFFFFF "7.205759403792794e16")
|
||||||
|
(#x1FFFFFFFFFFFFFF "1.4411518807585587e17")
|
||||||
|
(#x3FFFFFFFFFFFFFF "2.8823037615171174e17")
|
||||||
|
(#x7FFFFFFFFFFFFFF "5.764607523034235e17")
|
||||||
|
(#xFFFFFFFFFFFFFFF "1.152921504606847e18")
|
||||||
|
(#xFFFFFFFFFFFFFFFF "1.8446744073709552e19")
|
||||||
|
(1000000000000000000000 "1e21")
|
||||||
|
(100000000000000000000000000000 "1e29")
|
||||||
|
(100000000000000000000000000000000000000000000000 "1e47")
|
||||||
|
(-1000000000000000000000 "-1e21")
|
||||||
|
(-100000000000000000000000000000 "-1e29")
|
||||||
|
(-100000000000000000000000000000000000000000000000 "-1e47")))
|
||||||
|
|
Loading…
Reference in New Issue