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

fixing var closing to use constant stack-ref, not negative local-ref

Browse source 
which would depend on the current depth
This commit is contained in:
Alex Shinn 2009-03-27 01:06:48 +09:00
parent af7148ce02
commit 73c600b4dc
3 changed files with 22 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
debug.c
View file

@ -6,7 +6,7 @@ static const char* reverse_opcode_names[] =
{"NOOP", "TAIL-CALL", "CALL", "APPLY1", "CALLCC", "RESUMECC", "ERROR",
"FCALL0", "FCALL1",
"FCALL2", "FCALL3", "FCALLN",
"JUMP-UNLESS", "JUMP", "RET", "DONE", "PARAMETER",
"JUMP-UNLESS", "JUMP", "RET", "DONE", "PARAMETER", "STACK-REF",
"LOCAL-REF", "LOCAL-SET", "CLOSURE-REF",
"VECTOR-REF", "VECTOR-SET", "STRING-REF", "STRING-SET", "MAKE-PROCEDURE",
"MAKE-VECTOR", "PUSH", "DROP", "PAIRP", "NULLP", "VECTORP",
@ -27,13 +27,14 @@ void disasm (sexp bc) {
fprintf(stderr, " <unknown> %d ", opcode);
}
switch (opcode) {
case OP_STACK_REF:
case OP_LOCAL_REF:
case OP_LOCAL_SET:
case OP_CLOSURE_REF:
case OP_PARAMETER:
case OP_JUMP:
case OP_JUMP_UNLESS:
fprintf(stderr, "%ld", (long) ((sexp*)ip)[0]);
fprintf(stderr, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp);
break;
case OP_TAIL_CALL:

22
eval.c
View file

@ -657,8 +657,8 @@ void compile_lambda (sexp lambda, sexp context) {
compile_non_global_ref(sexp_ref_name(ref), sexp_ref_cell(ref),
prev_lambda, prev_fv, context, 0);
emit_push(sexp_make_integer(k), context);
emit(OP_LOCAL_REF, context);
emit_word(-5, context);
emit(OP_STACK_REF, context);
emit_word(3, context);
emit(OP_VECTOR_SET, context);
emit(OP_DROP, context);
sexp_context_depth(context)--;
@ -792,23 +792,34 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
sexp_sint_t i, j, k, fp=top-4;
loop:
fprintf(stderr, "\n");
print_stack(stack, top, fp);
fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip);
/* fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip); */
fprintf(stderr, "%s ", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>");
switch (*ip++) {
case OP_NOOP:
fprintf(stderr, "noop\n");
fprintf(stderr, "<<<NOOP>>>\n");
break;
case OP_STACK_REF:
fprintf(stderr, "%ld - %ld => %ld", top, (sexp_sint_t) ((sexp*)ip)[0], top - (sexp_sint_t) ((sexp*)ip)[0]);
stack[top] = stack[top - (sexp_sint_t) ((sexp*)ip)[0]];
ip += sizeof(sexp);
top++;
break;
case OP_LOCAL_REF:
fprintf(stderr, "%ld - 1 - %ld => %ld", fp, (sexp_sint_t) ((sexp*)ip)[0], fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]);
stack[top] = stack[fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]];
ip += sizeof(sexp);
top++;
break;
case OP_LOCAL_SET:
fprintf(stderr, "%ld - 1 - %ld => %ld", fp, (sexp_sint_t) ((sexp*)ip)[0], fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]);
stack[fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]] = _ARG1;
_ARG1 = SEXP_UNDEF;
ip += sizeof(sexp);
break;
case OP_CLOSURE_REF:
fprintf(stderr, "%ld", sexp_unbox_integer(((sexp*)ip)[0]));
_PUSH(sexp_vector_ref(cp, ((sexp*)ip)[0]));
ip += sizeof(sexp);
break;
@ -1016,6 +1027,7 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
top -= (j-i-1);
goto make_call;
case OP_CALL:
fprintf(stderr, " %ld", sexp_unbox_integer(((sexp*)ip)[0]));
if (top >= INIT_STACK_SIZE)
sexp_raise("out of stack space", SEXP_NULL);
i = sexp_unbox_integer(((sexp*)ip)[0]);
@ -1103,6 +1115,7 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
break;
case OP_ERROR:
call_error_handler:
fprintf(stderr, "\n");
sexp_print_exception(_ARG1, cur_error_port);
tmp1 = sexp_cdr(exception_handler_cell);
stack[top] = (sexp) 1;
@ -1184,6 +1197,7 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
top = top-i-4;
break;
case OP_DONE:
fprintf(stderr, "\n");
goto end_loop;
default:
sexp_raise("unknown opcode", sexp_list1(sexp_make_integer(*(ip-1))));

3
eval.h
View file

@ -70,8 +70,7 @@ enum opcode_names {
OP_RET,
OP_DONE,
OP_PARAMETER,
/* OP_STACK_REF, */
/* OP_STACK_SET, */
OP_STACK_REF,
OP_LOCAL_REF,
OP_LOCAL_SET,
OP_CLOSURE_REF,