mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 06:09:18 +02:00
simplifying gc variable preservation
Adding sexp_gc_var1..6 and corresponding _preserve/release1..6 referring to fixed preservation variable names, to substantially reduce the boilerplate on C functions which produce temporary sexp values. The fixed variable names are safe because we never nest them within the same C function. The original macros are still available for manual naming, block local variables and cases of more than 6 gc vars. Consider combining var+preserve into a single macro, since splitting them is rare.
This commit is contained in:
Alex Shinn
parent
445f8e9fa4
commit
576a20b3bc
4 changed files with 201 additions and 306 deletions
284
eval.c
284
eval.c
|
|
@ -31,16 +31,14 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version);
|
|||
|
||||
static sexp sexp_compile_error(sexp ctx, char *message, sexp obj) {
|
||||
sexp exn;
|
||||
sexp_gc_var(ctx, irritants, s_irr);
|
||||
sexp_gc_var(ctx, msg, s_msg);
|
||||
sexp_gc_preserve(ctx, irritants, s_irr);
|
||||
sexp_gc_preserve(ctx, msg, s_msg);
|
||||
sexp_gc_var2(irritants, msg);
|
||||
sexp_gc_preserve2(ctx, irritants, msg);
|
||||
irritants = sexp_list1(ctx, obj);
|
||||
msg = sexp_c_string(ctx, message, -1);
|
||||
exn = sexp_make_exception(ctx, the_compile_error_symbol, msg, irritants,
|
||||
SEXP_FALSE, (sexp_pairp(obj) ?
|
||||
sexp_pair_source(obj) : SEXP_FALSE));
|
||||
sexp_gc_release(ctx, irritants, s_irr);
|
||||
sexp_gc_release2(ctx);
|
||||
return exn;
|
||||
}
|
||||
|
||||
|
|
@ -60,15 +58,15 @@ static sexp env_cell(sexp e, sexp key) {
|
|||
}
|
||||
|
||||
static sexp env_cell_create(sexp ctx, sexp e, sexp key, sexp value) {
|
||||
sexp_gc_var(ctx, cell, s_cell);
|
||||
sexp_gc_var1(cell);
|
||||
cell = env_cell(e, key);
|
||||
if (! cell) {
|
||||
sexp_gc_preserve(ctx, cell, s_cell);
|
||||
sexp_gc_preserve1(ctx, cell);
|
||||
cell = sexp_cons(ctx, key, value);
|
||||
while (sexp_env_parent(e))
|
||||
e = sexp_env_parent(e);
|
||||
sexp_env_bindings(e) = sexp_cons(ctx, cell, sexp_env_bindings(e));
|
||||
sexp_gc_release(ctx, cell, s_cell);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
return cell;
|
||||
}
|
||||
|
|
@ -83,26 +81,24 @@ static sexp env_global_ref(sexp e, sexp key, sexp dflt) {
|
|||
|
||||
void env_define(sexp ctx, sexp e, sexp key, sexp value) {
|
||||
sexp cell = sexp_assq(ctx, key, sexp_env_bindings(e));
|
||||
sexp_gc_var1(tmp);
|
||||
if (sexp_immutablep(e)) {
|
||||
fprintf(stderr, "ERROR: immutable environment\n");
|
||||
} else {
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
if (sexp_truep(cell))
|
||||
sexp_cdr(cell) = value;
|
||||
else {
|
||||
tmp = sexp_cons(ctx, key, value);
|
||||
sexp_push(ctx, sexp_env_bindings(e), tmp);
|
||||
}
|
||||
sexp_gc_release(ctx, tmp, s_tmp);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
}
|
||||
|
||||
static sexp extend_env (sexp ctx, sexp env, sexp vars, sexp value) {
|
||||
sexp_gc_var(ctx, e, s_e);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, e, s_e);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var2(e, tmp);
|
||||
sexp_gc_preserve2(ctx, e, tmp);
|
||||
e = sexp_alloc_type(ctx, env, SEXP_ENV);
|
||||
sexp_env_parent(e) = env;
|
||||
sexp_env_bindings(e) = SEXP_NULL;
|
||||
|
|
@ -110,13 +106,13 @@ static sexp extend_env (sexp ctx, sexp env, sexp vars, sexp value) {
|
|||
tmp = sexp_cons(ctx, sexp_car(vars), value);
|
||||
sexp_push(ctx, sexp_env_bindings(e), tmp);
|
||||
}
|
||||
sexp_gc_release(ctx, e, s_e);
|
||||
sexp_gc_release2(ctx);
|
||||
return e;
|
||||
}
|
||||
|
||||
static sexp sexp_chain_env (sexp ctx, sexp env1, sexp env2) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
res = env2;
|
||||
if (env1 && sexp_envp(env1)) {
|
||||
res = sexp_alloc_type(ctx, env, SEXP_ENV);
|
||||
|
|
@ -124,16 +120,16 @@ static sexp sexp_chain_env (sexp ctx, sexp env1, sexp env2) {
|
|||
sexp_env_bindings(res) = sexp_env_bindings(env1);
|
||||
sexp_env_lambda(res) = sexp_env_lambda(env1);
|
||||
}
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp sexp_reverse_flatten_dot (sexp ctx, sexp ls) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
for (res=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls))
|
||||
sexp_push(ctx, res, sexp_car(ls));
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return (sexp_nullp(ls) ? res : sexp_cons(ctx, ls, res));
|
||||
}
|
||||
|
||||
|
|
@ -285,8 +281,8 @@ static sexp sexp_make_lit(sexp ctx, sexp value) {
|
|||
#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*INIT_STACK_SIZE)
|
||||
|
||||
sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
||||
sexp_gc_var(ctx, res, save_res);
|
||||
if (ctx) sexp_gc_preserve(ctx, res, save_res);
|
||||
sexp_gc_var1(res);
|
||||
if (ctx) sexp_gc_preserve1(ctx, res);
|
||||
res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
|
||||
if ((! stack) || (stack == SEXP_FALSE)) {
|
||||
stack = sexp_alloc_tagged(ctx, SEXP_STACK_SIZE, SEXP_STACK);
|
||||
|
|
@ -311,7 +307,7 @@ sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
|||
sexp_context_top(res) = 0;
|
||||
sexp_context_tailp(res) = 1;
|
||||
sexp_context_tracep(res) = 0;
|
||||
if (ctx) sexp_gc_release(ctx, res, save_res);
|
||||
if (ctx) sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -338,10 +334,8 @@ static sexp sexp_syntactic_closure_expr (sexp ctx, sexp x) {
|
|||
|
||||
static sexp sexp_strip_synclos (sexp ctx, sexp x) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, kar, s_kar);
|
||||
sexp_gc_var(ctx, kdr, s_kdr);
|
||||
sexp_gc_preserve(ctx, kar, s_kar);
|
||||
sexp_gc_preserve(ctx, kdr, s_kdr);
|
||||
sexp_gc_var2(kar, kdr);
|
||||
sexp_gc_preserve2(ctx, kar, kdr);
|
||||
loop:
|
||||
if (sexp_synclop(x)) {
|
||||
x = sexp_synclo_expr(x);
|
||||
|
|
@ -354,7 +348,7 @@ static sexp sexp_strip_synclos (sexp ctx, sexp x) {
|
|||
} else {
|
||||
res = x;
|
||||
}
|
||||
sexp_gc_release(ctx, kar, s_kar);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -380,10 +374,8 @@ static sexp sexp_identifier_eq(sexp ctx, sexp e1, sexp id1, sexp e2, sexp id2) {
|
|||
/************************* the compiler ***************************/
|
||||
|
||||
static sexp analyze_app (sexp ctx, sexp x) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var2(res, tmp);
|
||||
sexp_gc_preserve2(ctx, res, tmp);
|
||||
for (res=SEXP_NULL; sexp_pairp(x); x=sexp_cdr(x)) {
|
||||
sexp_push(ctx, res, SEXP_FALSE);
|
||||
tmp = analyze(ctx, sexp_car(x));
|
||||
|
|
@ -394,15 +386,13 @@ static sexp analyze_app (sexp ctx, sexp x) {
|
|||
sexp_car(res) = tmp;
|
||||
}
|
||||
}
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release2(ctx);
|
||||
return (sexp_pairp(res) ? sexp_nreverse(ctx, res) : res);
|
||||
}
|
||||
|
||||
static sexp analyze_seq (sexp ctx, sexp ls) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var2(res, tmp);
|
||||
sexp_gc_preserve2(ctx, res, tmp);
|
||||
if (sexp_nullp(ls))
|
||||
res = SEXP_VOID;
|
||||
else if (sexp_nullp(sexp_cdr(ls)))
|
||||
|
|
@ -415,14 +405,14 @@ static sexp analyze_seq (sexp ctx, sexp ls) {
|
|||
else
|
||||
sexp_seq_ls(res) = tmp;
|
||||
}
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_var_ref (sexp ctx, sexp x) {
|
||||
sexp env = sexp_context_env(ctx), res;
|
||||
sexp_gc_var(ctx, cell, s_cell);
|
||||
sexp_gc_preserve(ctx, cell, s_cell);
|
||||
sexp_gc_var1(cell);
|
||||
sexp_gc_preserve1(ctx, cell);
|
||||
cell = env_cell(env, x);
|
||||
if (! cell) {
|
||||
if (sexp_synclop(x)) {
|
||||
|
|
@ -436,16 +426,14 @@ static sexp analyze_var_ref (sexp ctx, sexp x) {
|
|||
res = sexp_compile_error(ctx, "invalid use of syntax as value", x);
|
||||
else
|
||||
res = sexp_make_ref(ctx, x, cell);
|
||||
sexp_gc_release(ctx, cell, s_cell);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_set (sexp ctx, sexp x) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, ref, s_ref);
|
||||
sexp_gc_var(ctx, value, s_value);
|
||||
sexp_gc_preserve(ctx, ref, s_ref);
|
||||
sexp_gc_preserve(ctx, value, s_value);
|
||||
sexp_gc_var2(ref, value);
|
||||
sexp_gc_preserve2(ctx, ref, value);
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x))
|
||||
&& sexp_nullp(sexp_cdddr(x)) && sexp_idp(sexp_cadr(x)))) {
|
||||
res = sexp_compile_error(ctx, "bad set! syntax", x);
|
||||
|
|
@ -461,7 +449,7 @@ static sexp analyze_set (sexp ctx, sexp x) {
|
|||
else
|
||||
res = sexp_make_set(ctx, ref, value);
|
||||
}
|
||||
sexp_gc_release(ctx, ref, s_ref);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -469,18 +457,8 @@ static sexp analyze_set (sexp ctx, sexp x) {
|
|||
|
||||
static sexp analyze_lambda (sexp ctx, sexp x) {
|
||||
sexp name, ls;
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, body, s_body);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, value, s_value);
|
||||
sexp_gc_var(ctx, defs, s_defs);
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, body, s_body);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, value, s_value);
|
||||
sexp_gc_preserve(ctx, defs, s_defs);
|
||||
sexp_gc_preserve(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var6(res, body, tmp, value, defs, ctx2);
|
||||
sexp_gc_preserve6(ctx, res, body, tmp, value, defs, ctx2);
|
||||
/* verify syntax */
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x))))
|
||||
sexp_return(res, sexp_compile_error(ctx, "bad lambda syntax", x));
|
||||
|
|
@ -523,18 +501,14 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
|
|||
}
|
||||
sexp_lambda_body(res) = body;
|
||||
cleanup:
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_if (sexp ctx, sexp x) {
|
||||
sexp res, fail_expr;
|
||||
sexp_gc_var(ctx, test, s_test);
|
||||
sexp_gc_var(ctx, pass, s_pass);
|
||||
sexp_gc_var(ctx, fail, s_fail);
|
||||
sexp_gc_preserve(ctx, test, s_test);
|
||||
sexp_gc_preserve(ctx, pass, s_pass);
|
||||
sexp_gc_preserve(ctx, fail, s_fail);
|
||||
sexp_gc_var3(test, pass, fail);
|
||||
sexp_gc_preserve3(ctx, test, pass, fail);
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) {
|
||||
res = sexp_compile_error(ctx, "bad if syntax", x);
|
||||
} else {
|
||||
|
|
@ -545,20 +519,14 @@ static sexp analyze_if (sexp ctx, sexp x) {
|
|||
res = (sexp_exceptionp(test) ? test : sexp_exceptionp(pass) ? pass :
|
||||
sexp_exceptionp(fail) ? fail : sexp_make_cnd(ctx, test, pass, fail));
|
||||
}
|
||||
sexp_gc_release(ctx, test, s_test);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_define (sexp ctx, sexp x) {
|
||||
sexp name, res;
|
||||
sexp_gc_var(ctx, ref, s_ref);
|
||||
sexp_gc_var(ctx, value, s_value);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, env, s_env);
|
||||
sexp_gc_preserve(ctx, ref, s_ref);
|
||||
sexp_gc_preserve(ctx, value, s_value);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, env, s_env);
|
||||
sexp_gc_var4(ref, value, tmp, env);
|
||||
sexp_gc_preserve4(ctx, ref, value, tmp, env);
|
||||
env = sexp_context_env(ctx);
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) {
|
||||
res = sexp_compile_error(ctx, "bad define syntax", x);
|
||||
|
|
@ -591,18 +559,14 @@ static sexp analyze_define (sexp ctx, sexp x) {
|
|||
res = sexp_make_set(ctx, ref, value);
|
||||
}
|
||||
}
|
||||
sexp_gc_release(ctx, ref, s_ref);
|
||||
sexp_gc_release4(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
|
||||
sexp res = SEXP_VOID, name;
|
||||
sexp_gc_var(eval_ctx, proc, s_proc);
|
||||
sexp_gc_var(eval_ctx, mac, s_mac);
|
||||
sexp_gc_var(eval_ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(eval_ctx, proc, s_proc);
|
||||
sexp_gc_preserve(eval_ctx, mac, s_mac);
|
||||
sexp_gc_preserve(eval_ctx, tmp, s_tmp);
|
||||
sexp_gc_var3(proc, mac, tmp);
|
||||
sexp_gc_preserve3(eval_ctx, proc, mac, tmp);
|
||||
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) {
|
||||
if (! (sexp_pairp(sexp_car(ls)) && sexp_pairp(sexp_cdar(ls))
|
||||
&& sexp_nullp(sexp_cddar(ls)))) {
|
||||
|
|
@ -623,28 +587,24 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
|
|||
}
|
||||
}
|
||||
}
|
||||
sexp_gc_release(eval_ctx, proc, s_proc);
|
||||
sexp_gc_release3(eval_ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_define_syntax (sexp ctx, sexp x) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var1(tmp);
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_list1(ctx, sexp_cdr(x));
|
||||
res = analyze_bind_syntax(tmp, ctx, ctx);
|
||||
sexp_gc_release(ctx, tmp, s_tmp);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_let_syntax (sexp ctx, sexp x) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, env, s_env);
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, env, s_env);
|
||||
sexp_gc_preserve(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var3(env, ctx2, tmp);
|
||||
sexp_gc_preserve3(ctx, env, ctx2, tmp);
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) {
|
||||
res = sexp_compile_error(ctx, "bad let-syntax", x);
|
||||
} else {
|
||||
|
|
@ -656,34 +616,28 @@ static sexp analyze_let_syntax (sexp ctx, sexp x) {
|
|||
tmp = analyze_bind_syntax(sexp_cadr(x), ctx, ctx2);
|
||||
res = (sexp_exceptionp(tmp) ? tmp : analyze_seq(ctx2, sexp_cddr(x)));
|
||||
}
|
||||
sexp_gc_release(ctx, env, s_env);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze_letrec_syntax (sexp ctx, sexp x) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var1(tmp);
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) {
|
||||
res = sexp_compile_error(ctx, "bad letrec-syntax", x);
|
||||
} else {
|
||||
tmp = analyze_bind_syntax(sexp_cadr(x), ctx, ctx);
|
||||
res = (sexp_exceptionp(tmp) ? tmp : analyze_seq(ctx, sexp_cddr(x)));
|
||||
}
|
||||
sexp_gc_release(ctx, tmp, s_tmp);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp analyze (sexp ctx, sexp object) {
|
||||
sexp op;
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, x, s_x);
|
||||
sexp_gc_var(ctx, cell, s_cell);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, x, s_x);
|
||||
sexp_gc_preserve(ctx, cell, s_cell);
|
||||
sexp_gc_var4(res, tmp, x, cell);
|
||||
sexp_gc_preserve4(ctx, res, tmp, x, cell);
|
||||
x = object;
|
||||
loop:
|
||||
if (sexp_pairp(x)) {
|
||||
|
|
@ -771,7 +725,7 @@ static sexp analyze (sexp ctx, sexp object) {
|
|||
} else {
|
||||
res = x;
|
||||
}
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release4(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -898,8 +852,8 @@ static void generate_set (sexp ctx, sexp set) {
|
|||
static void generate_opcode_app (sexp ctx, sexp app) {
|
||||
sexp op = sexp_car(app);
|
||||
sexp_sint_t i, num_args;
|
||||
sexp_gc_var(ctx, ls, s_ls);
|
||||
sexp_gc_preserve(ctx, ls, s_ls);
|
||||
sexp_gc_var1(ls);
|
||||
sexp_gc_preserve1(ctx, ls);
|
||||
|
||||
num_args = sexp_unbox_integer(sexp_length(ctx, sexp_cdr(app)));
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
|
|
@ -977,14 +931,14 @@ static void generate_opcode_app (sexp ctx, sexp app) {
|
|||
emit(ctx, sexp_opcode_code(op));
|
||||
|
||||
sexp_context_depth(ctx) -= (num_args-1);
|
||||
sexp_gc_release(ctx, ls, s_ls);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
|
||||
static void generate_general_app (sexp ctx, sexp app) {
|
||||
sexp_uint_t len = sexp_unbox_integer(sexp_length(ctx, sexp_cdr(app))),
|
||||
tailp = sexp_context_tailp(ctx);
|
||||
sexp_gc_var(ctx, ls, s_ls);
|
||||
sexp_gc_preserve(ctx, ls, s_ls);
|
||||
sexp_gc_var1(ls);
|
||||
sexp_gc_preserve1(ctx, ls);
|
||||
|
||||
/* push the arguments onto the stack */
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
|
|
@ -999,7 +953,7 @@ static void generate_general_app (sexp ctx, sexp app) {
|
|||
emit_word(ctx, (sexp_uint_t)sexp_make_integer(len));
|
||||
|
||||
sexp_context_depth(ctx) -= len;
|
||||
sexp_gc_release(ctx, ls, s_ls);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
|
||||
static void generate_app (sexp ctx, sexp app) {
|
||||
|
|
@ -1012,10 +966,8 @@ static void generate_app (sexp ctx, sexp app) {
|
|||
static void generate_lambda (sexp ctx, sexp lambda) {
|
||||
sexp ctx2, fv, ls, flags, len, ref, prev_lambda, prev_fv;
|
||||
sexp_uint_t k;
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, bc, s_bc);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, bc, s_bc);
|
||||
sexp_gc_var2(tmp, bc);
|
||||
sexp_gc_preserve2(ctx, tmp, bc);
|
||||
prev_lambda = sexp_context_lambda(ctx);
|
||||
prev_fv = sexp_lambdap(prev_lambda) ? sexp_lambda_fv(prev_lambda) : SEXP_NULL;
|
||||
fv = sexp_lambda_fv(lambda);
|
||||
|
|
@ -1073,7 +1025,7 @@ static void generate_lambda (sexp ctx, sexp lambda) {
|
|||
emit_push(ctx, flags);
|
||||
emit(ctx, OP_MAKE_PROCEDURE);
|
||||
}
|
||||
sexp_gc_release(ctx, tmp, s_tmp);
|
||||
sexp_gc_release2(ctx);
|
||||
}
|
||||
|
||||
static void generate (sexp ctx, sexp x) {
|
||||
|
|
@ -1103,34 +1055,32 @@ static sexp insert_free_var (sexp ctx, sexp x, sexp fv) {
|
|||
}
|
||||
|
||||
static sexp union_free_vars (sexp ctx, sexp fv1, sexp fv2) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
if (sexp_nullp(fv2))
|
||||
return fv1;
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
for (res=fv2; sexp_pairp(fv1); fv1=sexp_cdr(fv1))
|
||||
res = insert_free_var(ctx, sexp_car(fv1), res);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp diff_free_vars (sexp ctx, sexp lambda, sexp fv, sexp params) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
res = SEXP_NULL;
|
||||
for ( ; sexp_pairp(fv); fv=sexp_cdr(fv))
|
||||
if ((sexp_ref_loc(sexp_car(fv)) != lambda)
|
||||
|| (sexp_memq(NULL, sexp_ref_name(sexp_car(fv)), params)
|
||||
== SEXP_FALSE))
|
||||
sexp_push(ctx, res, sexp_car(fv));
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp free_vars (sexp ctx, sexp x, sexp fv) {
|
||||
sexp_gc_var(ctx, fv1, s_fv1);
|
||||
sexp_gc_var(ctx, fv2, s_fv2);
|
||||
sexp_gc_preserve(ctx, fv1, s_fv1);
|
||||
sexp_gc_preserve(ctx, fv2, s_fv2);
|
||||
sexp_gc_var2(fv1, fv2);
|
||||
sexp_gc_preserve2(ctx, fv1, fv2);
|
||||
fv1 = fv;
|
||||
if (sexp_lambdap(x)) {
|
||||
fv1 = free_vars(ctx, sexp_lambda_body(x), SEXP_NULL);
|
||||
|
|
@ -1157,34 +1107,26 @@ static sexp free_vars (sexp ctx, sexp x, sexp fv) {
|
|||
} else if (sexp_synclop(x)) {
|
||||
fv1 = free_vars(ctx, sexp_synclo_expr(x), fv);
|
||||
}
|
||||
sexp_gc_release(ctx, fv1, s_fv1);
|
||||
sexp_gc_release2(ctx);
|
||||
return fv1;
|
||||
}
|
||||
|
||||
static sexp make_param_list(sexp ctx, sexp_uint_t i) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
res = SEXP_NULL;
|
||||
for ( ; i>0; i--)
|
||||
res = sexp_cons(ctx, sexp_make_integer(i), res);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
|
||||
sexp ls, bc, res, env;
|
||||
sexp_gc_var(ctx, params, s_params);
|
||||
sexp_gc_var(ctx, ref, s_ref);
|
||||
sexp_gc_var(ctx, refs, s_refs);
|
||||
sexp_gc_var(ctx, lambda, s_lambda);
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var5(params, ref, refs, lambda, ctx2);
|
||||
if (i == sexp_opcode_num_args(op) && sexp_opcode_proc(op))
|
||||
return sexp_opcode_proc(op); /* return before preserving */
|
||||
sexp_gc_preserve(ctx, params, s_params);
|
||||
sexp_gc_preserve(ctx, ref, s_ref);
|
||||
sexp_gc_preserve(ctx, refs, s_refs);
|
||||
sexp_gc_preserve(ctx, lambda, s_lambda);
|
||||
sexp_gc_preserve(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_preserve5(ctx, params, ref, refs, lambda, ctx2);
|
||||
params = make_param_list(ctx, i);
|
||||
lambda = sexp_make_lambda(ctx, params);
|
||||
ctx2 = sexp_make_child_context(ctx, lambda);
|
||||
|
|
@ -1203,7 +1145,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
|
|||
bc, SEXP_VOID);
|
||||
if (i == sexp_opcode_num_args(op))
|
||||
sexp_opcode_proc(op) = res;
|
||||
sexp_gc_release(ctx, params, s_params);
|
||||
sexp_gc_release5(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1259,13 +1201,9 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
#if USE_BIGNUMS
|
||||
sexp_lsint_t prod;
|
||||
#endif
|
||||
sexp_gc_var3(self, tmp1, tmp2);
|
||||
sexp_gc_preserve3(ctx, self, tmp1, tmp2);
|
||||
fp = top - 4;
|
||||
sexp_gc_var(ctx, self, s_self);
|
||||
sexp_gc_var(ctx, tmp1, s_tmp1);
|
||||
sexp_gc_var(ctx, tmp2, s_tmp2);
|
||||
sexp_gc_preserve(ctx, self, s_self);
|
||||
sexp_gc_preserve(ctx, tmp1, s_tmp1);
|
||||
sexp_gc_preserve(ctx, tmp2, s_tmp2);
|
||||
self = proc;
|
||||
|
||||
loop:
|
||||
|
|
@ -1954,7 +1892,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
goto loop;
|
||||
|
||||
end_loop:
|
||||
sexp_gc_release(ctx, self, s_self);
|
||||
sexp_gc_release3(ctx);
|
||||
sexp_context_top(ctx) = top;
|
||||
return _ARG1;
|
||||
}
|
||||
|
|
@ -2024,14 +1962,8 @@ void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) {
|
|||
|
||||
sexp sexp_load (sexp ctx, sexp source, sexp env) {
|
||||
sexp tmp, out;
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var(ctx, x, s_x);
|
||||
sexp_gc_var(ctx, in, s_in);
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_preserve(ctx, x, s_x);
|
||||
sexp_gc_preserve(ctx, in, s_in);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var4(ctx2, x, in, res);
|
||||
sexp_gc_preserve4(ctx, ctx2, x, in, res);
|
||||
res = SEXP_VOID;
|
||||
in = sexp_open_input_file(ctx, source);
|
||||
out = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE);
|
||||
|
|
@ -2061,7 +1993,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
|
|||
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, out);
|
||||
#endif
|
||||
}
|
||||
sexp_gc_release(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_release4(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -2222,14 +2154,8 @@ static sexp sexp_make_null_env (sexp ctx, sexp version) {
|
|||
static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||
sexp_uint_t i;
|
||||
sexp ctx2, cell, sym, perr_cell, err_cell;
|
||||
sexp_gc_var(ctx, e, s_e);
|
||||
sexp_gc_var(ctx, op, s_op);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, err_handler, s_err);
|
||||
sexp_gc_preserve(ctx, e, s_e);
|
||||
sexp_gc_preserve(ctx, op, s_op);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, err_handler, s_err);
|
||||
sexp_gc_var4(e, op, tmp, err_handler);
|
||||
sexp_gc_preserve4(ctx, e, op, tmp, err_handler);
|
||||
e = sexp_make_null_env(ctx, version);
|
||||
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
||||
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
||||
|
|
@ -2272,7 +2198,7 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
finalize_bytecode(ctx2),
|
||||
tmp);
|
||||
env_define(ctx2, e, the_err_handler_symbol, err_handler);
|
||||
sexp_gc_release(ctx, e, s_e);
|
||||
sexp_gc_release4(ctx);
|
||||
return e;
|
||||
}
|
||||
|
||||
|
|
@ -2314,14 +2240,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
}
|
||||
|
||||
sexp sexp_compile (sexp ctx, sexp x) {
|
||||
sexp_gc_var(ctx, ast, s_ast);
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var(ctx, vec, s_vec);
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, ast, s_ast);
|
||||
sexp_gc_preserve(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_preserve(ctx, vec, s_vec);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var4(ast, ctx2, vec, res);
|
||||
sexp_gc_preserve4(ctx, ast, ctx2, vec, res);
|
||||
ast = analyze(ctx, x);
|
||||
if (sexp_exceptionp(ast)) {
|
||||
res = ast;
|
||||
|
|
@ -2333,14 +2253,14 @@ sexp sexp_compile (sexp ctx, sexp x) {
|
|||
res = sexp_make_procedure(ctx, sexp_make_integer(0), sexp_make_integer(0),
|
||||
res, vec);
|
||||
}
|
||||
sexp_gc_release(ctx, ast, s_ast);
|
||||
sexp_gc_release4(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_eval (sexp ctx, sexp obj, sexp env) {
|
||||
sexp res, ctx2;
|
||||
sexp_gc_var(ctx, thunk, s_thunk);
|
||||
sexp_gc_preserve(ctx, thunk, s_thunk);
|
||||
sexp_gc_var1(thunk);
|
||||
sexp_gc_preserve1(ctx, thunk);
|
||||
ctx2 = sexp_make_context(ctx, NULL, (env ? env : sexp_context_env(ctx)));
|
||||
sexp_context_parent(ctx2) = ctx;
|
||||
thunk = sexp_compile(ctx2, obj);
|
||||
|
|
@ -2353,17 +2273,17 @@ sexp sexp_eval (sexp ctx, sexp obj, sexp env) {
|
|||
} else {
|
||||
res = sexp_apply(ctx2, thunk, SEXP_NULL);
|
||||
}
|
||||
sexp_gc_release(ctx, thunk, s_thunk);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_eval_string (sexp ctx, char *str, sexp env) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, obj, s_obj);
|
||||
sexp_gc_preserve(ctx, obj, s_obj);
|
||||
sexp_gc_var1(obj);
|
||||
sexp_gc_preserve1(ctx, obj);
|
||||
obj = sexp_read_from_string(ctx, str);
|
||||
res = sexp_eval(ctx, obj, env);
|
||||
sexp_gc_release(ctx, obj, s_obj);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -293,6 +293,27 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
|
|||
#endif
|
||||
#endif
|
||||
|
||||
#define sexp_gc_var1(x) sexp_gc_var(ctx, x, __sexp_gc_preserver1)
|
||||
#define sexp_gc_var2(x, y) sexp_gc_var1(x); sexp_gc_var(ctx, y, __sexp_gc_preserver2)
|
||||
#define sexp_gc_var3(x, y, z) sexp_gc_var2(x, y); sexp_gc_var(ctx, z, __sexp_gc_preserver3)
|
||||
#define sexp_gc_var4(x, y, z, w) sexp_gc_var3(x, y, z); sexp_gc_var(ctx, w, __sexp_gc_preserver4)
|
||||
#define sexp_gc_var5(x, y, z, w, v) sexp_gc_var4(x, y, z, w); sexp_gc_var(ctx, v, __sexp_gc_preserver5)
|
||||
#define sexp_gc_var6(x, y, z, w, v, u) sexp_gc_var5(x, y, z, w, v); sexp_gc_var(ctx, u, __sexp_gc_preserver6)
|
||||
|
||||
#define sexp_gc_preserve1(ctx, x) sexp_gc_preserve(ctx, x, __sexp_gc_preserver1)
|
||||
#define sexp_gc_preserve2(ctx, x, y) sexp_gc_preserve1(ctx, x); sexp_gc_preserve(ctx, y, __sexp_gc_preserver2)
|
||||
#define sexp_gc_preserve3(ctx, x, y, z) sexp_gc_preserve2(ctx, x, y); sexp_gc_preserve(ctx, z, __sexp_gc_preserver3)
|
||||
#define sexp_gc_preserve4(ctx, x, y, z, w) sexp_gc_preserve3(ctx, x, y, z); sexp_gc_preserve(ctx, w, __sexp_gc_preserver4)
|
||||
#define sexp_gc_preserve5(ctx, x, y, z, w, v) sexp_gc_preserve4(ctx, x, y, z, w); sexp_gc_preserve(ctx, v, __sexp_gc_preserver5)
|
||||
#define sexp_gc_preserve6(ctx, x, y, z, w, v, u) sexp_gc_preserve5(ctx, x, y, z, w, v); sexp_gc_preserve(ctx, u, __sexp_gc_preserver6)
|
||||
|
||||
#define sexp_gc_release1(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
#define sexp_gc_release2(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
#define sexp_gc_release3(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
#define sexp_gc_release4(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
#define sexp_gc_release5(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
#define sexp_gc_release6(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
|
||||
|
||||
#define sexp_align(n, bits) (((n)+(1<<(bits))-1)&(((sexp_uint_t)-1)-((1<<(bits))-1)))
|
||||
|
||||
#define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
|
||||
|
|
|
|||
90
opt/bignum.c
90
opt/bignum.c
|
|
@ -30,12 +30,8 @@ sexp sexp_fixnum_to_bignum (sexp ctx, sexp a) {
|
|||
|
||||
sexp sexp_double_to_bignum (sexp ctx, double f) {
|
||||
int sign;
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, scale, s_scale);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, scale, s_scale);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var3(res, scale, tmp);
|
||||
sexp_gc_preserve3(ctx, res, scale, tmp);
|
||||
res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(0));
|
||||
scale = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1));
|
||||
sign = (f < 0 ? -1 : 1);
|
||||
|
|
@ -45,7 +41,7 @@ sexp sexp_double_to_bignum (sexp ctx, double f) {
|
|||
scale = sexp_bignum_fxmul(ctx, NULL, scale, 10, 0);
|
||||
}
|
||||
sexp_bignum_sign(res) = sign;
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -187,8 +183,8 @@ sexp_uint_t sexp_bignum_fxdiv (sexp ctx, sexp a, sexp_uint_t b, int offset) {
|
|||
sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
|
||||
char sign, sexp_uint_t base) {
|
||||
int c, digit;
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
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;
|
||||
|
|
@ -209,7 +205,7 @@ sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
|
|||
sexp_make_character(c), in);
|
||||
}
|
||||
sexp_push_char(ctx, c, in);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return sexp_bignum_normalize(res);
|
||||
}
|
||||
|
||||
|
|
@ -224,10 +220,8 @@ static int log2i(int v) {
|
|||
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_var(ctx, b, s_b);
|
||||
sexp_gc_var(ctx, str, s_str);
|
||||
sexp_gc_preserve(ctx, b, s_b);
|
||||
sexp_gc_preserve(ctx, str, s_str);
|
||||
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)
|
||||
|
|
@ -242,31 +236,31 @@ sexp sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base) {
|
|||
else if (sexp_bignum_sign(a) == -1)
|
||||
data[--i] = '-';
|
||||
sexp_write_string(ctx, data + i, out);
|
||||
sexp_gc_release(ctx, b, s_b);
|
||||
sexp_gc_release2(ctx);
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
/****************** bignum arithmetic *************************/
|
||||
|
||||
sexp sexp_bignum_add_fixnum (sexp ctx, sexp a, sexp b) {
|
||||
sexp_gc_var(ctx, c, s_c);
|
||||
sexp_gc_preserve(ctx, c, s_c);
|
||||
sexp_gc_var1(c);
|
||||
sexp_gc_preserve1(ctx, c);
|
||||
c = sexp_copy_bignum(ctx, NULL, a, 0);
|
||||
if (sexp_bignum_sign(c) == sexp_fx_sign(b))
|
||||
c = sexp_bignum_fxadd(ctx, c, sexp_unbox_integer(sexp_fx_abs(b)));
|
||||
else
|
||||
c = sexp_bignum_fxsub(ctx, c, sexp_unbox_integer(sexp_fx_abs(b)));
|
||||
sexp_gc_release(ctx, c, s_c);
|
||||
sexp_gc_release1(ctx);
|
||||
return c;
|
||||
}
|
||||
|
||||
sexp sexp_bignum_sub_digits (sexp ctx, sexp dst, sexp a, sexp b) {
|
||||
sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b),
|
||||
borrow=0, i, *adata, *bdata, *cdata;
|
||||
sexp_gc_var(ctx, c, s_c);
|
||||
sexp_gc_var1(c);
|
||||
if ((alen < blen) || ((alen == blen) && (sexp_bignum_compare_abs(a, b) < 0)))
|
||||
return sexp_bignum_sub_digits(ctx, dst, b, a);
|
||||
sexp_gc_preserve(ctx, c, s_c);
|
||||
sexp_gc_preserve1(ctx, c);
|
||||
c = ((dst && sexp_bignum_hi(dst) >= alen)
|
||||
? dst : sexp_copy_bignum(ctx, NULL, a, 0));
|
||||
adata = sexp_bignum_data(a);
|
||||
|
|
@ -280,16 +274,16 @@ sexp sexp_bignum_sub_digits (sexp ctx, sexp dst, sexp a, sexp b) {
|
|||
borrow = (cdata[i] == 0 ? 1 : 0);
|
||||
cdata[i]--;
|
||||
}
|
||||
sexp_gc_release(ctx, c, s_c);
|
||||
sexp_gc_release1(ctx);
|
||||
return c;
|
||||
}
|
||||
|
||||
sexp sexp_bignum_add_digits (sexp ctx, sexp dst, sexp a, sexp b) {
|
||||
sexp_uint_t alen=sexp_bignum_hi(a), blen=sexp_bignum_hi(b),
|
||||
carry=0, i, n, *adata, *bdata, *cdata;
|
||||
sexp_gc_var(ctx, c, s_c);
|
||||
sexp_gc_var1(c);
|
||||
if (alen < blen) return sexp_bignum_add_digits(ctx, dst, b, a);
|
||||
sexp_gc_preserve(ctx, c, s_c);
|
||||
sexp_gc_preserve1(ctx, c);
|
||||
c = ((dst && sexp_bignum_hi(dst) >= alen)
|
||||
? dst : sexp_copy_bignum(ctx, NULL, a, 0));
|
||||
adata = sexp_bignum_data(a);
|
||||
|
|
@ -308,7 +302,7 @@ sexp sexp_bignum_add_digits (sexp ctx, sexp dst, sexp a, sexp b) {
|
|||
c = sexp_copy_bignum(ctx, NULL, c, alen+1);
|
||||
sexp_bignum_data(c)[alen] = 1;
|
||||
}
|
||||
sexp_gc_release(ctx, c, s_c);
|
||||
sexp_gc_release1(ctx);
|
||||
return c;
|
||||
}
|
||||
|
||||
|
|
@ -342,11 +336,9 @@ sexp sexp_bignum_sub (sexp ctx, sexp dst, sexp a, sexp b) {
|
|||
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_var(ctx, c, s_c);
|
||||
sexp_gc_var(ctx, d, s_d);
|
||||
sexp_gc_var2(c, d);
|
||||
if (alen < blen) return sexp_bignum_mul(ctx, dst, b, a);
|
||||
sexp_gc_preserve(ctx, c, s_c);
|
||||
sexp_gc_preserve(ctx, d, s_d);
|
||||
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++) {
|
||||
|
|
@ -355,7 +347,7 @@ sexp sexp_bignum_mul (sexp ctx, sexp dst, sexp a, sexp b) {
|
|||
sexp_bignum_data(d)[i] = 0;
|
||||
}
|
||||
sexp_bignum_sign(c) = sexp_bignum_sign(a) * sexp_bignum_sign(b);
|
||||
sexp_gc_release(ctx, c, s_c);
|
||||
sexp_gc_release2(ctx);
|
||||
return c;
|
||||
}
|
||||
|
||||
|
|
@ -365,20 +357,12 @@ static sexp sexp_bignum_double (sexp ctx, sexp a) {
|
|||
|
||||
static sexp quot_step (sexp ctx, sexp *rem, sexp a, sexp b, sexp k, sexp i) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, x, s_x);
|
||||
sexp_gc_var(ctx, prod, s_prod);
|
||||
sexp_gc_var(ctx, diff, s_diff);
|
||||
sexp_gc_var(ctx, k2, s_k2);
|
||||
sexp_gc_var(ctx, i2, s_i2);
|
||||
sexp_gc_var5(x, prod, diff, k2, i2);
|
||||
if (sexp_bignum_compare(k, a) > 0) {
|
||||
*rem = a;
|
||||
return sexp_fixnum_to_bignum(ctx, sexp_make_integer(0));
|
||||
}
|
||||
sexp_gc_preserve(ctx, x, s_x);
|
||||
sexp_gc_preserve(ctx, prod, s_prod);
|
||||
sexp_gc_preserve(ctx, diff, s_diff);
|
||||
sexp_gc_preserve(ctx, k2, s_k2);
|
||||
sexp_gc_preserve(ctx, i2, s_i2);
|
||||
sexp_gc_preserve5(ctx, x, prod, diff, k2, i2);
|
||||
k2 = sexp_bignum_double(ctx, k);
|
||||
i2 = sexp_bignum_double(ctx, i);
|
||||
x = quot_step(ctx, rem, a, b, k2, i2);
|
||||
|
|
@ -391,20 +375,14 @@ static sexp quot_step (sexp ctx, sexp *rem, sexp a, sexp b, sexp k, sexp i) {
|
|||
*rem = diff;
|
||||
res = x;
|
||||
}
|
||||
sexp_gc_release(ctx, x, s_x);
|
||||
sexp_gc_release5(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_bignum_quot_rem (sexp ctx, sexp *rem, sexp a, sexp b) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, k, s_k);
|
||||
sexp_gc_var(ctx, i, s_i);
|
||||
sexp_gc_var(ctx, a1, s_a1);
|
||||
sexp_gc_var(ctx, b1, s_b1);
|
||||
sexp_gc_preserve(ctx, k, s_k);
|
||||
sexp_gc_preserve(ctx, i, s_i);
|
||||
sexp_gc_preserve(ctx, a1, s_a1);
|
||||
sexp_gc_preserve(ctx, b1, s_b1);
|
||||
sexp_gc_var4(k, i, a1, b1);
|
||||
sexp_gc_preserve4(ctx, k, i, a1, b1);
|
||||
a1 = sexp_copy_bignum(ctx, NULL, a, 0);
|
||||
sexp_bignum_sign(a1) = 1;
|
||||
b1 = sexp_copy_bignum(ctx, NULL, b, 0);
|
||||
|
|
@ -416,16 +394,16 @@ sexp sexp_bignum_quot_rem (sexp ctx, sexp *rem, sexp a, sexp b) {
|
|||
if (sexp_bignum_sign(a) < 0) {
|
||||
sexp_negate(*rem);
|
||||
}
|
||||
sexp_gc_release(ctx, k, s_k);
|
||||
sexp_gc_release4(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_bignum_quotient (sexp ctx, sexp a, sexp b) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, rem, s_rem);
|
||||
sexp_gc_preserve(ctx, rem, s_rem);
|
||||
sexp_gc_var1(rem);
|
||||
sexp_gc_preserve1(ctx, rem);
|
||||
res = sexp_bignum_quot_rem(ctx, &rem, a, b);
|
||||
sexp_gc_release(ctx, rem, s_rem);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -437,16 +415,14 @@ sexp sexp_bignum_remainder (sexp ctx, sexp a, sexp b) {
|
|||
|
||||
sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) {
|
||||
sexp_sint_t e = sexp_unbox_integer(sexp_fx_abs(b));
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, acc, s_acc);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, acc, s_acc);
|
||||
sexp_gc_var2(res, acc);
|
||||
sexp_gc_preserve2(ctx, res, acc);
|
||||
res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1));
|
||||
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_release(ctx, res, s_res);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
|
|||
112
sexp.c
112
sexp.c
|
|
@ -120,48 +120,38 @@ sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants,
|
|||
|
||||
sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, sym, s_sym);
|
||||
sexp_gc_var(ctx, str, s_str);
|
||||
sexp_gc_var(ctx, irr, s_irr);
|
||||
sexp_gc_preserve(ctx, sym, s_sym);
|
||||
sexp_gc_preserve(ctx, str, s_str);
|
||||
sexp_gc_preserve(ctx, irr, s_irr);
|
||||
sexp_gc_var3(sym, str, irr);
|
||||
sexp_gc_preserve3(ctx, sym, str, irr);
|
||||
res = sexp_make_exception(ctx, sym = sexp_intern(ctx, "user"),
|
||||
str = sexp_c_string(ctx, message, -1),
|
||||
((sexp_pairp(irritants) || sexp_nullp(irritants))
|
||||
? irritants : (irr = sexp_list1(ctx, irritants))),
|
||||
self, SEXP_FALSE);
|
||||
sexp_gc_release(ctx, sym, s_sym);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_type_exception (sexp ctx, char *message, sexp obj) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, sym, s_sym);
|
||||
sexp_gc_var(ctx, str, s_str);
|
||||
sexp_gc_var(ctx, irr, s_irr);
|
||||
sexp_gc_preserve(ctx, sym, s_sym);
|
||||
sexp_gc_preserve(ctx, str, s_str);
|
||||
sexp_gc_preserve(ctx, irr, s_irr);
|
||||
sexp_gc_var3(sym, str, irr);
|
||||
sexp_gc_preserve3(ctx, sym, str, irr);
|
||||
res = sexp_make_exception(ctx, sym = sexp_intern(ctx, "type"),
|
||||
str = sexp_c_string(ctx, message, -1),
|
||||
irr = sexp_list1(ctx, obj),
|
||||
SEXP_FALSE, SEXP_FALSE);
|
||||
sexp_gc_release(ctx, sym, s_sym);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, msg, s_msg);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, msg, s_msg);
|
||||
sexp_gc_var2(res, msg);
|
||||
sexp_gc_preserve2(ctx, res, msg);
|
||||
msg = sexp_c_string(ctx, "bad index range", -1);
|
||||
res = sexp_list2(ctx, start, end);
|
||||
res = sexp_cons(ctx, obj, res);
|
||||
res = sexp_make_exception(ctx, sexp_intern(ctx, "range"), msg, res,
|
||||
SEXP_FALSE, SEXP_FALSE);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -225,12 +215,8 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
|
|||
|
||||
static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, name, s_name);
|
||||
sexp_gc_var(ctx, str, s_str);
|
||||
sexp_gc_var(ctx, irr, s_irr);
|
||||
sexp_gc_preserve(ctx, name, s_name);
|
||||
sexp_gc_preserve(ctx, str, s_str);
|
||||
sexp_gc_preserve(ctx, irr, s_irr);
|
||||
sexp_gc_var3(name, str, irr);
|
||||
sexp_gc_preserve3(ctx, name, str, irr);
|
||||
name = (sexp_port_name(port) ? sexp_port_name(port) : SEXP_FALSE);
|
||||
name = sexp_cons(ctx, name, sexp_make_integer(sexp_port_line(port)));
|
||||
str = sexp_c_string(ctx, msg, -1);
|
||||
|
|
@ -238,7 +224,7 @@ static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
|
|||
? irritants : sexp_list1(ctx, irritants));
|
||||
res = sexp_make_exception(ctx, the_read_error_symbol,
|
||||
str, irr, SEXP_FALSE, name);
|
||||
sexp_gc_release(ctx, name, s_name);
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -253,11 +239,11 @@ sexp sexp_cons (sexp ctx, sexp head, sexp tail) {
|
|||
}
|
||||
|
||||
sexp sexp_list2 (sexp ctx, sexp a, sexp b) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
res = sexp_cons(ctx, b, SEXP_NULL);
|
||||
res = sexp_cons(ctx, a, res);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -294,11 +280,11 @@ sexp sexp_assq (sexp ctx, sexp x, sexp ls) {
|
|||
}
|
||||
|
||||
sexp sexp_reverse (sexp ctx, sexp ls) {
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
for (res=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls))
|
||||
res = sexp_cons(ctx, sexp_car(ls), res);
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -321,14 +307,12 @@ sexp sexp_nreverse (sexp ctx, sexp ls) {
|
|||
}
|
||||
|
||||
sexp sexp_append2 (sexp ctx, sexp a, sexp b) {
|
||||
sexp_gc_var(ctx, a1, s_a1);
|
||||
sexp_gc_var(ctx, b1, s_b1);
|
||||
sexp_gc_preserve(ctx, a1, s_a1);
|
||||
sexp_gc_preserve(ctx, b1, s_b1);
|
||||
sexp_gc_var2(a1, b1);
|
||||
sexp_gc_preserve2(ctx, a1, b1);
|
||||
b1 = b;
|
||||
for (a1=sexp_reverse(ctx, a); sexp_pairp(a1); a1=sexp_cdr(a1))
|
||||
b1 = sexp_cons(ctx, sexp_car(a1), b1);
|
||||
sexp_gc_release(ctx, a1, s_a1);
|
||||
sexp_gc_release2(ctx);
|
||||
return b1;
|
||||
}
|
||||
|
||||
|
|
@ -493,7 +477,7 @@ sexp sexp_intern(sexp ctx, char *str) {
|
|||
sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket;
|
||||
char c, *p=str;
|
||||
sexp ls;
|
||||
sexp_gc_var(ctx, sym, s_sym);
|
||||
sexp_gc_var1(sym);
|
||||
|
||||
#if USE_HUFF_SYMS
|
||||
res = 0;
|
||||
|
|
@ -521,11 +505,11 @@ sexp sexp_intern(sexp ctx, char *str) {
|
|||
return sexp_car(ls);
|
||||
|
||||
/* not found, make a new symbol */
|
||||
sexp_gc_preserve(ctx, sym, s_sym);
|
||||
sexp_gc_preserve1(ctx, sym);
|
||||
sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
|
||||
sexp_symbol_string(sym) = sexp_c_string(ctx, str, len);
|
||||
sexp_push(ctx, sexp_symbol_table[bucket], sym);
|
||||
sexp_gc_release(ctx, sym, s_sym);
|
||||
sexp_gc_release1(ctx);
|
||||
return sym;
|
||||
}
|
||||
|
||||
|
|
@ -625,8 +609,8 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
|
|||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
FILE *in;
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, cookie, s_cookie);
|
||||
sexp_gc_preserve(ctx, cookie, s_cookie);
|
||||
sexp_gc_var1(cookie);
|
||||
sexp_gc_preserve1(ctx, cookie);
|
||||
cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID);
|
||||
sexp_stream_ctx(cookie) = ctx;
|
||||
sexp_stream_buf(cookie) = str;
|
||||
|
|
@ -635,15 +619,15 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
|||
in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL);
|
||||
res = sexp_make_input_port(ctx, in, SEXP_FALSE);
|
||||
sexp_port_cookie(res) = cookie;
|
||||
sexp_gc_release(ctx, cookie, s_cookie);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
FILE *out;
|
||||
sexp res, size;
|
||||
sexp_gc_var(ctx, cookie, s_cookie);
|
||||
sexp_gc_preserve(ctx, cookie, s_cookie);
|
||||
sexp_gc_var1(cookie);
|
||||
sexp_gc_preserve1(ctx, cookie);
|
||||
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE);
|
||||
cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID);
|
||||
sexp_stream_ctx(cookie) = ctx;
|
||||
|
|
@ -653,7 +637,7 @@ sexp sexp_make_output_string_port (sexp ctx) {
|
|||
out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL);
|
||||
res = sexp_make_output_port(ctx, out, SEXP_FALSE);
|
||||
sexp_port_cookie(res) = cookie;
|
||||
sexp_gc_release(ctx, cookie, s_cookie);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -727,7 +711,7 @@ sexp sexp_buffered_write_string (sexp ctx, char *str, sexp p) {
|
|||
}
|
||||
|
||||
sexp sexp_buffered_flush (sexp ctx, sexp p) {
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var1(tmp);
|
||||
if (! sexp_oportp(p))
|
||||
return sexp_type_exception(ctx, "not an output-port", p);
|
||||
else if (! sexp_port_openp(p))
|
||||
|
|
@ -737,10 +721,10 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
|
|||
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p));
|
||||
fflush(sexp_port_stream(p));
|
||||
} else if (sexp_port_offset(p) > 0) {
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p));
|
||||
sexp_push(ctx, sexp_port_cookie(p), tmp);
|
||||
sexp_gc_release(ctx, tmp, s_tmp);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
sexp_port_offset(p) = 0;
|
||||
return SEXP_VOID;
|
||||
|
|
@ -767,10 +751,8 @@ sexp sexp_make_output_string_port (sexp ctx) {
|
|||
|
||||
sexp sexp_get_output_string (sexp ctx, sexp out) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, ls, s_ls);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, ls, s_ls);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var2(ls, tmp);
|
||||
sexp_gc_preserve2(ctx, ls, tmp);
|
||||
if (sexp_port_offset(out) > 0) {
|
||||
tmp = sexp_c_string(ctx, sexp_port_buf(out), sexp_port_offset(out));
|
||||
ls = sexp_cons(ctx, tmp, sexp_port_cookie(out));
|
||||
|
|
@ -778,7 +760,7 @@ sexp sexp_get_output_string (sexp ctx, sexp out) {
|
|||
ls = sexp_port_cookie(out);
|
||||
}
|
||||
res = sexp_string_concatenate(ctx, ls);
|
||||
sexp_gc_release(ctx, ls, s_ls);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1109,10 +1091,8 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
|
|||
char *str;
|
||||
int c1, c2, line;
|
||||
sexp tmp2;
|
||||
sexp_gc_var(ctx, res, s_res);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, res, s_res);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_var2(res, tmp);
|
||||
sexp_gc_preserve2(ctx, res, tmp);
|
||||
|
||||
scan_loop:
|
||||
switch (c1 = sexp_read_char(ctx, in)) {
|
||||
|
|
@ -1355,7 +1335,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
|
|||
|
||||
if (sexp_port_sourcep(in) && sexp_pointerp(res))
|
||||
sexp_immutablep(res) = 1;
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1370,25 +1350,23 @@ sexp sexp_read (sexp ctx, sexp in) {
|
|||
|
||||
sexp sexp_read_from_string(sexp ctx, char *str) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, s, s_s);
|
||||
sexp_gc_var(ctx, in, s_in);
|
||||
sexp_gc_preserve(ctx, s, s_s);
|
||||
sexp_gc_preserve(ctx, in, s_in);
|
||||
sexp_gc_var2(s, in);
|
||||
sexp_gc_preserve2(ctx, s, in);
|
||||
s = sexp_c_string(ctx, str, -1);
|
||||
in = sexp_make_input_string_port(ctx, s);
|
||||
res = sexp_read(ctx, in);
|
||||
sexp_gc_release(ctx, s, s_s);
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_write_to_string(sexp ctx, sexp obj) {
|
||||
sexp str;
|
||||
sexp_gc_var(ctx, out, s_out);
|
||||
sexp_gc_preserve(ctx, out, s_out);
|
||||
sexp_gc_var1(out);
|
||||
sexp_gc_preserve1(ctx, out);
|
||||
out = sexp_make_output_string_port(ctx);
|
||||
sexp_write(ctx, obj, out);
|
||||
str = sexp_get_output_string(ctx, out);
|
||||
sexp_gc_release(ctx, out, s_out);
|
||||
sexp_gc_release1(ctx);
|
||||
return str;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue