diff --git a/BUGS b/BUGS index 9730d52..26af0e5 100644 --- a/BUGS +++ b/BUGS @@ -1,4 +1,6 @@ BUG: +* (exact->inexact (/ (expt 2 3000) (- (expt 2 3000) 1))) + should return 1.0, not +nan.0. * pretty-print goes into infinite loop on cyclic data * set! on global names is not working. diff --git a/bin/ikarus b/bin/ikarus index eb4e821..fb01e5e 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-numerics.c b/bin/ikarus-numerics.c index 1434555..9a53d94 100644 --- a/bin/ikarus-numerics.c +++ b/bin/ikarus-numerics.c @@ -831,10 +831,7 @@ normalize_bignum(int limbs, int sign, ikp r){ } } } - ref(r, 0) = (ikp) - (bignum_tag | - sign | - (limbs << bignum_length_shift)); + ref(r, 0) = (ikp) (bignum_tag | sign | (limbs << bignum_length_shift)); return BN(r+vector_tag); } @@ -954,6 +951,7 @@ ikrt_bnbncomp(ikp bn1, ikp bn2){ } } +/* FIXME: Too complicated! */ ikp ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){ int n1 = unfix(x); @@ -1014,6 +1012,31 @@ count_leading_ffs(int n, unsigned int* x){ return n; } +static void +bits_compliment(unsigned int* src, unsigned int* dst, int n){ + int carry = 1; + int i; + for(i=0; i> bignum_length_shift; if(bignum_sign_mask & (unsigned int) xfst){ if(bignum_sign_mask & (unsigned int) yfst){ - fprintf(stderr, "not yet for bnbnlogand\n"); - exit(-1); + unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag)); + unsigned int* s2 = ((unsigned int*)(y+disp_bignum_data-vector_tag)); + if(n1 >= n2){ + ikp r = ik_alloc(pcb, align(disp_bignum_data + n1*wordsize)); + unsigned int* s = ((unsigned int*)(r+disp_bignum_data)); + bits_compliment(s1, s, n1); + bits_compliment_logand(s2, s, s, n2); + bits_compliment(s, s, n1); + return normalize_bignum(n1, 1<= 0){ - unsigned int t = s1[i] & (1+~s2[i]); - if(t != 0){ - if((i == 0) && (t <= most_positive_fixnum)){ - return fix(t); - } - ikp r = ik_alloc(pcb, align(disp_bignum_data+(i+1)*wordsize)); - ref(r, 0) = (ikp) (bignum_tag | ((i+1) << bignum_length_shift)); - unsigned int* s = (unsigned int*)(r+disp_bignum_data); - s[i] = t; - for(i--; i>=0; i--){ - s[i] = s1[i] & (1+~s2[i]); - } - return r+vector_tag; - } else { - i--; - } - } - return 0; - } else { - fprintf(stderr, "not yet for bnbnlogand\n"); - exit(-1); - } + ikp r = ik_alloc(pcb, align(disp_bignum_data + n1*wordsize)); + unsigned int* s = ((unsigned int*)(r+disp_bignum_data)); + bits_compliment_logand(s2, s1, s, n1); + return normalize_bignum(n1, 0, r); } else { /* both positive */ int n = (n1flonum x)] [(8) (bignum/8->flonum x)] [else (bignum/n->flonum x bytes)])))) + (define (ratnum->flonum x) - (binary/ (exact->inexact ($ratnum-n x)) - (exact->inexact ($ratnum-d x)))) + (let f ([n ($ratnum-n x)] [d ($ratnum-d x)]) + (let-values ([(q r) (quotient+remainder n d)]) + (if (= q 0) + (/ 1.0 (f d n)) + (if (= r 0) + (inexact q) + (+ q (f r d))))))) + ;(binary/ (exact->inexact ($ratnum-n x)) + ; (exact->inexact ($ratnum-d x)))) (define binary+ (lambda (x y) @@ -610,16 +618,16 @@ [(bignum? y) (foreign-call "ikrt_fxbnlogand" x y)] [else - (error 'logand "~s is not a number" y)])] + (error 'logand "~s is not an exact integer" y)])] [(bignum? x) (cond [(fixnum? y) (foreign-call "ikrt_fxbnlogand" y x)] - [(bignum? y) + [(bignum? y) (foreign-call "ikrt_bnbnlogand" x y)] - [else - (error 'logand "~s is not a number" y)])] - [else (error 'logand "~s is not a number" x)]))) + [else + (error 'logand "~s is not an exact integer" y)])] + [else (error 'logand "~s is not an exact integer" x)]))) (define binary- @@ -1127,8 +1135,7 @@ (cond [(fixnum? x) ($fixnum->flonum x)] [(bignum? x) (bignum->flonum x)] - [(ratnum? x) - (binary/ (exact->inexact ($ratnum-n x)) ($ratnum-d x))] + [(ratnum? x) (ratnum->flonum x)] [else (error 'exact->inexact "~s is not an exact number" x)]))) @@ -1138,8 +1145,7 @@ (cond [(fixnum? x) ($fixnum->flonum x)] [(bignum? x) (bignum->flonum x)] - [(ratnum? x) - (binary/ (exact->inexact ($ratnum-n x)) ($ratnum-d x))] + [(ratnum? x) (ratnum->flonum x)] [(flonum? x) x] [else (error 'inexact "~s is not a number" x)]))) diff --git a/src/run-tests.ss b/src/run-tests.ss index 06639db..0536b13 100755 --- a/src/run-tests.ss +++ b/src/run-tests.ss @@ -5,6 +5,7 @@ (tests bytevectors) (tests strings) (tests numbers) + (tests bignums) (tests bignum-to-flonum) (tests string-to-number)) @@ -28,4 +29,5 @@ (test-bignum-to-flonum) (test-string-to-number) (test-div-and-mod) +(test-bignums) (printf "Happy Happy Joy Joy\n")