From dec08e9cfa34705f6543b21d9e777bee5025b7ca Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 1 Mar 2009 15:54:46 +0900 Subject: [PATCH] preparing for set! support --- sexp.c | 66 ++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 36 insertions(+), 30 deletions(-) diff --git a/sexp.c b/sexp.c index 19788e0a..9c7c825f 100644 --- a/sexp.c +++ b/sexp.c @@ -1063,14 +1063,20 @@ env make_standard_env() { void print_bytecode (bytecode bc) { int i; fprintf(stderr, "bytecode @ %p, data @ %p, length = %d\n", bc, bc->data, bc->len); - for (i=0; i+8 < bc->len; i+=8) { - fprintf(stderr, "%02x: %02x %02x %02x %02x %02x %02x %02x %02x\n", i, + for (i=0; i+16 < bc->len; i+=8) { + fprintf(stderr, "%02x: %02x %02x %02x %02x %02x %02x %02x %02x ", i, + bc->data[i], bc->data[i+1], bc->data[i+2], bc->data[i+3], + bc->data[i+4], bc->data[i+5], bc->data[i+6], bc->data[i+7]); + i += 8; + fprintf(stderr, "%02x %02x %02x %02x %02x %02x %02x %02x\n", bc->data[i], bc->data[i+1], bc->data[i+2], bc->data[i+3], bc->data[i+4], bc->data[i+5], bc->data[i+6], bc->data[i+7]); } if (i != bc->len) { fprintf(stderr, "%02x:", i); for ( ; i < bc->len; i++) { + if ((i % 8) == 0 && (i % 16) != 0) + fprintf(stderr, " "); fprintf(stderr, " %02x", bc->data[i]); } fprintf(stderr, "\n"); @@ -1126,17 +1132,17 @@ void emit_word(bytecode *bc, unsigned int *i, unsigned long val) { *i += sizeof(unsigned long); } -bytecode compile(sexp params, sexp obj, env e, sexp fv, int done_p); +bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p); void analyze_app (sexp obj, bytecode *bc, unsigned int *i, - env e, sexp params, sexp fv, unsigned int *d); + env e, sexp params, sexp fv, sexp sv, unsigned int *d); void analyze_lambda (sexp name, sexp formals, sexp body, bytecode *bc, unsigned int *i, env e, - sexp params, sexp fv, unsigned int *d); + sexp params, sexp fv, sexp sv, unsigned int *d); void analyze_var_ref (sexp name, bytecode *bc, unsigned int *i, env e, - sexp params, sexp fv, unsigned int *d); + sexp params, sexp fv, sexp sv, unsigned int *d); void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, - sexp params, sexp fv, unsigned int *d) { + sexp params, sexp fv, sexp sv, unsigned int *d) { int tmp1, tmp2; env e2 = e; sexp o1, o2, cell; @@ -1158,7 +1164,7 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, case CORE_LAMBDA: fprintf(stderr, ":: lambda\n"); analyze_lambda(SEXP_FALSE, SEXP_CADR(obj), SEXP_CADDR(obj), - bc, i, e, params, fv, d); + bc, i, e, params, fv, sv, d); break; case CORE_DEFINE: case CORE_SET: @@ -1168,9 +1174,9 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, analyze_lambda(SEXP_CAR(SEXP_CADR(obj)), SEXP_CDR(SEXP_CADR(obj)), SEXP_CADDR(obj), - bc, i, e, params, fv, d); + bc, i, e, params, fv, sv, d); } else { - analyze(SEXP_CADDR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADDR(obj), bc, i, e, params, fv, sv, d); } emit(bc, i, OP_GLOBAL_SET); emit_word(bc, i, (unsigned long) (SEXP_PAIRP(SEXP_CADR(obj)) @@ -1182,24 +1188,24 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, break; case CORE_BEGIN: for (o2 = SEXP_CDR(obj); SEXP_PAIRP(o2); o2 = SEXP_CDR(o2)) { - analyze(SEXP_CAR(o2), bc, i, e, params, fv, d); + analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d); } break; case CORE_IF: fprintf(stderr, "test clause: %d\n", *i); - analyze(SEXP_CADR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADR(obj), bc, i, e, params, fv, sv, d); emit(bc, i, OP_JUMP_UNLESS); /* jumps if test fails */ tmp1 = *i; emit(bc, i, 0); fprintf(stderr, "pass clause: %d\n", *i); - analyze(SEXP_CADDR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADDR(obj), bc, i, e, params, fv, sv, d); emit(bc, i, OP_JUMP); tmp2 = *i; emit(bc, i, 0); ((signed char*) (*bc)->data)[tmp1] = (*i)-tmp1-1; /* patch */ fprintf(stderr, "fail clause: %d\n", *i); if (SEXP_PAIRP(SEXP_CDDDR(obj))) { - analyze(SEXP_CADDDR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADDDR(obj), bc, i, e, params, fv, sv, d); } else { emit(bc, i, OP_PUSH); (*d)++; @@ -1229,16 +1235,16 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, errx(1, "unknown opcode class: %d", ((opcode)o1)->op_class); } else if (SEXP_NULLP(SEXP_CDDR(obj))) { if (((opcode)o1)->op_class == OPC_ARITHMETIC_INV) { - analyze(SEXP_CADR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADR(obj), bc, i, e, params, fv, sv, d); emit(bc, i, ((opcode)o1)->op_inverse); } else { - analyze(SEXP_CADR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CADR(obj), bc, i, e, params, fv, sv, d); } } else { /* fprintf(stderr, ":: class: %d\n", ((opcode)o1)->op_class); */ for (o2 = reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2 = SEXP_CDR(o2)) { /* fprintf(stderr, ":: arg: %d\n", SEXP_CAR(o2)); */ - analyze(SEXP_CAR(o2), bc, i, e, params, fv, d); + analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d); } fprintf(stderr, ":: name: %d\n", ((opcode)o1)->op_name); emit(bc, i, ((opcode)o1)->op_name); @@ -1250,7 +1256,7 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, } } else { /* function call */ - analyze_app(obj, bc, i, e, params, fv, d); + analyze_app(obj, bc, i, e, params, fv, sv, d); } } else if (SEXP_PAIRP(SEXP_CAR(obj))) { o2 = env_cell(e, SEXP_CAAR(obj)); @@ -1260,13 +1266,13 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, /* /\* let *\/ */ /* } else { */ /* computed application */ - analyze_app(obj, bc, i, e, params, fv, d); + analyze_app(obj, bc, i, e, params, fv, sv, d); /* } */ } else { errx(1, "invalid operator: %s", SEXP_CAR(obj)); } } else if (SEXP_SYMBOLP(obj)) { - analyze_var_ref (obj, bc, i, e, params, fv, d); + analyze_var_ref (obj, bc, i, e, params, fv, sv, d); } else { fprintf(stderr, "push: %d\n", (unsigned long)obj); emit(bc, i, OP_PUSH); @@ -1276,7 +1282,7 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, } void analyze_var_ref (sexp obj, bytecode *bc, unsigned int *i, env e, - sexp params, sexp fv, unsigned int *d) { + sexp params, sexp fv, sexp sv, unsigned int *d) { int tmp; /* variable reference */ /* cell = env_cell(e, obj); */ @@ -1300,17 +1306,17 @@ void analyze_var_ref (sexp obj, bytecode *bc, unsigned int *i, env e, } void analyze_app (sexp obj, bytecode *bc, unsigned int *i, - env e, sexp params, sexp fv, unsigned int *d) { + env e, sexp params, sexp fv, sexp sv, unsigned int *d) { sexp o1; unsigned long len = length(SEXP_CDR(obj)); /* push the arguments onto the stack */ for (o1 = reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1 = SEXP_CDR(o1)) { - analyze(SEXP_CAR(o1), bc, i, e, params, fv, d); + analyze(SEXP_CAR(o1), bc, i, e, params, fv, sv, d); } /* push the operator onto the stack */ - analyze(SEXP_CAR(obj), bc, i, e, params, fv, d); + analyze(SEXP_CAR(obj), bc, i, e, params, fv, sv, d); /* make the call */ emit(bc, i, OP_CALL); @@ -1346,7 +1352,7 @@ sexp free_vars (env e, sexp formals, sexp obj, sexp fv) { void analyze_lambda (sexp name, sexp formals, sexp body, bytecode *bc, unsigned int *i, env e, - sexp params, sexp fv, unsigned int *d) { + sexp params, sexp fv, sexp sv, unsigned int *d) { sexp obj; sexp fv2 = free_vars(e, formals, body, SEXP_NULL), ls; env e2 = extend_env_closure(e, formals); @@ -1354,7 +1360,7 @@ void analyze_lambda (sexp name, sexp formals, sexp body, fprintf(stderr, "%d free-vars\n", length(fv2)); write_sexp(stderr, fv2); fprintf(stderr, "\n"); - obj = (sexp) compile(formals, body, e2, fv2, 0); + obj = (sexp) compile(formals, body, e2, fv2, sv, 0); emit(bc, i, OP_PUSH); emit_word(bc, i, (unsigned long) SEXP_UNDEF); emit(bc, i, OP_PUSH); @@ -1362,7 +1368,7 @@ void analyze_lambda (sexp name, sexp formals, sexp body, emit(bc, i, OP_MAKE_VECTOR); (*d)++; 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, sv, d); emit(bc, i, OP_PUSH); emit_word(bc, i, (unsigned long) make_integer(k)); emit(bc, i, OP_STACK_REF); @@ -1562,13 +1568,13 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) { return stack[top-1]; } -bytecode compile(sexp params, sexp obj, env e, sexp fv, int done_p) { +bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) { bytecode bc = (bytecode) malloc(sizeof(struct bytecode)+INIT_BCODE_SIZE); unsigned int i = 0, d = 0; bc->tag = SEXP_BYTECODE; bc->len = INIT_BCODE_SIZE; fprintf(stderr, "analyzing\n"); - analyze(obj, &bc, &i, e, params, fv, &d); + analyze(obj, &bc, &i, e, params, fv, sv, &d); emit(&bc, &i, done_p ? OP_DONE : OP_RET); /* fprintf(stderr, "shrinking\n"); */ shrink_bcode(&bc, i); @@ -1578,7 +1584,7 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, int done_p) { } sexp eval_in_stack(sexp obj, env e, sexp* stack, unsigned int top) { - bytecode bc = compile(SEXP_NULL, obj, e, SEXP_NULL, 1); + bytecode bc = compile(SEXP_NULL, obj, e, SEXP_NULL, SEXP_NULL, 1); fprintf(stderr, "evaling\n"); return vm(bc, e, stack, top); }