Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 03:36:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing random-integer for real.

Browse source
This commit is contained in:
Alex Shinn 2015-04-25 14:14:32 +09:00
parent 7e80510755
commit e230823cc6
1 changed files with 23 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -49,8 +49,9 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs,
sexp res; sexp res;
sexp_int32_t m; sexp_int32_t m;
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
sexp_uint32_t mod; sexp_uint_t mod;
sexp_int32_t hi, len, i, *data; sexp_uint32_t *data;
sexp_int32_t hi, len, i;
#endif #endif
if (! sexp_random_source_p(rs)) if (! sexp_random_source_p(rs))
res = sexp_type_exception(ctx, self, rs_type_id, rs); res = sexp_type_exception(ctx, self, rs_type_id, rs);
@ -62,21 +63,35 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs,
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_int32_t*) sexp_bignum_data(res); data = (sexp_uint32_t*) sexp_bignum_data(res);
for (i=0; i<len-1; i++) { for (i=0; i<len; i++) {
sexp_call_random(rs, m); sexp_call_random(rs, m);
data[i] = m; data[i] = m;
} }
/* Scan down, modding bigits > bound to < bound, and stop as */ /* Scan down, modding bigits > bound to < bound, and stop as */
/* soon as we are sure the result is within bound. */ /* soon as we are sure the result is within bound. */
for (i = hi-1; i >= 0; i--) { for (i = hi-1; i >= 0; --i) {
mod = sexp_bignum_data(bound)[i]; mod = sexp_bignum_data(bound)[i];
if (mod && sexp_bignum_data(res)[i] > mod) { if (mod) {
sexp_bignum_data(res)[i] %= 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] != mod) { if (sexp_bignum_data(res)[i] < sexp_bignum_data(bound)[i]) {
break; 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);
}
} }
#endif #endif
} else { } else {