Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-06-23 14:26:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Now that bugs are fixed, re-using same stack for eval. Restores stack traces.

Browse source
This commit is contained in:
Alex Shinn 2012-02-02 23:16:16 +09:00
parent 3d1a230b8c
commit af60e10c4f
2 changed files with 10 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
eval.c
View file

@ -1147,7 +1147,7 @@ sexp sexp_load_op (sexp ctx, sexp self, sexp_sint_t n, sexp source, sexp env) {
}
sexp_gc_preserve4(ctx, ctx2, x, in, res);
out = sexp_current_error_port(ctx);
ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0);
sexp_context_parent(ctx2) = ctx;
tmp = sexp_env_bindings(env);
sexp_context_tailp(ctx2) = 0;
@ -1163,6 +1163,7 @@ sexp sexp_load_op (sexp ctx, sexp self, sexp_sint_t n, sexp source, sexp env) {
if (sexp_exceptionp(res))
break;
}
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);
if (x == SEXP_EOF)
res = SEXP_VOID;
sexp_close_port(ctx, in);
@ -2138,6 +2139,7 @@ sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
res = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, vec);
}
sexp_context_child(ctx) = SEXP_FALSE;
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);
sexp_gc_release3(ctx);
return res;
}
@ -2152,7 +2154,7 @@ sexp sexp_eval_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
top = sexp_context_top(ctx);
params = sexp_context_params(ctx);
sexp_context_params(ctx) = SEXP_NULL;
ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0, 0);
sexp_context_child(ctx) = ctx2;
sexp_context_dk(ctx2) = sexp_list1(ctx, SEXP_FALSE);
res = sexp_compile_op(ctx2, self, n, obj, env);

7
vm.c
View file

@ -29,7 +29,7 @@ void sexp_stack_trace (sexp ctx, sexp out) {
if (self && sexp_procedurep(self)) {
sexp_write_string(ctx, " called from ", out);
bc = sexp_procedure_code(self);
if (sexp_truep(sexp_bytecode_name(bc)))
if (sexp_symbolp(sexp_bytecode_name(bc)))
sexp_write(ctx, sexp_bytecode_name(bc), out);
else
sexp_write_string(ctx, "<anonymous>", out);
@ -1050,24 +1050,28 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
case SEXP_OP_FCALL1:
_ALIGN_IP();
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = fp;
tmp1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx, _WORD0, 1, _ARG1);
sexp_fcall_return(tmp1, 0)
break;
case SEXP_OP_FCALL2:
_ALIGN_IP();
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = fp;
tmp1 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx, _WORD0, 2, _ARG1, _ARG2);
sexp_fcall_return(tmp1, 1)
break;
case SEXP_OP_FCALL3:
_ALIGN_IP();
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = fp;
tmp1 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx, _WORD0, 3, _ARG1, _ARG2, _ARG3);
sexp_fcall_return(tmp1, 2)
break;
case SEXP_OP_FCALL4:
_ALIGN_IP();
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = fp;
tmp1 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx, _WORD0, 4, _ARG1, _ARG2, _ARG3, _ARG4);
sexp_fcall_return(tmp1, 3)
break;
@ -1075,6 +1079,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
case SEXP_OP_FCALLN:
_ALIGN_IP();
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = fp;
i = sexp_opcode_num_args(_WORD0);
tmp1 = sexp_fcall(ctx, self, i, _WORD0);
sexp_fcall_return(tmp1, i-1)