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

Adding sexp_int32_t definition. Fixing SRFI 27 bug on 32 bit machines.

Browse source 
Fixing the random-integer range to allow all results with a bignum bound.
This commit is contained in:
Alex Shinn 2015-04-25 13:01:16 +09:00
parent 2e481d57e9
commit 11cb17835b
2 changed files with 21 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
include/chibi/sexp.h
View file

@ -204,6 +204,7 @@ typedef uint8_t sexp_uint8_t;
# ifdef UINT32_MAX # ifdef UINT32_MAX
# define SEXP_UINT32_DEFINED 1 # define SEXP_UINT32_DEFINED 1
typedef uint32_t sexp_uint32_t; typedef uint32_t sexp_uint32_t;
typedef int32_t sexp_int32_t;
# endif # endif
#else #else
# include <limits.h> # include <limits.h>
@ -214,12 +215,15 @@ typedef unsigned char sexp_uint8_t;
# if UINT_MAX == 4294967295U # if UINT_MAX == 4294967295U
# define SEXP_UINT32_DEFINED 1 # define SEXP_UINT32_DEFINED 1
typedef unsigned int sexp_uint32_t; typedef unsigned int sexp_uint32_t;
typedef int sexp_int32_t;
# elif ULONG_MAX == 4294967295UL # elif ULONG_MAX == 4294967295UL
# define SEXP_UINT32_DEFINED 1 # define SEXP_UINT32_DEFINED 1
typedef unsigned long sexp_uint32_t; typedef unsigned long sexp_uint32_t;
typedef long sexp_int32_t;
# elif USHRT_MAX == 4294967295U # elif USHRT_MAX == 4294967295U
# define SEXP_UINT32_DEFINED 1 # define SEXP_UINT32_DEFINED 1
typedef unsigned short sexp_uint32_t; typedef unsigned short sexp_uint32_t;
typedef short sexp_int32_t;
# endif # endif
#endif #endif

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

@ -47,9 +47,10 @@ typedef unsigned int sexp_random_t;
static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) { static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) {
sexp res; sexp res;
int32_t m; sexp_int32_t m;
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
int32_t hi, mod, len, i, *data; sexp_uint32_t mod;
sexp_int32_t hi, len, i, *data;
#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);
@ -59,16 +60,24 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs,
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) { } else if (sexp_bignump(bound)) {
hi = sexp_bignum_hi(bound); hi = sexp_bignum_hi(bound);
len = hi * (sizeof(sexp_uint_t) / sizeof(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 = (int32_t*) sexp_bignum_data(res); data = (sexp_int32_t*) sexp_bignum_data(res);
for (i=0; i<len-1; i++) { for (i=0; i<len-1; i++) {
sexp_call_random(rs, m); sexp_call_random(rs, m);
data[i] = m; data[i] = m;
} }
mod = sexp_bignum_data(bound)[hi-1]; /* Scan down, modding bigits > bound to < bound, and stop as */
if (mod && sexp_bignum_data(res)[hi-1] > 0) /* soon as we are sure the result is within bound. */
sexp_bignum_data(res)[hi-1] %= mod; for (i = hi-1; i >= 0; i++) {
mod = sexp_bignum_data(bound)[i-1];
if (mod && sexp_bignum_data(res)[i-1] > mod) {
sexp_bignum_data(res)[i-1] %= mod;
}
if (sexp_bignum_data(res)[i-1] != mod) {
break;
}
}
#endif #endif
} else { } else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound); res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound);
@ -81,7 +90,7 @@ static sexp sexp_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp bound)
} }
static sexp sexp_rs_random_real (sexp ctx, sexp self, sexp_sint_t n, sexp rs) { static sexp sexp_rs_random_real (sexp ctx, sexp self, sexp_sint_t n, sexp rs) {
int32_t res; sexp_int32_t res;
if (! sexp_random_source_p(rs)) if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs); return sexp_type_exception(ctx, self, rs_type_id, rs);
sexp_call_random(rs, res); sexp_call_random(rs, res);