static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) {
sexp res;
int32_t m;
#if SEXP_USE_BIGNUMS
int32_t hi, mod, len, i, *data;
#endif
if (! sexp_random_source_p(rs))
res = sexp_type_exception(ctx, self, rs_type_id, rs);
if (sexp_fixnump(bound)) {
sexp_call_random(rs, m);
res = sexp_make_fixnum(m % sexp_unbox_fixnum(bound));
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) {
hi = sexp_bignum_hi(bound);
len = hi * sizeof(sexp_uint_t) / sizeof(int32_t);
res = sexp_make_bignum(ctx, hi);
data = (int32_t*) sexp_bignum_data(res);
for (i=0; i<len-1; i++) {
sexp_call_random(rs, m);
data[i] = m;
}
sexp_call_random(rs, m);
mod = sexp_bignum_data(bound)[hi-1] * sizeof(int32_t) / sizeof(sexp_uint_t);
if (mod)
data[i] = m % mod;
#endif
} else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound);
}
return res;
}
sexp sexp_bignum_mul (sexp ctx, sexp dst, sexp a, sexp b) {
sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b), i,
*bdata=sexp_bignum_data(b);
sexp_gc_var2(c, d);
if (alen < blen) return sexp_bignum_mul(ctx, dst, b, a);
sexp_gc_preserve2(ctx, c, d);
c = (dst ? dst : sexp_make_bignum(ctx, alen+blen+1));
d = sexp_make_bignum(ctx, alen+blen+1);
for (i=0; i<blen; i++) {
d = sexp_bignum_fxmul(ctx, d, a, bdata[i], i);
c = sexp_bignum_add_digits(ctx, NULL, c, d);
sexp_bignum_data(d)[i] = 0;
}
sexp_bignum_sign(c) = sexp_bignum_sign(a) * sexp_bignum_sign(b);
sexp_gc_release2(ctx);
return c;
}
sexp sexp_make_unsigned_integer (sexp ctx, sexp_luint_t x) {
sexp res;
if (x <= SEXP_MAX_FIXNUM) {
res = sexp_make_fixnum(x);
} else {
res = sexp_make_bignum(ctx, 1);
sexp_bignum_sign(res) = 1;
sexp_bignum_data(res)[0] = x;
}
return res;
}
sexp sexp_make_integer (sexp ctx, sexp_lsint_t x) {
sexp res;
if ((SEXP_MIN_FIXNUM <= x) && (x <= SEXP_MAX_FIXNUM)) {
res = sexp_make_fixnum(x);
} else {
res = sexp_make_bignum(ctx, 1);
if (x < 0) {
sexp_bignum_sign(res) = -1;
sexp_bignum_data(res)[0] = -x;
} else {
sexp_bignum_sign(res) = 1;
sexp_bignum_data(res)[0] = x;
}
}
return res;
}
sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
signed char sign, sexp_uint_t base) {
int c, digit;
sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res);
res = sexp_make_bignum(ctx, SEXP_INIT_BIGNUM_SIZE);
sexp_bignum_sign(res) = sign;
sexp_bignum_data(res)[0] = init;
for (c=sexp_read_char(ctx, in); sexp_isxdigit(c); c=sexp_read_char(ctx, in)) {
digit = digit_value(c);
if ((digit < 0) || (digit >= base))
break;
res = sexp_bignum_fxmul(ctx, res, res, base, 0);
res = sexp_bignum_fxadd(ctx, res, digit);
}
if (c=='.' || c=='e' || c=='E') {
if (base != 10) {
res = sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in);
} else {
if (c!='.') sexp_push_char(ctx, c, in); /* push the e back */
res = sexp_read_float_tail(ctx, in, sexp_bignum_to_double(res), (sign==-1));
}
#if SEXP_USE_RATIOS
} else if (c=='/') {
res = sexp_bignum_normalize(res);
res = sexp_make_ratio(ctx, res, SEXP_ONE);
sexp_ratio_denominator(res) = sexp_read_number(ctx, in, 10);
res = sexp_ratio_normalize(ctx, res, in);
#endif
#if SEXP_USE_COMPLEX
} else if (c=='i' || c=='i' || c=='+' || c=='-') {
sexp_push_char(ctx, c, in);
res = sexp_bignum_normalize(res);
res = sexp_read_complex_tail(ctx, in, res);
#endif
} else if ((c!=EOF) && ! sexp_is_separator(c)) {
res = sexp_read_error(ctx, "invalid numeric syntax",
sexp_make_character(c), in);
} else {
sexp_push_char(ctx, c, in);
}
sexp_gc_release1(ctx);
return sexp_bignum_normalize(res);
}
sexp sexp_bignum_fxmul (sexp ctx, sexp d, sexp a, sexp_uint_t b, int offset) {
sexp_uint_t len=sexp_bignum_length(a), *data, *adata=sexp_bignum_data(a),
carry=0, i;
sexp_luint_t n;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
if ((! d) || (sexp_bignum_length(d)+offset < len))
d = tmp = sexp_make_bignum(ctx, len);
data = sexp_bignum_data(d);
for (i=0; i<len; i++) {
n = (sexp_luint_t)adata[i]*b + carry;
data[i+offset] = (sexp_uint_t)n;
carry = n >> (sizeof(sexp_uint_t)*8);
}
if (carry) {
if (sexp_bignum_length(d)+offset <= len)
d = sexp_copy_bignum(ctx, NULL, d, len+offset+1);
sexp_bignum_data(d)[len+offset] = carry;
}
sexp_gc_release1(ctx);
return d;
}
sexp sexp_fixnum_to_bignum (sexp ctx, sexp a) {
sexp res = sexp_make_bignum(ctx, 1);
sexp_bignum_data(res)[0] = sexp_unbox_fixnum(sexp_fx_abs(a));
sexp_bignum_sign(res) = sexp_fx_sign(a);
return res;
}
