* Fixed a bug in that caused exact->inexact to return nans when
given big ratnums. E.g. (exact->inexact (/ (expt 2 3000) (- (expt 2 3000) 1))) now returns 1.0 instead of +nan.0
This commit is contained in:
parent
9d32ae5767
commit
ef1a828f1f
2
BUGS
2
BUGS
|
@ -1,4 +1,6 @@
|
||||||
BUG:
|
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
|
* pretty-print goes into infinite loop on cyclic data
|
||||||
* set! on global names is not working.
|
* set! on global names is not working.
|
||||||
|
|
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -831,10 +831,7 @@ normalize_bignum(int limbs, int sign, ikp r){
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
ref(r, 0) = (ikp)
|
ref(r, 0) = (ikp) (bignum_tag | sign | (limbs << bignum_length_shift));
|
||||||
(bignum_tag |
|
|
||||||
sign |
|
|
||||||
(limbs << bignum_length_shift));
|
|
||||||
return BN(r+vector_tag);
|
return BN(r+vector_tag);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -954,6 +951,7 @@ ikrt_bnbncomp(ikp bn1, ikp bn2){
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* FIXME: Too complicated! */
|
||||||
ikp
|
ikp
|
||||||
ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
|
ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
|
||||||
int n1 = unfix(x);
|
int n1 = unfix(x);
|
||||||
|
@ -1014,6 +1012,31 @@ count_leading_ffs(int n, unsigned int* x){
|
||||||
return n;
|
return n;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
bits_compliment(unsigned int* src, unsigned int* dst, int n){
|
||||||
|
int carry = 1;
|
||||||
|
int i;
|
||||||
|
for(i=0; i<n; i++){
|
||||||
|
unsigned int d = src[i];
|
||||||
|
unsigned int c = carry + ~ d;
|
||||||
|
dst[i] = c;
|
||||||
|
carry = (carry && ! d);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
bits_compliment_logand(unsigned int* s1, unsigned int* s2, unsigned int* dst, int n){
|
||||||
|
int carry = 1;
|
||||||
|
int i;
|
||||||
|
for(i=0; i<n; i++){
|
||||||
|
unsigned int d = s1[i];
|
||||||
|
unsigned int c = carry + ~ d;
|
||||||
|
dst[i] = c & s2[i];
|
||||||
|
carry = (carry && ! d);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
ikp
|
ikp
|
||||||
ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
|
ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
|
||||||
ikp xfst = ref(x, -vector_tag);
|
ikp xfst = ref(x, -vector_tag);
|
||||||
|
@ -1022,8 +1045,18 @@ ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
|
||||||
int n2 = ((unsigned int) yfst) >> bignum_length_shift;
|
int n2 = ((unsigned int) yfst) >> bignum_length_shift;
|
||||||
if(bignum_sign_mask & (unsigned int) xfst){
|
if(bignum_sign_mask & (unsigned int) xfst){
|
||||||
if(bignum_sign_mask & (unsigned int) yfst){
|
if(bignum_sign_mask & (unsigned int) yfst){
|
||||||
fprintf(stderr, "not yet for bnbnlogand\n");
|
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
|
||||||
exit(-1);
|
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<<bignum_sign_shift, r);
|
||||||
|
} else {
|
||||||
|
return ikrt_bnbnlogand(y,x,pcb);
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
return ikrt_bnbnlogand(y,x,pcb);
|
return ikrt_bnbnlogand(y,x,pcb);
|
||||||
}
|
}
|
||||||
|
@ -1033,31 +1066,10 @@ ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
|
||||||
/* the result is at most n1 words long */
|
/* the result is at most n1 words long */
|
||||||
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
|
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
|
||||||
unsigned int* s2 = ((unsigned int*)(y+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));
|
||||||
int i = n1-1;
|
unsigned int* s = ((unsigned int*)(r+disp_bignum_data));
|
||||||
while(i >= 0){
|
bits_compliment_logand(s2, s1, s, n1);
|
||||||
unsigned int t = s1[i] & (1+~s2[i]);
|
return normalize_bignum(n1, 0, r);
|
||||||
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);
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
/* both positive */
|
/* both positive */
|
||||||
int n = (n1<n2)?n1:n2;
|
int n = (n1<n2)?n1:n2;
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -537,9 +537,17 @@
|
||||||
[(4) (bignum/4->flonum x)]
|
[(4) (bignum/4->flonum x)]
|
||||||
[(8) (bignum/8->flonum x)]
|
[(8) (bignum/8->flonum x)]
|
||||||
[else (bignum/n->flonum x bytes)]))))
|
[else (bignum/n->flonum x bytes)]))))
|
||||||
|
|
||||||
(define (ratnum->flonum x)
|
(define (ratnum->flonum x)
|
||||||
(binary/ (exact->inexact ($ratnum-n x))
|
(let f ([n ($ratnum-n x)] [d ($ratnum-d x)])
|
||||||
(exact->inexact ($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+
|
(define binary+
|
||||||
(lambda (x y)
|
(lambda (x y)
|
||||||
|
@ -610,16 +618,16 @@
|
||||||
[(bignum? y)
|
[(bignum? y)
|
||||||
(foreign-call "ikrt_fxbnlogand" x y)]
|
(foreign-call "ikrt_fxbnlogand" x y)]
|
||||||
[else
|
[else
|
||||||
(error 'logand "~s is not a number" y)])]
|
(error 'logand "~s is not an exact integer" y)])]
|
||||||
[(bignum? x)
|
[(bignum? x)
|
||||||
(cond
|
(cond
|
||||||
[(fixnum? y)
|
[(fixnum? y)
|
||||||
(foreign-call "ikrt_fxbnlogand" y x)]
|
(foreign-call "ikrt_fxbnlogand" y x)]
|
||||||
[(bignum? y)
|
[(bignum? y)
|
||||||
(foreign-call "ikrt_bnbnlogand" x y)]
|
(foreign-call "ikrt_bnbnlogand" x y)]
|
||||||
[else
|
[else
|
||||||
(error 'logand "~s is not a number" y)])]
|
(error 'logand "~s is not an exact integer" y)])]
|
||||||
[else (error 'logand "~s is not a number" x)])))
|
[else (error 'logand "~s is not an exact integer" x)])))
|
||||||
|
|
||||||
|
|
||||||
(define binary-
|
(define binary-
|
||||||
|
@ -1127,8 +1135,7 @@
|
||||||
(cond
|
(cond
|
||||||
[(fixnum? x) ($fixnum->flonum x)]
|
[(fixnum? x) ($fixnum->flonum x)]
|
||||||
[(bignum? x) (bignum->flonum x)]
|
[(bignum? x) (bignum->flonum x)]
|
||||||
[(ratnum? x)
|
[(ratnum? x) (ratnum->flonum x)]
|
||||||
(binary/ (exact->inexact ($ratnum-n x)) ($ratnum-d x))]
|
|
||||||
[else
|
[else
|
||||||
(error 'exact->inexact
|
(error 'exact->inexact
|
||||||
"~s is not an exact number" x)])))
|
"~s is not an exact number" x)])))
|
||||||
|
@ -1138,8 +1145,7 @@
|
||||||
(cond
|
(cond
|
||||||
[(fixnum? x) ($fixnum->flonum x)]
|
[(fixnum? x) ($fixnum->flonum x)]
|
||||||
[(bignum? x) (bignum->flonum x)]
|
[(bignum? x) (bignum->flonum x)]
|
||||||
[(ratnum? x)
|
[(ratnum? x) (ratnum->flonum x)]
|
||||||
(binary/ (exact->inexact ($ratnum-n x)) ($ratnum-d x))]
|
|
||||||
[(flonum? x) x]
|
[(flonum? x) x]
|
||||||
[else
|
[else
|
||||||
(error 'inexact "~s is not a number" x)])))
|
(error 'inexact "~s is not a number" x)])))
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
(tests bytevectors)
|
(tests bytevectors)
|
||||||
(tests strings)
|
(tests strings)
|
||||||
(tests numbers)
|
(tests numbers)
|
||||||
|
(tests bignums)
|
||||||
(tests bignum-to-flonum)
|
(tests bignum-to-flonum)
|
||||||
(tests string-to-number))
|
(tests string-to-number))
|
||||||
|
|
||||||
|
@ -28,4 +29,5 @@
|
||||||
(test-bignum-to-flonum)
|
(test-bignum-to-flonum)
|
||||||
(test-string-to-number)
|
(test-string-to-number)
|
||||||
(test-div-and-mod)
|
(test-div-and-mod)
|
||||||
|
(test-bignums)
|
||||||
(printf "Happy Happy Joy Joy\n")
|
(printf "Happy Happy Joy Joy\n")
|
||||||
|
|
Loading…
Reference in New Issue