Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

initial closures seem to be working!

Browse source
This commit is contained in:
Alex Shinn 2009-03-01 15:37:42 +09:00
parent dd6dd392c8
commit 107566d680
1 changed files with 14 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
sexp.c
View file

@ -1361,12 +1361,12 @@ void analyze_lambda (sexp name, sexp formals, sexp body,
emit_word(bc, i, (unsigned long) make_integer(length(fv2))); emit_word(bc, i, (unsigned long) make_integer(length(fv2)));
emit(bc, i, OP_MAKE_VECTOR); emit(bc, i, OP_MAKE_VECTOR);
(*d)++; (*d)++;
for (ls=fv, k=0; SEXP_PAIRP(ls); ls=SEXP_CDR(ls), k++) { for (ls=fv2, k=0; SEXP_PAIRP(ls); ls=SEXP_CDR(ls), k++) {
analyze_var_ref(SEXP_CAR(ls), bc, i, e, params, fv, d); analyze_var_ref(SEXP_CAR(ls), bc, i, e, params, fv, d);
emit(bc, i, OP_PUSH); emit(bc, i, OP_PUSH);
emit_word(bc, i, (unsigned long) make_integer(k)); emit_word(bc, i, (unsigned long) make_integer(k));
emit(bc, i, OP_STACK_REF); emit(bc, i, OP_STACK_REF);
emit_word(bc, i, 2); emit_word(bc, i, 3);
emit(bc, i, OP_VECTOR_SET); emit(bc, i, OP_VECTOR_SET);
emit(bc, i, OP_DROP); emit(bc, i, OP_DROP);
(*d)--; (*d)--;
@ -1416,6 +1416,10 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
top++; top++;
break; break;
case OP_CLOSURE_REF: case OP_CLOSURE_REF:
fprintf(stderr, "closure-ref %d => ", ((sexp*)ip)[0]);
fflush(stderr);
write_sexp(stderr, vector_ref(cp,((sexp*)ip)[0]));
fprintf(stderr, "\n");
stack[top++]=vector_ref(cp,((sexp*)ip)[0]); stack[top++]=vector_ref(cp,((sexp*)ip)[0]);
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
@ -1427,6 +1431,9 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
top--; top--;
break; break;
case OP_VECTOR_SET: case OP_VECTOR_SET:
fprintf(stderr, "vector-set! %p %d => ", stack[top-1], unbox_integer(stack[top-2]));
write_sexp(stderr, stack[top-3]);
fprintf(stderr, "\n");
vector_set(stack[top-1], stack[top-2], stack[top-3]); vector_set(stack[top-1], stack[top-2], stack[top-3]);
stack[top-3]=SEXP_UNDEF; stack[top-3]=SEXP_UNDEF;
top-=2; top-=2;
@ -1436,7 +1443,7 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
top--; top--;
break; break;
case OP_MAKE_VECTOR: case OP_MAKE_VECTOR:
stack[top-2]=make_vector(unbox_integer(stack[top-2]), stack[top-1]); stack[top-2]=make_vector(unbox_integer(stack[top-1]), stack[top-2]);
top--; top--;
break; break;
case OP_PUSH: case OP_PUSH:
@ -1467,6 +1474,7 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
top--; top--;
break; break;
case OP_ADD: case OP_ADD:
fprintf(stderr, "OP_ADD %d %d\n", stack[top-1], stack[top-2]);
stack[top-2]=sexp_add(stack[top-1],stack[top-2]); stack[top-2]=sexp_add(stack[top-1],stack[top-2]);
top--; top--;
break; break;
@ -1504,7 +1512,9 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
print_bytecode(bc); print_bytecode(bc);
ip = bc->data; ip = bc->data;
cp = procedure_vars(tmp); cp = procedure_vars(tmp);
fprintf(stderr, "... calling procedure at %p\n", ip); fprintf(stderr, "... calling procedure at %p\ncp: ", ip);
write_sexp(stderr, cp);
fprintf(stderr, "\n");
/* print_stack(stack, top); */ /* print_stack(stack, top); */
break; break;
case OP_JUMP_UNLESS: case OP_JUMP_UNLESS: