Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing distribution of random bignums

Browse source
This commit is contained in:
Alex Shinn 2020-07-29 12:15:20 +09:00
parent 67dcd04d03
commit c726273c3b
1 changed files with 7 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
lib/srfi/27/rand.c
View file

@ -54,11 +54,11 @@ typedef unsigned int sexp_random_t;
#endif #endif
sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) { sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) {
sexp res; sexp_gc_var1(res);
int64_t m; int64_t m;
sexp_int32_t m2; sexp_int32_t m2;
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
sexp_uint_t mod; /* sexp_uint_t mod; */
sexp_uint32_t *data; sexp_uint32_t *data;
sexp_int32_t hi, len, i; sexp_int32_t hi, len, i;
#endif #endif
@ -77,39 +77,17 @@ sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp b
} }
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) { } else if (sexp_bignump(bound)) {
sexp_gc_preserve1(ctx, res);
hi = sexp_bignum_hi(bound); hi = sexp_bignum_hi(bound);
len = hi * (sizeof(sexp_uint_t) / sizeof(sexp_int32_t)); len = hi * (sizeof(sexp_uint_t) / sizeof(sexp_int32_t));
res = sexp_make_bignum(ctx, hi + 1); res = sexp_make_bignum(ctx, hi + 1);
data = (sexp_uint32_t*) sexp_bignum_data(res); data = (sexp_uint32_t*) sexp_bignum_data(res);
for (i=0; i<len; i++) { for (i=0; i<len; i++) {
sexp_call_random(rs, m); sexp_call_random(rs, m2);
data[i] = m; data[i] = m2;
}
/* Scan down, modding bigits > bound to < bound, and stop as */
/* soon as we are sure the result is within bound. */
for (i = hi-1; i >= 0; --i) {
mod = sexp_bignum_data(bound)[i];
if (mod) {
if (i > 0 && mod < SEXP_UINT_T_MAX) {
/* allow non-final bigits to be == */
++mod;
}
if (sexp_bignum_data(res)[i] >= mod)
sexp_bignum_data(res)[i] %= mod;
} else {
sexp_bignum_data(res)[i] = 0;
}
if (sexp_bignum_data(res)[i] < sexp_bignum_data(bound)[i]) {
break;
}
if (i == 0) {
/* handle the case where all bigits are == */
if (sexp_bignum_data(res)[i] > 0)
--sexp_bignum_data(res)[i];
else
res = sexp_sub(ctx, res, SEXP_ONE);
}
} }
res = sexp_remainder(ctx, res, bound);
sexp_gc_release1(ctx);
#endif #endif
} else { } else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound); res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound);