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

add OP_LSET and OP_CSET

This commit is contained in:
Yuichi Nishiwaki 2013-10-24 03:14:32 +09:00
parent 337b54dc40
commit d75b624b4a
6 changed files with 70 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picrin.h
View File

@ -26,7 +26,7 @@ typedef struct {
pic_callinfo *ci;
pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_value sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV;

2
include/picrin/irep.h
View File

@ -11,7 +11,9 @@ enum pic_opcode {
OP_GREF,
OP_GSET,
OP_LREF,
OP_LSET,
OP_CREF,
OP_CSET,
OP_JMP,
OP_JMPIF,
OP_CALL,

46
src/codegen.c
View File

@ -250,6 +250,42 @@ codegen(codegen_state *state, pic_value obj)
irep->clen--;
break;
}
else if (pic_eq_p(pic, proc, pic->sSETBANG)) {
codegen_scope *s;
int depth, idx;
const char *name;
name = pic_symbol_ptr(pic_car(pic, pic_cdr(pic, obj)))->name;
s = scope_lookup(state, name, &depth, &idx);
if (! s) {
pic_error(pic, "unbound variable");
}
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
switch (depth) {
case -1: /* global */
irep->code[irep->clen].insn = OP_GSET;
irep->code[irep->clen].u.i = idx;
irep->clen++;
break;
default: /* nonlocal */
/* dirty flag */
s->cv_tbl[idx] = 1;
/* at this stage, lset and cset are not distinguished */
FALLTHROUGH;
case 0: /* local */
irep->code[irep->clen].insn = OP_CSET;
irep->code[irep->clen].u.c.depth = depth;
irep->code[irep->clen].u.c.idx = idx;
irep->clen++;
break;
}
irep->code[irep->clen].insn = OP_PUSHFALSE;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sQUOTE)) {
int pidx;
pidx = pic->plen++;
@ -412,6 +448,10 @@ codegen_lambda(codegen_state *state, pic_value obj)
irep->code[i].insn = OP_LREF;
irep->code[i].u.i = irep->code[i].u.c.idx;
}
if (c.insn == OP_CSET && c.u.c.depth == 0 && ! state->scope->cv_tbl[c.u.c.idx]) {
irep->code[i].insn = OP_LSET;
irep->code[i].u.i = irep->code[i].u.c.idx;
}
}
}
destroy_scope(pic, state->scope);
@ -511,9 +551,15 @@ print_irep(pic_state *pic, struct pic_irep *irep)
case OP_LREF:
printf("OP_LREF\t%d\n", irep->code[i].u.i);
break;
case OP_LSET:
printf("OP_LSET\t%d\n", irep->code[i].u.i);
break;
case OP_CREF:
printf("OP_CREF\t%d\t%d\n", irep->code[i].u.c.depth, irep->code[i].u.c.idx);
break;
case OP_CSET:
printf("OP_CSET\t%d\t%d\n", irep->code[i].u.c.depth, irep->code[i].u.c.idx);
break;
case OP_JMP:
printf("OP_JMP\t%d\n", irep->code[i].u.i);
break;

1
src/gc.c
View File

@ -239,6 +239,7 @@ gc_mark_phase(pic_state *pic)
gc_mark(pic, pic->sLAMBDA);
gc_mark(pic, pic->sIF);
gc_mark(pic, pic->sBEGIN);
gc_mark(pic, pic->sSETBANG);
gc_mark(pic, pic->sQUOTE);
gc_mark(pic, pic->sQUASIQUOTE);
gc_mark(pic, pic->sUNQUOTE);

1
src/state.c
View File

@ -79,6 +79,7 @@ pic_open(int argc, char *argv[], char **envp)
pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
pic->sIF = pic_intern_cstr(pic, "if");
pic->sBEGIN = pic_intern_cstr(pic, "begin");
pic->sSETBANG = pic_intern_cstr(pic, "set!");
pic->sQUOTE = pic_intern_cstr(pic, "quote");
pic->sQUASIQUOTE = pic_intern_cstr(pic, "quasiquote");
pic->sUNQUOTE = pic_intern_cstr(pic, "unquote");

23
src/vm.c
View File

@ -118,10 +118,10 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
#if PIC_DIRECT_THREADED_VM
static void *oplabels[] = {
&&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHNUM,
&&L_OP_PUSHCONST, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_CREF,
&&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS,
&&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL,
&&L_OP_DIV, &&L_OP_STOP
&&L_OP_PUSHCONST, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET,
&&L_OP_CREF, &&L_OP_CSET, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL, &&L_OP_RET,
&&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP,
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_STOP
};
#endif
@ -178,6 +178,10 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
PUSH(pic->ci->fp[pc->u.i]);
NEXT;
}
CASE(OP_LSET) {
pic->ci->fp[pc->u.i] = POP();
NEXT;
}
CASE(OP_CREF) {
int depth = pc->u.c.depth;
struct pic_env *env;
@ -189,6 +193,17 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
PUSH(env->values[pc->u.c.idx]);
NEXT;
}
CASE(OP_CSET) {
int depth = pc->u.c.depth;
struct pic_env *env;
env = pic_proc_ptr(*pic->ci->fp)->env;
while (depth--) {
env = env->up;
}
env->values[pc->u.c.idx] = POP();
NEXT;
}
CASE(OP_JMP) {
pc += pc->u.i;
JUMP;