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); }