Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 19:56:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

tail calls are back

Browse source
This commit is contained in:
Alex Shinn 2009-03-29 18:59:47 +09:00
parent 45fe39b2db
commit e7f507a5f1
2 changed files with 17 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
eval.c
View file

@ -221,7 +221,7 @@ static sexp sexp_new_context(sexp *stack) {
sexp_context_depth(res) = 0; sexp_context_depth(res) = 0;
sexp_context_pos(res) = 0; sexp_context_pos(res) = 0;
sexp_context_top(res) = 0; sexp_context_top(res) = 0;
sexp_context_tailp(res) = 0; sexp_context_tailp(res) = 1;
return res; return res;
} }
@ -540,6 +540,7 @@ static void generate_non_global_ref (sexp name, sexp cell, sexp lambda,
static void generate_set (sexp set, sexp context) { static void generate_set (sexp set, sexp context) {
sexp ref = sexp_set_var(set); sexp ref = sexp_set_var(set);
/* compile the value */ /* compile the value */
sexp_context_tailp(context) = 0;
generate(sexp_set_value(set), context); generate(sexp_set_value(set), context);
if (! sexp_lambdap(sexp_ref_loc(ref))) { if (! sexp_lambdap(sexp_ref_loc(ref))) {
/* global vars are set directly */ /* global vars are set directly */
@ -562,6 +563,7 @@ static void generate_app (sexp app, sexp context) {
static void generate_opcode_app (sexp app, sexp context) { static void generate_opcode_app (sexp app, sexp context) {
sexp ls, op = sexp_car(app); sexp ls, op = sexp_car(app);
sexp_sint_t i, num_args = sexp_unbox_integer(sexp_length(sexp_cdr(app))); sexp_sint_t i, num_args = sexp_unbox_integer(sexp_length(sexp_cdr(app)));
sexp_context_tailp(context) = 0;
/* maybe push the default for an optional argument */ /* maybe push the default for an optional argument */
if ((num_args == sexp_opcode_num_args(op)) if ((num_args == sexp_opcode_num_args(op))
@ -615,9 +617,11 @@ static void generate_opcode_app (sexp app, sexp context) {
static void generate_general_app (sexp app, sexp context) { static void generate_general_app (sexp app, sexp context) {
sexp ls; sexp ls;
sexp_uint_t len = sexp_unbox_integer(sexp_length(sexp_cdr(app))); sexp_uint_t len = sexp_unbox_integer(sexp_length(sexp_cdr(app))),
tailp = sexp_context_tailp(context);
/* push the arguments onto the stack */ /* push the arguments onto the stack */
sexp_context_tailp(context) = 0;
for (ls = sexp_reverse(sexp_cdr(app)); sexp_pairp(ls); ls = sexp_cdr(ls)) for (ls = sexp_reverse(sexp_cdr(app)); sexp_pairp(ls); ls = sexp_cdr(ls))
generate(sexp_car(ls), context); generate(sexp_car(ls), context);
@ -625,14 +629,8 @@ static void generate_general_app (sexp app, sexp context) {
generate(sexp_car(app), context); generate(sexp_car(app), context);
/* maybe overwrite the current frame */ /* maybe overwrite the current frame */
if (sexp_context_tailp(context)) { emit((tailp ? OP_TAIL_CALL : OP_CALL), context);
emit(OP_TAIL_CALL, context); emit_word((sexp_uint_t)sexp_make_integer(len), context);
emit_word((sexp_uint_t)sexp_make_integer(len), context);
} else {
/* normal call */
emit(OP_CALL, context);
emit_word((sexp_uint_t)sexp_make_integer(len), context);
}
sexp_context_depth(context) -= len; sexp_context_depth(context) -= len;
} }
@ -1044,18 +1042,18 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
break; break;
case OP_TAIL_CALL: case OP_TAIL_CALL:
/* old-args ... n ret-ip ret-cp new-args ... proc */ /* old-args ... n ret-ip ret-cp new-args ... proc */
/* [================= j ===========================] */
/* [==== i =====] */ /* [==== i =====] */
i = sexp_unbox_integer(((sexp*)ip)[1]); /* number of params */ i = sexp_unbox_integer(((sexp*)ip)[0]); /* number of params */
tmp1 = _ARG1; /* procedure to call */ tmp1 = _ARG1; /* procedure to call */
/* save frame info */ /* save frame info */
ip = ((unsigned char*) sexp_unbox_integer(stack[top-i-3])) - sizeof(sexp); j = sexp_unbox_integer(stack[fp]);
cp = stack[top-i-2]; ip = ((unsigned char*) sexp_unbox_integer(stack[fp+1])) - sizeof(sexp);
fp = (sexp_sint_t) stack[top-i-2]; cp = stack[fp+2];
/* copy new args into place */ /* copy new args into place */
for (k=0; k<i; k++) for (k=0; k<i; k++)
stack[top-j+k] = stack[top-i-1+k]; stack[fp-j+k] = stack[top-1-i+k];
top -= (j-i-1); top = fp+i-j+1;
fp = sexp_unbox_integer(stack[fp+3]);
goto make_call; goto make_call;
case OP_CALL: case OP_CALL:
fprintf(stderr, " %ld", sexp_unbox_integer(((sexp*)ip)[0])); fprintf(stderr, " %ld", sexp_unbox_integer(((sexp*)ip)[0]));
@ -1463,6 +1461,7 @@ int main (int argc, char **argv) {
interaction_environment = env; interaction_environment = env;
context = sexp_new_context(NULL); context = sexp_new_context(NULL);
sexp_context_env(context) = env; sexp_context_env(context) = env;
sexp_context_tailp(context) = 0;
emit_push(SEXP_UNDEF, context); emit_push(SEXP_UNDEF, context);
emit(OP_DONE, context); emit(OP_DONE, context);
err_handler = sexp_make_procedure(sexp_make_integer(0), err_handler = sexp_make_procedure(sexp_make_integer(0),

2
sexp.h
View file

@ -159,8 +159,6 @@ struct sexp_struct {
} value; } value;
}; };
/* #define offsetof(st, m) ((size_t) ((char*)&((st*)(0))->m - (char*)0)) */
#define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \ #define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
+ sizeof(((sexp)0)->value.x)) + sizeof(((sexp)0)->value.x))