Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

primitive load should use a fresh stack

Browse source
This commit is contained in:
Alex Shinn 2013-02-11 15:24:31 +09:00
parent c468e328a5
commit a689b1a399
1 changed files with 11 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
eval.c
View file

@ -1248,7 +1248,7 @@ sexp sexp_load_op (sexp ctx, sexp self, sexp_sint_t n, sexp source, sexp env) {
res = in; res = in;
} else { } else {
sexp_port_sourcep(in) = 1; sexp_port_sourcep(in) = 1;
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0); ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
sexp_context_parent(ctx2) = ctx; sexp_context_parent(ctx2) = ctx;
sexp_context_tailp(ctx2) = 0; sexp_context_tailp(ctx2) = 0;
while ((x=sexp_read(ctx2, in)) != (sexp) SEXP_EOF) { while ((x=sexp_read(ctx2, in)) != (sexp) SEXP_EOF) {
@ -2178,15 +2178,16 @@ sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from,
/************************** eval interface ****************************/ /************************** eval interface ****************************/
sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) { sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
sexp_gc_var3(ast, vec, res); sexp_gc_var4(ast, vec, tmp, res);
sexp ctx2; sexp ctx2;
if (! env) env = sexp_context_env(ctx); if (! env) env = sexp_context_env(ctx);
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env); sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
sexp_gc_preserve3(ctx, ast, vec, res); sexp_gc_preserve4(ctx, ast, vec, tmp, res);
ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0); ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
if (sexp_exceptionp(ctx2)) { if (sexp_exceptionp(ctx2)) {
res = ctx2; res = ctx2;
} else { } else {
tmp = sexp_context_child(ctx);
sexp_context_child(ctx) = ctx2; sexp_context_child(ctx) = ctx2;
ast = sexp_analyze(ctx2, obj); ast = sexp_analyze(ctx2, obj);
if (sexp_exceptionp(ast)) { if (sexp_exceptionp(ast)) {
@ -2210,33 +2211,34 @@ sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
} }
} }
} }
sexp_context_child(ctx) = SEXP_FALSE; sexp_context_child(ctx) = tmp;
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2); sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);
} }
sexp_gc_release3(ctx); sexp_gc_release4(ctx);
return res; return res;
} }
sexp sexp_eval_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) { sexp sexp_eval_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
sexp_sint_t top; sexp_sint_t top;
sexp ctx2; sexp ctx2;
sexp_gc_var2(res, params); sexp_gc_var3(res, tmp, params);
if (! env) env = sexp_context_env(ctx); if (! env) env = sexp_context_env(ctx);
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env); sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
sexp_gc_preserve2(ctx, res, params); sexp_gc_preserve3(ctx, res, tmp, params);
top = sexp_context_top(ctx); top = sexp_context_top(ctx);
params = sexp_context_params(ctx); params = sexp_context_params(ctx);
sexp_context_params(ctx) = SEXP_NULL; sexp_context_params(ctx) = SEXP_NULL;
ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0); ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
tmp = sexp_context_child(ctx);
sexp_context_child(ctx) = ctx2; sexp_context_child(ctx) = ctx2;
res = sexp_exceptionp(ctx2) ? ctx2 : sexp_compile_op(ctx2, self, n, obj, env); res = sexp_exceptionp(ctx2) ? ctx2 : sexp_compile_op(ctx2, self, n, obj, env);
if (! sexp_exceptionp(res)) if (! sexp_exceptionp(res))
res = sexp_apply(ctx2, res, SEXP_NULL); res = sexp_apply(ctx2, res, SEXP_NULL);
sexp_context_child(ctx) = SEXP_FALSE; sexp_context_child(ctx) = tmp;
sexp_context_params(ctx) = params; sexp_context_params(ctx) = params;
sexp_context_top(ctx) = top; sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2); sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);
sexp_gc_release2(ctx); sexp_gc_release3(ctx);
return res; return res;
} }