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_read_u8 (sexp ctx, sexp self, sexp in) {
int c;
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
if (!sexp_port_binaryp(in))
return sexp_xtype_exception(ctx, self, "not a binary port", in);
#if SEXP_USE_GREEN_THREADS
errno = 0;
#endif
c = sexp_read_char(ctx, in);
#if SEXP_USE_GREEN_THREADS
if ((c == EOF)
&& (errno == EAGAIN)) {
if (sexp_port_stream(in))
clearerr(sexp_port_stream(in));
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), in);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
}
#endif
if (c == '\n') sexp_port_line(in)++;
return (c==EOF) ? SEXP_EOF : sexp_make_fixnum(c);
}
