Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19: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", {"NOOP", "TAIL-CALL", "CALL", "APPLY1", "CALLCC", "RESUMECC", "ERROR",
"FCALL0", "FCALL1", "FCALL0", "FCALL1",
"FCALL2", "FCALL3", "FCALLN", "FCALL2", "FCALL3", "FCALLN",
"JUMP-UNLESS", "JUMP", "RET", "DONE", "PARAMETER", "JUMP-UNLESS", "JUMP", "RET", "DONE", "PARAMETER", "STACK-REF",
"LOCAL-REF", "LOCAL-SET", "CLOSURE-REF", "LOCAL-REF", "LOCAL-SET", "CLOSURE-REF",
"VECTOR-REF", "VECTOR-SET", "STRING-REF", "STRING-SET", "MAKE-PROCEDURE", "VECTOR-REF", "VECTOR-SET", "STRING-REF", "STRING-SET", "MAKE-PROCEDURE",
"MAKE-VECTOR", "PUSH", "DROP", "PAIRP", "NULLP", "VECTORP", "MAKE-VECTOR", "PUSH", "DROP", "PAIRP", "NULLP", "VECTORP",
@ -27,13 +27,14 @@ void disasm (sexp bc) {
fprintf(stderr, " <unknown> %d ", opcode); fprintf(stderr, " <unknown> %d ", opcode);
} }
switch (opcode) { switch (opcode) {
case OP_STACK_REF:
case OP_LOCAL_REF: case OP_LOCAL_REF:
case OP_LOCAL_SET: case OP_LOCAL_SET:
case OP_CLOSURE_REF: case OP_CLOSURE_REF:
case OP_PARAMETER: case OP_PARAMETER:
case OP_JUMP: case OP_JUMP:
case OP_JUMP_UNLESS: case OP_JUMP_UNLESS:
fprintf(stderr, "%ld", (long) ((sexp*)ip)[0]); fprintf(stderr, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_TAIL_CALL: 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), compile_non_global_ref(sexp_ref_name(ref), sexp_ref_cell(ref),
prev_lambda, prev_fv, context, 0); prev_lambda, prev_fv, context, 0);
emit_push(sexp_make_integer(k), context); emit_push(sexp_make_integer(k), context);
emit(OP_LOCAL_REF, context); emit(OP_STACK_REF, context);
emit_word(-5, context); emit_word(3, context);
emit(OP_VECTOR_SET, context); emit(OP_VECTOR_SET, context);
emit(OP_DROP, context); emit(OP_DROP, context);
sexp_context_depth(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; sexp_sint_t i, j, k, fp=top-4;
loop: loop:
fprintf(stderr, "\n");
print_stack(stack, top, fp); 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++) { switch (*ip++) {
case OP_NOOP: 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; break;
case OP_LOCAL_REF: 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]]; stack[top] = stack[fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]];
ip += sizeof(sexp); ip += sizeof(sexp);
top++; top++;
break; break;
case OP_LOCAL_SET: 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; stack[fp - 1 - (sexp_sint_t) ((sexp*)ip)[0]] = _ARG1;
_ARG1 = SEXP_UNDEF; _ARG1 = SEXP_UNDEF;
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_CLOSURE_REF: case OP_CLOSURE_REF:
fprintf(stderr, "%ld", sexp_unbox_integer(((sexp*)ip)[0]));
_PUSH(sexp_vector_ref(cp, ((sexp*)ip)[0])); _PUSH(sexp_vector_ref(cp, ((sexp*)ip)[0]));
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
@ -1016,6 +1027,7 @@ sexp vm(sexp bc, sexp cp, sexp e, sexp* stack, sexp_sint_t top) {
top -= (j-i-1); top -= (j-i-1);
goto make_call; goto make_call;
case OP_CALL: case OP_CALL:
fprintf(stderr, " %ld", sexp_unbox_integer(((sexp*)ip)[0]));
if (top >= INIT_STACK_SIZE) if (top >= INIT_STACK_SIZE)
sexp_raise("out of stack space", SEXP_NULL); sexp_raise("out of stack space", SEXP_NULL);
i = sexp_unbox_integer(((sexp*)ip)[0]); 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; break;
case OP_ERROR: case OP_ERROR:
call_error_handler: call_error_handler:
fprintf(stderr, "\n");
sexp_print_exception(_ARG1, cur_error_port); sexp_print_exception(_ARG1, cur_error_port);
tmp1 = sexp_cdr(exception_handler_cell); tmp1 = sexp_cdr(exception_handler_cell);
stack[top] = (sexp) 1; 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; top = top-i-4;
break; break;
case OP_DONE: case OP_DONE:
fprintf(stderr, "\n");
goto end_loop; goto end_loop;
default: default:
sexp_raise("unknown opcode", sexp_list1(sexp_make_integer(*(ip-1)))); 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_RET,
OP_DONE, OP_DONE,
OP_PARAMETER, OP_PARAMETER,
/* OP_STACK_REF, */ OP_STACK_REF,
/* OP_STACK_SET, */
OP_LOCAL_REF, OP_LOCAL_REF,
OP_LOCAL_SET, OP_LOCAL_SET,
OP_CLOSURE_REF, OP_CLOSURE_REF,