Merge branch 'master' into trampoline

This commit is contained in:
Yuichi Nishiwaki 2014-02-06 13:01:31 +09:00
commit 9f21c8d7b1
3 changed files with 64 additions and 56 deletions

@ -1 +1 @@
Subproject commit 8cb37986f940d4207477ab3710ce1c172cf499d0
Subproject commit 70abe4ffd48e60b2a7fdeb54ad1a793bc786b27b

View File

@ -92,7 +92,7 @@ typedef struct analyze_state {
pic_sym rCONS, rCAR, rCDR, rNILP;
pic_sym rADD, rSUB, rMUL, rDIV;
pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT;
pic_sym sCALL, sTAILCALL, sREF;
pic_sym sCALL, sTAILCALL, sREF, sRETURN;
} analyze_state;
static void push_scope(analyze_state *, pic_value);
@ -142,6 +142,7 @@ new_analyze_state(pic_state *pic)
register_symbol(pic, state, sCALL, "call");
register_symbol(pic, state, sTAILCALL, "tail-call");
register_symbol(pic, state, sREF, "ref");
register_symbol(pic, state, sRETURN, "return");
/* push initial scope */
push_scope(state, pic_nil_value());
@ -254,13 +255,25 @@ static pic_value analyze_lambda(analyze_state *, pic_value);
static pic_value
analyze(analyze_state *state, pic_value obj, bool tailpos)
{
int ai = pic_gc_arena_preserve(state->pic);
pic_state *pic = state->pic;
int ai = pic_gc_arena_preserve(pic);
pic_value res;
pic_sym tag;
res = analyze_node(state, obj, tailpos);
pic_gc_arena_restore(state->pic, ai);
pic_gc_protect(state->pic, res);
tag = pic_sym(pic_car(pic, res));
if (tailpos) {
if (tag == pic->sIF || tag == pic->sBEGIN || tag == state->sTAILCALL || tag == state->sRETURN) {
/* pass through */
}
else {
res = pic_list(pic, 2, pic_symbol_value(state->sRETURN), res);
}
}
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, res);
return res;
}
@ -646,7 +659,7 @@ pic_analyze(pic_state *pic, pic_value obj)
state = new_analyze_state(pic);
obj = analyze(state, obj, false);
obj = analyze(state, obj, true);
destroy_analyze_state(state);
return obj;
@ -925,7 +938,7 @@ typedef struct codegen_state {
pic_state *pic;
codegen_context *cxt;
pic_sym sGREF, sCREF, sLREF;
pic_sym sCALL, sTAILCALL;
pic_sym sCALL, sTAILCALL, sRETURN;
unsigned *cv_tbl, cv_num;
} codegen_state;
@ -946,6 +959,7 @@ new_codegen_state(pic_state *pic)
register_symbol(pic, state, sGREF, "gref");
register_symbol(pic, state, sLREF, "lref");
register_symbol(pic, state, sCREF, "cref");
register_symbol(pic, state, sRETURN, "return");
push_codegen_context(state, pic_nil_value(), pic_nil_value(), false, pic_nil_value());
@ -1297,6 +1311,12 @@ codegen(codegen_state *state, pic_value obj)
cxt->clen++;
return;
}
else if (sym == state->sRETURN) {
codegen(state, pic_list_ref(pic, obj, 1));
cxt->code[cxt->clen].insn = OP_RET;
cxt->clen++;
return;
}
pic_error(pic, "codegen: unknown AST type");
}
@ -1318,8 +1338,6 @@ codegen_lambda(codegen_state *state, pic_value obj)
{
/* body */
codegen(state, body);
state->cxt->code[state->cxt->clen].insn = OP_RET;
state->cxt->clen++;
}
return pop_codegen_context(state);
}
@ -1332,34 +1350,20 @@ pic_codegen(pic_state *pic, pic_value obj)
state = new_codegen_state(pic);
codegen(state, obj);
state->cxt->code[state->cxt->clen].insn = OP_RET;
state->cxt->clen++;
return destroy_codegen_state(state);
}
struct pic_proc *
pic_compile(pic_state *pic, pic_value obj)
static struct pic_irep *
compile(pic_state *pic, pic_value obj)
{
struct pic_proc *proc;
struct pic_irep *irep;
jmp_buf jmp, *prev_jmp = pic->jmp;
int ai = pic_gc_arena_preserve(pic);
if (setjmp(jmp) == 0) {
pic->jmp = &jmp;
}
else {
/* error occured */
proc = NULL;
goto exit;
}
#if DEBUG
fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic));
fprintf(stderr, "## input expression\n");
fprintf(stderr, "# input expression\n");
pic_debug(pic, obj);
fprintf(stderr, "\n");
@ -1398,23 +1402,39 @@ pic_compile(pic_state *pic, pic_value obj)
#if DEBUG
fprintf(stderr, "## codegen completed\n");
pic_dump_irep(pic, irep);
#endif
fprintf(stderr, "## compilation finished\n");
#if DEBUG
fprintf(stderr, "# compilation finished\n");
puts("");
#endif
proc = pic_proc_new_irep(pic, irep, NULL);
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, pic_obj_value(irep));
#if VM_DEBUG
pic_dump_irep(pic, proc->u.irep);
#endif
return irep;
}
struct pic_proc *
pic_compile(pic_state *pic, pic_value obj)
{
struct pic_proc *proc;
jmp_buf jmp, *prev_jmp = pic->jmp;
if (setjmp(jmp) == 0) {
pic->jmp = &jmp;
}
else {
/* error occured */
proc = NULL;
goto exit;
}
proc = pic_proc_new_irep(pic, compile(pic, obj), NULL);
exit:
pic->jmp = prev_jmp;
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, pic_obj_value(proc));
return proc;
}

View File

@ -411,21 +411,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
argc = pic_length(pic, argv) + 1;
#if VM_DEBUG
puts("== booting VM...");
printf(" proc = ");
pic_debug(pic, pic_obj_value(proc));
puts("");
printf(" argv = ");
pic_debug(pic, argv);
puts("");
if (! proc->cfunc_p) {
printf(" irep = ");
pic_dump_irep(pic, proc->u.irep);
}
else {
printf(" cfunc = %p\n", (void *)proc->u.cfunc);
}
puts("\nLet's go!");
puts("### booting VM... ###");
#endif
PUSH(pic_obj_value(proc));
@ -439,8 +425,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
boot[0].u.i = argc;
boot[1].insn = OP_STOP;
pic->ip = boot;
c = *pic->ip;
goto L_CALL;
VM_LOOP {
CASE(OP_NOP) {
@ -561,13 +545,17 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
proc = pic_proc_ptr(x);
#if VM_DEBUG
puts("== calling proc...");
puts("\n== calling proc...");
printf(" proc = ");
pic_debug(pic, pic_obj_value(proc));
puts("");
printf(" argv = ");
pic_debug(pic, argv);
puts("");
printf(" argv = (");
for (short i = 1; i < c.u.i; ++i) {
if (i > 1)
printf(" ");
pic_debug(pic, pic->sp[-c.u.i + i]);
}
puts(")");
if (! proc->cfunc_p) {
printf(" irep = ");
pic_dump_irep(pic, proc->u.irep);
@ -575,7 +563,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
else {
printf(" cfunc = %p\n", (void *)proc->u.cfunc);
}
puts("");
puts("== end\n");
#endif
ci = PUSHCI();