static sexp sexp_make_custom_port (sexp ctx, sexp self,
char *mode, sexp read, sexp write,
sexp seek, sexp close) {
sexp vec;
sexp_gc_var2(res, str);
sexp_gc_preserve2(ctx, res, str);
str = sexp_make_string(ctx, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE), SEXP_VOID);
if (sexp_exceptionp(str)) return str;
res = sexp_open_input_string(ctx, str);
if (sexp_exceptionp(res)) return res;
if (mode && mode[0] == 'w') {
sexp_pointer_tag(res) = SEXP_OPORT;
sexp_port_cookie(res) = str;
} else {
sexp_port_offset(res) = 0;
sexp_port_size(res) = 0;
}
vec = sexp_make_vector(ctx, SEXP_SIX, SEXP_VOID);
if (sexp_exceptionp(vec)) return vec;
sexp_vector_set(vec, SEXP_ZERO, SEXP_FALSE);
sexp_vector_set(vec, SEXP_ONE, sexp_port_cookie(res));
sexp_vector_set(vec, SEXP_TWO, read);
sexp_vector_set(vec, SEXP_THREE, write);
sexp_vector_set(vec, SEXP_FOUR, seek);
sexp_vector_set(vec, SEXP_FIVE, close);
sexp_port_cookie(res) = vec;
sexp_gc_release2(ctx);
return res;
}
static sexp sexp_free_sizes (sexp ctx, sexp self, sexp_sint_t n) {
size_t freed;
sexp_uint_t sizes[512];
sexp_sint_t i;
sexp_heap h = sexp_context_heap(ctx);
sexp_free_list q;
sexp_gc_var2(res, tmp);
/* run gc once to remove unused variables */
sexp_gc(ctx, &freed);
/* initialize stats */
for (i=0; i<512; i++)
sizes[i]=0;
/* loop over each free block */
for ( ; h; h=h->next)
for (q=h->free_list; q; q=q->next)
sizes[sexp_heap_chunks(q->size) > 511 ? 511 : sexp_heap_chunks(q->size)]++;
/* build and return results */
sexp_gc_preserve2(ctx, res, tmp);
res = SEXP_NULL;
for (i=511; i>=0; i--)
if (sizes[i]) {
tmp = sexp_cons(ctx, sexp_make_fixnum(i), sexp_make_fixnum(sizes[i]));
res = sexp_cons(ctx, tmp, res);
}
sexp_gc_release2(ctx);
return res;
}
static void sexp_define_type_predicate_by_tag (sexp ctx, sexp env, char *cname, sexp_uint_t type) {
sexp_gc_var2(name, op);
sexp_gc_preserve2(ctx, name, op);
name = sexp_c_string(ctx, cname, -1);
op = sexp_make_type_predicate(ctx, name, sexp_make_fixnum(type));
sexp_env_define(ctx, env, name=sexp_intern(ctx, cname, -1), op);
sexp_gc_release2(ctx);
}
sexp sexp_ratio_compare (sexp ctx, sexp a, sexp b) {
sexp_gc_var2(a2, b2);
sexp_gc_preserve2(ctx, a2, b2);
a2 = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(b));
b2 = sexp_mul(ctx, sexp_ratio_numerator(b), sexp_ratio_denominator(a));
a2 = sexp_compare(ctx, a2, b2);
sexp_gc_release2(ctx);
return a2;
}
sexp sexp_open_input_bytevector (sexp ctx, sexp self, sexp vec) {
sexp_gc_var2(str, res);
sexp_assert_type(ctx, sexp_bytesp, SEXP_BYTES, vec);
sexp_gc_preserve2(ctx, str, res);
str = sexp_bytes_to_string(ctx, vec);
res = sexp_open_input_string(ctx, str);
sexp_port_binaryp(res) = 1;
sexp_gc_release2(ctx);
return res;
}
sexp sexp_complex_sub (sexp ctx, sexp a, sexp b) {
sexp_gc_var2(res, tmp);
sexp_gc_preserve2(ctx, res, tmp);
tmp = sexp_make_complex(ctx, sexp_complex_real(b), sexp_complex_imag(b));
sexp_negate(sexp_complex_real(tmp));
sexp_negate(sexp_complex_imag(tmp));
res = sexp_complex_add(ctx, a, tmp);
sexp_gc_release2(ctx);
return res;
}
sexp sexp_complex_tan (sexp ctx, sexp z) {
sexp res;
sexp_gc_var2(sin, cos);
sexp_gc_preserve2(ctx, sin, cos);
sin = sexp_complex_sin(ctx, z);
cos = sexp_complex_cos(ctx, z);
res = sexp_complex_div(ctx, sin, cos);
sexp_gc_release2(ctx);
return res;
}
static sexp sexp_add_import_binding (sexp ctx, sexp env) {
sexp_gc_var2(sym, tmp);
sexp_gc_preserve2(ctx, sym, tmp);
sym = sexp_intern(ctx, "repl-import", -1);
tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID);
sym = sexp_intern(ctx, "import", -1);
sexp_env_define(ctx, env, sym, tmp);
sexp_gc_release3(ctx);
return env;
}
sexp sexp_complex_acos (sexp ctx, sexp z) {
sexp_gc_var2(res, tmp);
sexp_gc_preserve2(ctx, res, tmp);
res = sexp_complex_asin(ctx, z);
tmp = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
sexp_complex_real(tmp) = sexp_make_flonum(ctx, acos(-1)/2);
res = sexp_sub(ctx, tmp, res);
sexp_gc_release2(ctx);
return res;
}
static sexp sexp_optimize (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
sexp_gc_var2(ls, res);
sexp_gc_preserve2(ctx, ls, res);
res = x;
ls = sexp_global(ctx, SEXP_G_OPTIMIZATIONS);
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
res = sexp_apply1(ctx, sexp_cdar(ls), res);
sexp_free_vars(ctx, res, SEXP_NULL);
sexp_gc_release2(ctx);
return res;
}
static void invoke_closure(ffi_cif *cif, void *ret, void **args, void *data)
{
struct callback* cb;
cb = (struct callback*) data;
sexp_gc_var2(call, res);
call = sexp_list1(cb->ctx, cb->proc);
res = sexp_eval(cb->ctx, call, NULL);
sexp_gc_release2(cb->ctx);
}
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);
}
static sexp
sexp_yuniffi_nccc_proc_register(sexp ctx, sexp self, sexp_sint_t n,
sexp proc){
sexp_gc_var2(res, resptr);
REQUIRE(ctx, self, proc, sexp_procedurep, SEXP_PROCEDURE);
sexp_gc_preserve2(ctx, res, resptr);
res = sexp_cons(ctx, ctx, proc);
resptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, (void*)(uintptr_t)res,
SEXP_FALSE, 0);
sexp_preserve_object(ctx, res);
sexp_gc_release2(ctx);
return resptr;
}
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
sexp_gc_var2(name, op);
if (!(sexp_version_compatible(ctx, version, sexp_version)
&& sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
return SEXP_ABI_ERROR;
sexp_gc_preserve2(ctx, name, op);
sexp_define_foreign(ctx, env, "num-parameters", 0, sexp_num_parameters);
op = copy_opcode(ctx, &local_ref_op);
sexp_opcode_name(op) = sexp_c_string(ctx, (char*)sexp_opcode_name(op), -1);
name = sexp_string_to_symbol(ctx, sexp_opcode_name(op));
sexp_env_define(ctx, env, name, op);
sexp_gc_release2(ctx);
return SEXP_VOID;
}
static int sexp_cookie_seeker (void *cookie, off64_t *position, int whence) {
sexp vec = (sexp)cookie, ctx, res;
if (! sexp_procedurep(sexp_cookie_seek(vec))) return -1;
sexp_gc_var2(ctx2, args);
ctx = sexp_cookie_ctx(vec);
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
args = sexp_make_integer(ctx, *position);
args = sexp_list2(ctx, args, sexp_make_fixnum(whence));
res = sexp_apply(ctx, sexp_cookie_seek(vec), args);
if (sexp_fixnump(res))
*position = sexp_unbox_fixnum(res);
sexp_gc_release2(ctx);
return sexp_fixnump(res);
}
sexp sexp_ratio_round (sexp ctx, sexp a) {
sexp_gc_var2(q, r);
sexp_gc_preserve2(ctx, q, r);
q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a));
if ((sexp_ratio_denominator(a) == SEXP_TWO) && sexp_oddp(q)) {
q = sexp_add(ctx, q, (sexp_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE));
} else {
r = sexp_remainder(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a));
r = sexp_mul(ctx, r, SEXP_TWO);
if (sexp_negativep(r)) {sexp_negate(r);}
if (sexp_unbox_fixnum(sexp_compare(ctx, r, sexp_ratio_denominator(a))) > 0)
q = sexp_add(ctx, q, (sexp_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE));
}
sexp_gc_release2(ctx);
return q;
}
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;
}
static void sexp_define_accessors (sexp ctx, sexp env, sexp_uint_t ctype,
sexp_uint_t cindex, char* get, char *set) {
sexp type, index;
sexp_gc_var2(name, op);
sexp_gc_preserve2(ctx, name, op);
type = sexp_make_fixnum(ctype);
index = sexp_make_fixnum(cindex);
if (get) {
op = sexp_make_getter(ctx, name=sexp_c_string(ctx, get, -1), type, index);
sexp_env_define(ctx, env, name=sexp_intern(ctx, get, -1), op);
}
if (set) {
op = sexp_make_setter(ctx, name=sexp_c_string(ctx, set, -1), type, index);
sexp_env_define(ctx, env, name=sexp_intern(ctx, set, -1), op);
}
sexp_gc_release2(ctx);
}
static sexp sexp_translate_opcode_type (sexp ctx, sexp type) {
sexp_gc_var2(res, tmp);
res = type;
if (! res) {
res = sexp_type_by_index(ctx, SEXP_OBJECT);
} if (sexp_fixnump(res)) {
res = sexp_type_by_index(ctx, sexp_unbox_fixnum(res));
} else if (sexp_nullp(res)) { /* opcode list types */
sexp_gc_preserve2(ctx, res, tmp);
tmp = sexp_intern(ctx, "or", -1);
res = sexp_cons(ctx, SEXP_NULL, SEXP_NULL);
res = sexp_cons(ctx, sexp_type_by_index(ctx, SEXP_PAIR), res);
res = sexp_cons(ctx, tmp, res);
sexp_gc_release2(ctx);
}
return res;
}
static ssize_t sexp_cookie_writer (void *cookie, const char *buffer, size_t size)
#endif
{
sexp vec = (sexp)cookie, ctx, res;
if (! sexp_procedurep(sexp_cookie_write(vec))) return -1;
sexp_gc_var2(ctx2, args);
ctx = sexp_cookie_ctx(vec);
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
if (size > sexp_string_length(sexp_cookie_buffer(vec)))
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
memcpy(sexp_string_data(sexp_cookie_buffer(vec)), buffer, size);
args = sexp_list2(ctx, sexp_cookie_buffer(vec), sexp_make_fixnum(size));
res = sexp_apply(ctx, sexp_cookie_write(vec), args);
sexp_gc_release2(ctx);
return (sexp_fixnump(res) ? sexp_unbox_fixnum(res) : -1);
}
sexp sexp_complex_asin (sexp ctx, sexp z) {
sexp_gc_var2(res, tmp);
sexp_gc_preserve2(ctx, res, tmp);
res = sexp_complex_mul(ctx, z, z);
tmp = sexp_make_complex(ctx, SEXP_ONE, SEXP_ZERO);
res = sexp_complex_sub(ctx, tmp, res);
res = sexp_complex_sqrt(ctx, res);
/* tmp = iz */
sexp_complex_real(tmp) = sexp_complex_imag(z);
sexp_negate(sexp_complex_real(tmp));
sexp_complex_imag(tmp) = sexp_complex_real(z);
res = sexp_complex_add(ctx, tmp, res);
tmp = sexp_complex_log(ctx, res);
/* res = -i*tmp */
sexp_complex_real(res) = sexp_complex_imag(tmp);
sexp_complex_imag(res) = sexp_complex_real(tmp);
sexp_negate(sexp_complex_imag(res));
sexp_gc_release2(ctx);
return res;
}
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, sexp_abi_identifier_t abi) {
sexp_gc_var2(name, op);
if (!(sexp_version_compatible(ctx, version, sexp_version)
&& sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
return SEXP_ABI_ERROR;
sexp_gc_preserve2(ctx, name, op);
name = sexp_c_string(ctx, "random-source", -1);
op = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE,
sexp_make_fixnum(sexp_offsetof_slot0),
ONE, ONE, ZERO, ZERO,
sexp_make_fixnum(sexp_sizeof_random), ZERO,
ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL, NULL);
if (sexp_exceptionp(op))
return op;
rs_type_id = sexp_type_tag(op);
name = sexp_c_string(ctx, "random-source?", -1);
op = sexp_make_type_predicate(ctx, name, sexp_make_fixnum(rs_type_id));
name = sexp_intern(ctx, "random-source?", -1);
sexp_env_define(ctx, env, name, op);
sexp_define_foreign(ctx, env, "make-random-source", 0, sexp_make_random_source);
sexp_define_foreign(ctx, env, "%random-integer", 2, sexp_rs_random_integer);
sexp_define_foreign(ctx, env, "random-integer", 1, sexp_random_integer);
sexp_define_foreign(ctx, env, "%random-real", 1, sexp_rs_random_real);
sexp_define_foreign(ctx, env, "random-real", 0, sexp_random_real);
sexp_define_foreign(ctx, env, "random-source-state-ref", 1, sexp_random_source_state_ref);
sexp_define_foreign(ctx, env, "random-source-state-set!", 2, sexp_random_source_state_set);
sexp_define_foreign(ctx, env, "random-source-randomize!", 1, sexp_random_source_randomize);
sexp_define_foreign(ctx, env, "random-source-pseudo-randomize!", 2, sexp_random_source_pseudo_randomize);
default_random_source = op = sexp_make_random_source(ctx, NULL, 0);
name = sexp_intern(ctx, "default-random-source", -1);
sexp_env_define(ctx, env, name, default_random_source);
sexp_random_source_randomize(ctx, NULL, 0, default_random_source);
sexp_gc_release2(ctx);
return SEXP_VOID;
}
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;
}
static ssize_t sexp_cookie_reader (void *cookie, char *buffer, size_t size)
#endif
{
sexp vec = (sexp)cookie, ctx, res;
if (! sexp_procedurep(sexp_cookie_read(vec))) return -1;
sexp_gc_var2(ctx2, args);
ctx = sexp_cookie_ctx(vec);
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
if (size > sexp_string_size(sexp_cookie_buffer(vec)))
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
args = sexp_list2(ctx, SEXP_ZERO, sexp_make_fixnum(size));
args = sexp_cons(ctx, sexp_cookie_buffer(vec), args);
res = sexp_apply(ctx, sexp_cookie_read(vec), args);
sexp_gc_release2(ctx);
if (sexp_fixnump(res)) {
memcpy(buffer, sexp_string_data(sexp_cookie_buffer(vec)), sexp_unbox_fixnum(res));
return sexp_unbox_fixnum(res);
} else {
return -1;
}
}
sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
sexp_gc_var2(name, op);
sexp_gc_preserve2(ctx, name, op);
name = sexp_c_string(ctx, "random-source", -1);
op = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE,
sexp_make_fixnum(sexp_offsetof_slot0),
ONE, ONE, ZERO, ZERO,
sexp_make_fixnum(sexp_sizeof_random),
ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL);
if (sexp_exceptionp(op))
return op;
rs_type_id = sexp_type_tag(op);
name = sexp_c_string(ctx, "random-source?", -1);
op = sexp_make_type_predicate(ctx, name, sexp_make_fixnum(rs_type_id));
name = sexp_intern(ctx, "random-source?", -1);
sexp_env_define(ctx, env, name, op);
sexp_define_foreign(ctx, env, "make-random-source", 0, sexp_make_random_source);
sexp_define_foreign(ctx, env, "%random-integer", 2, sexp_rs_random_integer);
sexp_define_foreign(ctx, env, "random-integer", 1, sexp_random_integer);
sexp_define_foreign(ctx, env, "%random-real", 1, sexp_rs_random_real);
sexp_define_foreign(ctx, env, "random-real", 0, sexp_random_real);
sexp_define_foreign(ctx, env, "random-source-state-ref", 1, sexp_random_source_state_ref);
sexp_define_foreign(ctx, env, "random-source-state-set!", 2, sexp_random_source_state_set);
sexp_define_foreign(ctx, env, "random-source-randomize!", 1, sexp_random_source_randomize);
sexp_define_foreign(ctx, env, "random-source-pseudo-randomize!", 2, sexp_random_source_pseudo_randomize);
default_random_source = op = sexp_make_random_source(ctx sexp_api_pass(NULL, 0));
name = sexp_intern(ctx, "default-random-source", -1);
sexp_env_define(ctx, env, name, default_random_source);
sexp_random_source_randomize(ctx sexp_api_pass(NULL, 0), default_random_source);
sexp_gc_release2(ctx);
return SEXP_VOID;
}
void run_main (int argc, char **argv) {
char *arg, *impmod, *p;
sexp out=SEXP_FALSE, env=NULL, ctx=NULL;
sexp_sint_t i, j, len, quit=0, print=0, init_loaded=0, fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS;
sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
sexp_gc_var2(tmp, args);
args = SEXP_NULL;
/* parse options */
for (i=1; i < argc && argv[i][0] == '-'; i++) {
switch (argv[i][1]) {
case 'e':
case 'p':
load_init();
print = (argv[i][1] == 'p');
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('e', arg);
tmp = check_exception(ctx, sexp_eval_string(ctx, arg, -1, env));
if (print) {
if (! sexp_oportp(out))
out = sexp_eval_string(ctx, "(current-output-port)", -1, env);
sexp_write(ctx, tmp, out);
sexp_write_char(ctx, '\n', out);
}
quit = 1;
break;
case 'l':
load_init();
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('l', arg);
check_exception(ctx, sexp_load_module_file(ctx, arg, env));
break;
case 'm':
load_init();
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('m', arg);
len = strlen(arg)+strlen(sexp_import_prefix)+strlen(sexp_import_suffix);
impmod = (char*) malloc(len+1);
strcpy(impmod, sexp_import_prefix);
strcpy(impmod+strlen(sexp_import_prefix), arg);
strcpy(impmod+len-+strlen(sexp_import_suffix), sexp_import_suffix);
impmod[len] = '\0';
for (p=impmod; *p; p++)
if (*p == '.') *p=' ';
check_exception(ctx, sexp_eval_string(ctx, impmod, -1, env));
free(impmod);
break;
case 'q':
init_context();
if (! init_loaded++)
sexp_load_standard_ports(ctx, env, stdin, stdout, stderr, 0);
break;
case 'A':
init_context();
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('A', arg);
sexp_add_module_directory(ctx, tmp=sexp_c_string(ctx,arg,-1), SEXP_TRUE);
break;
case 'I':
init_context();
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('I', arg);
sexp_add_module_directory(ctx, tmp=sexp_c_string(ctx,arg,-1), SEXP_FALSE);
break;
case '-':
i++;
goto done_options;
case 'h':
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('h', arg);
heap_size = strtoul(arg, &arg, 0);
if (sexp_isalpha(*arg)) heap_size *= multiplier(*arg++);
if (*arg == '/') {
heap_max_size = strtoul(arg+1, &arg, 0);
if (sexp_isalpha(*arg)) heap_max_size *= multiplier(*arg++);
}
break;
case 'V':
load_init();
if (! sexp_oportp(out))
out = sexp_eval_string(ctx, "(current-output-port)", -1, env);
sexp_write_string(ctx, sexp_version_string, out);
tmp = sexp_env_ref(env, sexp_intern(ctx, "*features*", -1), SEXP_NULL);
sexp_write(ctx, tmp, out);
sexp_newline(ctx, out);
return;
#if SEXP_USE_FOLD_CASE_SYMS
case 'f':
fold_case = 1;
if (ctx) sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE;
break;
#endif
default:
fprintf(stderr, "unknown option: %s\n", argv[i]);
exit_failure();
}
}
done_options:
if (! quit) {
load_init();
if (i < argc)
for (j=argc-1; j>i; j--)
args = sexp_cons(ctx, tmp=sexp_c_string(ctx,argv[j],-1), args);
else
args = sexp_cons(ctx, tmp=sexp_c_string(ctx,argv[0],-1), args);
sexp_env_define(ctx, env, sexp_intern(ctx, sexp_argv_symbol, -1), args);
sexp_eval_string(ctx, sexp_argv_proc, -1, env);
if (i < argc) { /* script usage */
sexp_context_tracep(ctx) = 1;
check_exception(ctx, sexp_load(ctx, tmp=sexp_c_string(ctx, argv[i], -1), env));
tmp = sexp_intern(ctx, "main", -1);
tmp = sexp_env_ref(env, tmp, SEXP_FALSE);
if (sexp_procedurep(tmp)) {
args = sexp_list1(ctx, args);
check_exception(ctx, sexp_apply(ctx, tmp, args));
}
} else {
repl(ctx, env);
}
}
sexp_gc_release2(ctx);
sexp_destroy_context(ctx);
}
