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; }
static sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) { sexp res; #if SEXP_USE_BIGNUMS sexp_sint_t len, i; #endif if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y); #if SEXP_USE_BIGNUMS else if (sexp_bignump(y)) res = sexp_bit_and(ctx, self, n, y, x); #endif else res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y); #if SEXP_USE_BIGNUMS } else if (sexp_bignump(x)) { if (sexp_fixnump(y)) { res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]); } else if (sexp_bignump(y)) { if (sexp_bignum_length(x) < sexp_bignum_length(y)) res = sexp_copy_bignum(ctx, NULL, x, 0); else res = sexp_copy_bignum(ctx, NULL, y, 0); for (i=0, len=sexp_bignum_length(res); i<len; i++) sexp_bignum_data(res)[i] = sexp_bignum_data(x)[i] & sexp_bignum_data(y)[i]; } else { res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y); } #endif } else { res = sexp_type_exception(ctx, self, SEXP_FIXNUM, x); } return sexp_bignum_normalize(res); }
sexp sexp_bignum_add_digits (sexp ctx, sexp dst, sexp a, sexp b) { sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b), carry=0, i, n, *adata, *bdata, *cdata; sexp_gc_var1(c); if (alen < blen) return sexp_bignum_add_digits(ctx, dst, b, a); sexp_gc_preserve1(ctx, c); c = ((dst && sexp_bignum_hi(dst) >= alen) ? dst : sexp_copy_bignum(ctx, NULL, a, 0)); adata = sexp_bignum_data(a); bdata = sexp_bignum_data(b); cdata = sexp_bignum_data(c); for (i=0; i<blen; i++) { n = adata[i]; cdata[i] = n + bdata[i] + carry; carry = (n > (SEXP_UINT_T_MAX - bdata[i]) ? 1 : 0); } for ( ; carry && (i<alen); i++) { carry = (cdata[i] == SEXP_UINT_T_MAX-1 ? 1 : 0); cdata[i]++; } if (carry) { c = sexp_copy_bignum(ctx, NULL, c, alen+1); sexp_bignum_data(c)[alen] = 1; } sexp_gc_release1(ctx); return c; }
sexp sexp_bignum_fxadd (sexp ctx, sexp a, sexp_uint_t b) { sexp_uint_t len=sexp_bignum_hi(a), *data=sexp_bignum_data(a), carry=b, i=0, n; do { n = data[i]; data[i] += carry; carry = (n > (SEXP_UINT_T_MAX - carry)); } while (++i<len && carry); if (carry) { a = sexp_copy_bignum(ctx, NULL, a, len+1); sexp_bignum_data(a)[len] = 1; } return a; }
sexp_sint_t sexp_bignum_compare_abs (sexp a, sexp b) { int ai=sexp_bignum_hi(a), bi=sexp_bignum_hi(b); sexp_uint_t *adata=sexp_bignum_data(a), *bdata=sexp_bignum_data(b); if (ai != bi) return ai - bi; for (--ai; ai >= 0; ai--) { if (adata[ai] > bdata[ai]) return 1; else if (adata[ai] < bdata[ai]) return -1; } return 0; }
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_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; }
double sexp_bignum_to_double (sexp a) { double res = 0; sexp_sint_t i; sexp_uint_t *data=sexp_bignum_data(a); for (i=sexp_bignum_hi(a)-1; i>=0; i--) res = res * ((double)SEXP_UINT_T_MAX+1) + data[i]; return res * sexp_bignum_sign(a); }
int sexp_bignum_zerop (sexp a) { int i; sexp_uint_t *data = sexp_bignum_data(a); for (i=sexp_bignum_length(a)-1; i>=0; i--) if (data[i]) return 0; return 1; }
sexp sexp_bignum_fxsub (sexp ctx, sexp a, sexp_uint_t b) { sexp_uint_t *data=sexp_bignum_data(a), borrow, i=0, n; for (borrow=b; borrow; i++) { n = data[i]; data[i] -= borrow; borrow = (n < borrow); } return a; }
sexp sexp_bignum_normalize (sexp a) { sexp_uint_t *data; if ((! sexp_bignump(a)) || (sexp_bignum_hi(a)>1)) return a; data = sexp_bignum_data(a); if ((data[0] > SEXP_MAX_FIXNUM) && ! ((sexp_bignum_sign(a) == -1) && (data[0] == SEXP_MAX_FIXNUM+1))) return a; return sexp_make_fixnum((sexp_sint_t)data[0] * sexp_bignum_sign(a)); }
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_uint_t sexp_bignum_fxdiv (sexp ctx, sexp a, sexp_uint_t b, int offset) { sexp_uint_t len=sexp_bignum_hi(a), *data=sexp_bignum_data(a), q, r=0; int i; sexp_luint_t n = 0; for (i=len-1; i>=offset; i--) { n = (n << sizeof(sexp_uint_t)*8) + data[i]; q = n / b; r = n - (sexp_luint_t)q * b; data[i] = q; n = r; } return r; }
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; }
static sexp sexp_random_source_state_set (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp state) { if (! sexp_random_source_p(rs)) return sexp_type_exception(ctx, self, rs_type_id, rs); else if (sexp_fixnump(state)) *sexp_random_data(rs) = sexp_unbox_fixnum(state); #if SEXP_USE_BIGNUMS else if (sexp_bignump(state)) *sexp_random_data(rs) = sexp_bignum_data(state)[0]*sexp_bignum_sign(state); #endif else return sexp_type_exception(ctx, self, SEXP_FIXNUM, state); return SEXP_VOID; }
sexp sexp_bignum_sub_digits (sexp ctx, sexp dst, sexp a, sexp b) { sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b), borrow=0, i, *adata, *bdata, *cdata; sexp_gc_var1(c); if ((alen < blen) || ((alen == blen) && (sexp_bignum_compare_abs(a, b) < 0))) return sexp_bignum_sub_digits(ctx, dst, b, a); sexp_gc_preserve1(ctx, c); c = ((dst && sexp_bignum_hi(dst) >= alen) ? dst : sexp_copy_bignum(ctx, NULL, a, 0)); adata = sexp_bignum_data(a); bdata = sexp_bignum_data(b); cdata = sexp_bignum_data(c); for (i=0; i<blen; i++) { cdata[i] = adata[i] - bdata[i] - borrow; borrow = (adata[i] < bdata[i] ? 1 : 0); } for ( ; borrow && (i<alen); i++) { borrow = (cdata[i] == 0 ? 1 : 0); cdata[i]--; } sexp_gc_release1(ctx); return c; }
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_uint_t sexp_bignum_hi (sexp a) { sexp_uint_t i=sexp_bignum_length(a)-1; while ((i>0) && ! sexp_bignum_data(a)[i]) i--; return i+1; }
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; }