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; }