sexp sexp_double_to_ratio (sexp ctx, double f) { int sign, i; sexp_gc_var3(res, whole, scale); if (f == trunc(f)) return sexp_bignum_normalize(sexp_double_to_bignum(ctx, f)); sexp_gc_preserve3(ctx, res, whole, scale); whole = sexp_double_to_bignum(ctx, trunc(f)); res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO); scale = SEXP_ONE; sign = (f < 0 ? -1 : 1); for (i=0, f=fabs(f-trunc(f)); f != trunc(f) && i < 15; i++) { res = sexp_bignum_fxmul(ctx, NULL, res, 10, 0); f = f * 10; res = sexp_bignum_fxadd(ctx, res, double_10s_digit(f)); f = f - trunc(f); scale = sexp_mul(ctx, scale, SEXP_TEN); } sexp_bignum_sign(res) = sign; res = sexp_bignum_normalize(res); scale = sexp_bignum_normalize(scale); res = sexp_make_ratio(ctx, res, scale); res = sexp_ratio_normalize(ctx, res, SEXP_FALSE); res = sexp_add(ctx, res, whole); sexp_gc_release3(ctx); 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_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_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); }