From 035de0016bdeab9afff1b6736c5175847840bca7 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 23 Oct 2013 15:55:42 +0900 Subject: [PATCH] evaluate arguments in normal (lexical) order --- include/picrin.h | 2 +- src/codegen.c | 20 ++++++++++---------- src/vm.c | 37 +++++++++++++++++++++---------------- 3 files changed, 32 insertions(+), 27 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index bbcf47d6..80351abf 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -13,7 +13,7 @@ struct pic_code; typedef struct pic_callinfo { int argc; struct pic_code *pc; - pic_value *sp; + pic_value *fp; } pic_callinfo; typedef struct { diff --git a/src/codegen.c b/src/codegen.c index 8a1eed6b..e4073b6c 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -9,6 +9,7 @@ typedef struct codegen_scope { struct codegen_scope *up; + /* local variables are 1-indexed */ struct xhash *local_tbl; size_t localc; } codegen_scope; @@ -37,14 +38,14 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope) new_scope->up = scope; new_scope->local_tbl = x = xh_new(); - i = -1; + i = 1; for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) { pic_value sym; sym = pic_car(pic, v); - xh_put(x, pic_symbol_ptr(sym)->name, i--); + xh_put(x, pic_symbol_ptr(sym)->name, i++); } - new_scope->localc = -1-i; + new_scope->localc = i-1; return new_scope; } @@ -235,8 +236,8 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope *sco break; } else if (pic_eq_p(pic, proc, sCONS)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_CONS; irep->clen++; break; @@ -260,29 +261,29 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope *sco break; } else if (pic_eq_p(pic, proc, sADD)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_ADD; irep->clen++; break; } else if (pic_eq_p(pic, proc, sSUB)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_SUB; irep->clen++; break; } else if (pic_eq_p(pic, proc, sMUL)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_MUL; irep->clen++; break; } else if (pic_eq_p(pic, proc, sDIV)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_DIV; irep->clen++; break; @@ -337,8 +338,7 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope pic_value seq; int i = 0; - seq = pic_reverse(pic, obj); - for (; ! pic_nil_p(seq); seq = pic_cdr(pic, seq)) { + for (seq = obj; ! pic_nil_p(seq); seq = pic_cdr(pic, seq)) { pic_value v; v = pic_car(pic, seq); diff --git a/src/vm.c b/src/vm.c index 4b194f8e..a5ab5175 100644 --- a/src/vm.c +++ b/src/vm.c @@ -6,13 +6,13 @@ #include "picrin/proc.h" #include "picrin/irep.h" -#define GET_OPERAND(pic,n) ((pic)->sp[-1-(n)]) +#define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)]) int pic_get_args(pic_state *pic, const char *format, ...) { char c; - int i = 0, argc = pic->ci->argc - 1; + int i = 1, argc = pic->ci->argc; va_list ap; bool opt = false; @@ -101,9 +101,9 @@ pic_get_args(pic_state *pic, const char *format, ...) # define VM_LOOP_END } } #endif -#define PUSH(v) (*++pic->sp = (v)) -#define POP() (*pic->sp--) -#define POPN(i) ((void)(pic->sp-=i)) +#define PUSH(v) (*pic->sp++ = (v)) +#define POP() (*--pic->sp) +#define POPN(i) (pic->sp -= (i)) #define PUSHCI() (++pic->ci) #define POPCI() (pic->ci--) @@ -137,7 +137,8 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) pic->sp[0] = pic_obj_value(proc); pic->ci->argc = 1; pic->ci->pc = NULL; - pic->ci->sp = NULL; + pic->ci->fp = pic->sp; + pic->sp++; VM_LOOP { CASE(OP_POP) { @@ -173,7 +174,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) NEXT; } CASE(OP_LREF) { - PUSH(pic->ci->sp[pc->u.i]); + PUSH(pic->ci->fp[pc->u.i]); NEXT; } CASE(OP_JMP) { @@ -195,15 +196,16 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) pic_callinfo *ci; struct pic_proc *proc; - c = pic->sp[0]; + c = pic->sp[-pc->u.i]; proc = pic_proc_ptr(c); + ci = PUSHCI(); ci->argc = pc->u.i; ci->pc = pc; - ci->sp = pic->sp; + ci->fp = pic->sp - pc->u.i; if (pic_proc_cfunc_p(c)) { v = proc->u.cfunc(pic); - pic->sp -= ci->argc; + pic->sp = ci->fp; POPCI(); PUSH(v); pic_gc_arena_restore(pic, ai); @@ -228,7 +230,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) v = POP(); ci = POPCI(); pc = ci->pc; - pic->sp -= ci->argc; + pic->sp = ci->fp; PUSH(v); } NEXT; @@ -243,8 +245,8 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) } CASE(OP_CONS) { pic_value a, b; - pic_gc_protect(pic, a = POP()); pic_gc_protect(pic, b = POP()); + pic_gc_protect(pic, a = POP()); PUSH(pic_cons(pic, a, b)); pic_gc_arena_restore(pic, ai); NEXT; @@ -269,29 +271,29 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) } CASE(OP_ADD) { pic_value a, b; - a = POP(); b = POP(); + a = POP(); PUSH(pic_float_value(pic_float(a) + pic_float(b))); NEXT; } CASE(OP_SUB) { pic_value a, b; - a = POP(); b = POP(); + a = POP(); PUSH(pic_float_value(pic_float(a) - pic_float(b))); NEXT; } CASE(OP_MUL) { pic_value a, b; - a = POP(); b = POP(); + a = POP(); PUSH(pic_float_value(pic_float(a) * pic_float(b))); NEXT; } CASE(OP_DIV) { pic_value a, b; - a = POP(); b = POP(); + a = POP(); PUSH(pic_float_value(pic_float(a) / pic_float(b))); NEXT; } @@ -301,6 +303,9 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) L_STOP: val = POP(); + /* pop the first procedure */ + POPN(1); + pic->jmp = NULL; if (pic->errmsg) { return pic_undef_value();