conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

evaluate arguments in normal (lexical) order

This commit is contained in:
Yuichi Nishiwaki 2013-10-23 15:55:42 +09:00
parent d12ed0a139
commit 035de0016b
3 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picrin.h
View File

@ -13,7 +13,7 @@ struct pic_code;
typedef struct pic_callinfo { typedef struct pic_callinfo {
int argc; int argc;
struct pic_code *pc; struct pic_code *pc;
pic_value *sp; pic_value *fp;
} pic_callinfo; } pic_callinfo;
typedef struct { typedef struct {

20
src/codegen.c
View File

@ -9,6 +9,7 @@
typedef struct codegen_scope { typedef struct codegen_scope {
struct codegen_scope *up; struct codegen_scope *up;
/* local variables are 1-indexed */
struct xhash *local_tbl; struct xhash *local_tbl;
size_t localc; size_t localc;
} codegen_scope; } codegen_scope;
@ -37,14 +38,14 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope)
new_scope->up = scope; new_scope->up = scope;
new_scope->local_tbl = x = xh_new(); new_scope->local_tbl = x = xh_new();
i = -1; i = 1;
for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) { for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_value sym; pic_value sym;
sym = pic_car(pic, v); 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; return new_scope;
} }
@ -235,8 +236,8 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope *sco
break; break;
} }
else if (pic_eq_p(pic, proc, sCONS)) { 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, 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->code[irep->clen].insn = OP_CONS;
irep->clen++; irep->clen++;
break; break;
@ -260,29 +261,29 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope *sco
break; break;
} }
else if (pic_eq_p(pic, proc, sADD)) { 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, 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->code[irep->clen].insn = OP_ADD;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, sSUB)) { 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, 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->code[irep->clen].insn = OP_SUB;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, sMUL)) { 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, 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->code[irep->clen].insn = OP_MUL;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, sDIV)) { 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, 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->code[irep->clen].insn = OP_DIV;
irep->clen++; irep->clen++;
break; break;
@ -337,8 +338,7 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, codegen_scope
pic_value seq; pic_value seq;
int i = 0; int i = 0;
seq = pic_reverse(pic, obj); for (seq = obj; ! pic_nil_p(seq); seq = pic_cdr(pic, seq)) {
for (; ! pic_nil_p(seq); seq = pic_cdr(pic, seq)) {
pic_value v; pic_value v;
v = pic_car(pic, seq); v = pic_car(pic, seq);

37
src/vm.c
View File

@ -6,13 +6,13 @@
#include "picrin/proc.h" #include "picrin/proc.h"
#include "picrin/irep.h" #include "picrin/irep.h"
#define GET_OPERAND(pic,n) ((pic)->sp[-1-(n)]) #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
int int
pic_get_args(pic_state *pic, const char *format, ...) pic_get_args(pic_state *pic, const char *format, ...)
{ {
char c; char c;
int i = 0, argc = pic->ci->argc - 1; int i = 1, argc = pic->ci->argc;
va_list ap; va_list ap;
bool opt = false; bool opt = false;
@ -101,9 +101,9 @@ pic_get_args(pic_state *pic, const char *format, ...)
# define VM_LOOP_END } } # define VM_LOOP_END } }
#endif #endif
#define PUSH(v) (*++pic->sp = (v)) #define PUSH(v) (*pic->sp++ = (v))
#define POP() (*pic->sp--) #define POP() (*--pic->sp)
#define POPN(i) ((void)(pic->sp-=i)) #define POPN(i) (pic->sp -= (i))
#define PUSHCI() (++pic->ci) #define PUSHCI() (++pic->ci)
#define POPCI() (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->sp[0] = pic_obj_value(proc);
pic->ci->argc = 1; pic->ci->argc = 1;
pic->ci->pc = NULL; pic->ci->pc = NULL;
pic->ci->sp = NULL; pic->ci->fp = pic->sp;
pic->sp++;
VM_LOOP { VM_LOOP {
CASE(OP_POP) { CASE(OP_POP) {
@ -173,7 +174,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
NEXT; NEXT;
} }
CASE(OP_LREF) { CASE(OP_LREF) {
PUSH(pic->ci->sp[pc->u.i]); PUSH(pic->ci->fp[pc->u.i]);
NEXT; NEXT;
} }
CASE(OP_JMP) { CASE(OP_JMP) {
@ -195,15 +196,16 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_callinfo *ci; pic_callinfo *ci;
struct pic_proc *proc; struct pic_proc *proc;
c = pic->sp[0]; c = pic->sp[-pc->u.i];
proc = pic_proc_ptr(c); proc = pic_proc_ptr(c);
ci = PUSHCI(); ci = PUSHCI();
ci->argc = pc->u.i; ci->argc = pc->u.i;
ci->pc = pc; ci->pc = pc;
ci->sp = pic->sp; ci->fp = pic->sp - pc->u.i;
if (pic_proc_cfunc_p(c)) { if (pic_proc_cfunc_p(c)) {
v = proc->u.cfunc(pic); v = proc->u.cfunc(pic);
pic->sp -= ci->argc; pic->sp = ci->fp;
POPCI(); POPCI();
PUSH(v); PUSH(v);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
@ -228,7 +230,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
v = POP(); v = POP();
ci = POPCI(); ci = POPCI();
pc = ci->pc; pc = ci->pc;
pic->sp -= ci->argc; pic->sp = ci->fp;
PUSH(v); PUSH(v);
} }
NEXT; NEXT;
@ -243,8 +245,8 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
} }
CASE(OP_CONS) { CASE(OP_CONS) {
pic_value a, b; pic_value a, b;
pic_gc_protect(pic, a = POP());
pic_gc_protect(pic, b = POP()); pic_gc_protect(pic, b = POP());
pic_gc_protect(pic, a = POP());
PUSH(pic_cons(pic, a, b)); PUSH(pic_cons(pic, a, b));
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
NEXT; NEXT;
@ -269,29 +271,29 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
} }
CASE(OP_ADD) { CASE(OP_ADD) {
pic_value a, b; pic_value a, b;
a = POP();
b = POP(); b = POP();
a = POP();
PUSH(pic_float_value(pic_float(a) + pic_float(b))); PUSH(pic_float_value(pic_float(a) + pic_float(b)));
NEXT; NEXT;
} }
CASE(OP_SUB) { CASE(OP_SUB) {
pic_value a, b; pic_value a, b;
a = POP();
b = POP(); b = POP();
a = POP();
PUSH(pic_float_value(pic_float(a) - pic_float(b))); PUSH(pic_float_value(pic_float(a) - pic_float(b)));
NEXT; NEXT;
} }
CASE(OP_MUL) { CASE(OP_MUL) {
pic_value a, b; pic_value a, b;
a = POP();
b = POP(); b = POP();
a = POP();
PUSH(pic_float_value(pic_float(a) * pic_float(b))); PUSH(pic_float_value(pic_float(a) * pic_float(b)));
NEXT; NEXT;
} }
CASE(OP_DIV) { CASE(OP_DIV) {
pic_value a, b; pic_value a, b;
a = POP();
b = POP(); b = POP();
a = POP();
PUSH(pic_float_value(pic_float(a) / pic_float(b))); PUSH(pic_float_value(pic_float(a) / pic_float(b)));
NEXT; NEXT;
} }
@ -301,6 +303,9 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
L_STOP: L_STOP:
val = POP(); val = POP();
/* pop the first procedure */
POPN(1);
pic->jmp = NULL; pic->jmp = NULL;
if (pic->errmsg) { if (pic->errmsg) {
return pic_undef_value(); return pic_undef_value();