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 {
int argc;
struct pic_code *pc;
pic_value *sp;
pic_value *fp;
} pic_callinfo;
typedef struct {

20
src/codegen.c
View File

@ -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);

37
src/vm.c
View File

@ -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();