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_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; }
_FN1(_I(SEXP_OPORT), _I(SEXP_STRING), "open-binary-output-file", 0, sexp_open_binary_output_file), _FN1(SEXP_VOID, _I(SEXP_IPORT), "close-input-port", 0, sexp_close_port_op), _FN1(SEXP_VOID, _I(SEXP_OPORT), "close-output-port", 0, sexp_close_port_op), _FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_ENV), "env-parent", 0, sexp_env_parent_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "primitive-environment", 0, sexp_make_primitive_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op), _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op), _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "generate", (sexp)"interaction-environment", sexp_generate_op), _FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "%load", (sexp)"interaction-environment", sexp_load_op), _FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%import", 0, sexp_env_import_op), _FN2OPTP(SEXP_VOID, _I(SEXP_EXCEPTION), _I(SEXP_OPORT), "print-exception", (sexp)"current-error-port", sexp_print_exception_op), _FN1OPTP(SEXP_VOID, _I(SEXP_OPORT), "print-stack-trace", (sexp)"current-error-port", sexp_stack_trace_op), _FN3OPT(SEXP_VOID, _I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_OBJECT), "warn-undefs", SEXP_FALSE, sexp_warn_undefs_op), _FN2OPT(_I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_CHAR), "make-string", sexp_make_character(' '), sexp_make_string_op), _FN2OPT(_I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "make-bytevector", SEXP_ZERO, sexp_make_bytes_op), _FN2OPT(_I(SEXP_NUMBER), _I(SEXP_STRING), _I(SEXP_FIXNUM), "string->number", SEXP_TEN, sexp_string_to_number_op), _FN3(_I(SEXP_FIXNUM), _I(SEXP_STRING), _I(SEXP_STRING), _I(SEXP_BOOLEAN), "string-cmp", 0, sexp_string_cmp_op), _FN1(_I(SEXP_SYMBOL), _I(SEXP_STRING), "string->symbol", 0, sexp_string_to_symbol_op), _FN1(_I(SEXP_STRING), _I(SEXP_SYMBOL), "symbol->string", 0, sexp_symbol_to_string_op), _FN2OPT(_I(SEXP_STRING), SEXP_NULL, _I(SEXP_STRING), "string-concatenate", SEXP_FALSE, sexp_string_concatenate_op), _FN2(_I(SEXP_OBJECT), _I(SEXP_OBJECT), SEXP_NULL, "memq", 0, sexp_memq_op), _FN2(_I(SEXP_OBJECT), _I(SEXP_OBJECT), SEXP_NULL, "assq", 0, sexp_assq_op), _FN3(_I(SEXP_SYNCLO), _I(SEXP_ENV), SEXP_NULL, _I(SEXP_OBJECT), "make-syntactic-closure", 0, sexp_make_synclo_op), _FN1(_I(SEXP_OBJECT), _I(SEXP_OBJECT), "strip-syntactic-closures", 0, sexp_strip_synclos), _FN0(_I(SEXP_OPORT), "open-output-string", 0, sexp_open_output_string_op), _FN1(_I(SEXP_IPORT), _I(SEXP_STRING), "open-input-string", 0, sexp_open_input_string_op), _FN1(_I(SEXP_STRING), _I(SEXP_OPORT), "get-output-string", 0, sexp_get_output_string_op), _FN2OPT(_I(SEXP_IPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-input-file-descriptor", SEXP_FALSE, sexp_open_input_file_descriptor), _FN2OPT(_I(SEXP_OPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-output-file-descriptor", SEXP_FALSE, sexp_open_output_file_descriptor),