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_quot_rem (sexp ctx, sexp *rem, sexp a, sexp b) { sexp res; sexp_gc_var4(k, i, a1, b1); sexp_gc_preserve4(ctx, k, i, a1, b1); a1 = sexp_copy_bignum(ctx, NULL, a, 0); sexp_bignum_sign(a1) = 1; b1 = sexp_copy_bignum(ctx, NULL, b, 0); sexp_bignum_sign(b1) = 1; k = sexp_copy_bignum(ctx, NULL, b1, 0); i = sexp_fixnum_to_bignum(ctx, SEXP_ONE); res = quot_step(ctx, rem, a1, b1, k, i); sexp_bignum_sign(res) = sexp_bignum_sign(a) * sexp_bignum_sign(b); if (sexp_bignum_sign(a) < 0) { sexp_negate_exact(*rem); } sexp_gc_release4(ctx); return res; }
sexp sexp_bignum_add_fixnum (sexp ctx, sexp a, sexp b) { sexp_gc_var1(c); sexp_gc_preserve1(ctx, c); c = sexp_copy_bignum(ctx, NULL, a, 0); if (sexp_bignum_sign(c) == sexp_fx_sign(b)) c = sexp_bignum_fxadd(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b))); else c = sexp_bignum_fxsub(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b))); sexp_gc_release1(ctx); return c; }
sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) { sexp_sint_t e = sexp_unbox_fixnum(sexp_fx_abs(b)); sexp_gc_var2(res, acc); sexp_gc_preserve2(ctx, res, acc); res = sexp_fixnum_to_bignum(ctx, SEXP_ONE); acc = sexp_copy_bignum(ctx, NULL, a, 0); for (; e; e>>=1, acc=sexp_bignum_mul(ctx, NULL, acc, acc)) if (e & 1) res = sexp_bignum_mul(ctx, NULL, res, acc); sexp_gc_release2(ctx); return sexp_bignum_normalize(res); }
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 sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base) { int i, str_len, lg_base = log2i(base); char *data; sexp_gc_var2(b, str); sexp_gc_preserve2(ctx, b, str); b = sexp_copy_bignum(ctx, NULL, a, 0); sexp_bignum_sign(b) = 1; i = str_len = (sexp_bignum_length(b)*sizeof(sexp_uint_t)*8 + lg_base - 1) / lg_base + 1; str = sexp_make_string(ctx, sexp_make_fixnum(str_len), sexp_make_character(' ')); data = sexp_string_data(str); while (! sexp_bignum_zerop(b)) data[--i] = hex_digit(sexp_bignum_fxdiv(ctx, b, base, 0)); if (i == str_len) data[--i] = '0'; else if (sexp_bignum_sign(a) == -1) data[--i] = '-'; sexp_write_string(ctx, data + i, out); sexp_gc_release2(ctx); return SEXP_VOID; }
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_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; }