optimize vm procs

This commit is contained in:
Yuichi Nishiwaki 2016-03-03 21:38:50 +09:00
parent 6244c9c550
commit e4bf1a14ab
2 changed files with 37 additions and 64 deletions

View File

@ -695,6 +695,29 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
#define emit_ret(pic, cxt, tailpos) if (tailpos) emit_n(pic, cxt, OP_RET) #define emit_ret(pic, cxt, tailpos) if (tailpos) emit_n(pic, cxt, OP_RET)
struct {
const char *name;
int insn;
int argc;
} pic_vm_proc[] = {
{ "picrin.base/cons", OP_CONS, 2 },
{ "picrin.base/car", OP_CAR, 1 },
{ "picrin.base/cdr", OP_CDR, 1 },
{ "picrin.base/null?", OP_NILP, 1 },
{ "picrin.base/symbol?", OP_SYMBOLP, 1 },
{ "picrin.base/pair?", OP_PAIRP, 1 },
{ "picrin.base/not", OP_NOT, 1 },
{ "picrin.base/=", OP_EQ, 2 },
{ "picrin.base/<", OP_LT, 2 },
{ "picrin.base/<=", OP_LE, 2 },
{ "picrin.base/>", OP_GT, 2 },
{ "picrin.base/>=", OP_GE, 2 },
{ "picrin.base/+", OP_ADD, 2 },
{ "picrin.base/-", OP_SUB, 2 },
{ "picrin.base/*", OP_MUL, 2 },
{ "picrin.base//", OP_DIV, 2 }
};
static int static int
index_capture(pic_state *pic, codegen_context *cxt, pic_value sym, int depth) index_capture(pic_state *pic, codegen_context *cxt, pic_value sym, int depth)
{ {
@ -951,47 +974,34 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
emit_ret(pic, cxt, tailpos); emit_ret(pic, cxt, tailpos);
} }
#define VM(name, op) \
if (EQ(sym, name)) { \
emit_i(pic, cxt, op, len - 1); \
emit_ret(pic, cxt, tailpos); \
return; \
}
static void static void
codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
{ {
int len = pic_length(pic, obj); int len = pic_length(pic, obj);
pic_value elt, it, functor; pic_value elt, it, functor;
pic_for_each (elt, pic_cdr(pic, obj), it) {
codegen(pic, cxt, elt, false);
}
functor = pic_list_ref(pic, obj, 1); functor = pic_list_ref(pic, obj, 1);
if (EQ(pic_list_ref(pic, functor, 0), "gref")) { if (EQ(pic_list_ref(pic, functor, 0), "gref")) {
pic_value sym; pic_value sym;
size_t i;
sym = pic_list_ref(pic, functor, 1); sym = pic_list_ref(pic, functor, 1);
VM("picrin.base/cons", OP_CONS) for (i = 0; i < sizeof pic_vm_proc / sizeof pic_vm_proc[0]; ++i) {
VM("picrin.base/car", OP_CAR) if (EQ(sym, pic_vm_proc[i].name) && len == pic_vm_proc[i].argc + 2) {
VM("picrin.base/cdr", OP_CDR) pic_for_each (elt, pic_cddr(pic, obj), it) {
VM("picrin.base/null?", OP_NILP) codegen(pic, cxt, elt, false);
VM("picrin.base/symbol?", OP_SYMBOLP) }
VM("picrin.base/pair?", OP_PAIRP) emit_n(pic, cxt, pic_vm_proc[i].insn);
VM("picrin.base/not", OP_NOT) emit_ret(pic, cxt, tailpos);
VM("picrin.base/=", OP_EQ) return;
VM("picrin.base/<", OP_LT) }
VM("picrin.base/<=", OP_LE) }
VM("picrin.base/>", OP_GT)
VM("picrin.base/>=", OP_GE)
VM("picrin.base/+", OP_ADD)
VM("picrin.base/-", OP_SUB)
VM("picrin.base/*", OP_MUL)
VM("picrin.base//", OP_DIV)
} }
pic_for_each (elt, pic_cdr(pic, obj), it) {
codegen(pic, cxt, elt, false);
}
emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1); emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1);
} }

View File

@ -629,148 +629,111 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
NEXT; NEXT;
} }
#define check_condition(name, n) do { \
if (c.a != n + 1) \
goto L_CALL; \
} while (0)
CASE(OP_CONS) { CASE(OP_CONS) {
pic_value a, b; pic_value a, b;
check_condition(CONS, 2);
pic_protect(pic, b = POP()); pic_protect(pic, b = POP());
pic_protect(pic, a = POP()); pic_protect(pic, a = POP());
(void)POP();
PUSH(pic_cons(pic, a, b)); PUSH(pic_cons(pic, a, b));
pic_leave(pic, ai); pic_leave(pic, ai);
NEXT; NEXT;
} }
CASE(OP_CAR) { CASE(OP_CAR) {
pic_value p; pic_value p;
check_condition(CAR, 1);
p = POP(); p = POP();
(void)POP();
PUSH(pic_car(pic, p)); PUSH(pic_car(pic, p));
NEXT; NEXT;
} }
CASE(OP_CDR) { CASE(OP_CDR) {
pic_value p; pic_value p;
check_condition(CDR, 1);
p = POP(); p = POP();
(void)POP();
PUSH(pic_cdr(pic, p)); PUSH(pic_cdr(pic, p));
NEXT; NEXT;
} }
CASE(OP_NILP) { CASE(OP_NILP) {
pic_value p; pic_value p;
check_condition(NILP, 1);
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_nil_p(pic, p))); PUSH(pic_bool_value(pic, pic_nil_p(pic, p)));
NEXT; NEXT;
} }
CASE(OP_SYMBOLP) { CASE(OP_SYMBOLP) {
pic_value p; pic_value p;
check_condition(SYMBOLP, 1);
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_sym_p(pic, p))); PUSH(pic_bool_value(pic, pic_sym_p(pic, p)));
NEXT; NEXT;
} }
CASE(OP_PAIRP) { CASE(OP_PAIRP) {
pic_value p; pic_value p;
check_condition(PAIRP, 1);
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_pair_p(pic, p))); PUSH(pic_bool_value(pic, pic_pair_p(pic, p)));
NEXT; NEXT;
} }
CASE(OP_NOT) { CASE(OP_NOT) {
pic_value v; pic_value v;
check_condition(NOT, 1);
v = pic_false_p(pic, POP()) ? pic_true_value(pic) : pic_false_value(pic); v = pic_false_p(pic, POP()) ? pic_true_value(pic) : pic_false_value(pic);
(void)POP();
PUSH(v); PUSH(v);
NEXT; NEXT;
} }
CASE(OP_ADD) { CASE(OP_ADD) {
pic_value a, b; pic_value a, b;
check_condition(ADD, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_add(pic, a, b)); PUSH(pic_add(pic, a, b));
NEXT; NEXT;
} }
CASE(OP_SUB) { CASE(OP_SUB) {
pic_value a, b; pic_value a, b;
check_condition(SUB, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_sub(pic, a, b)); PUSH(pic_sub(pic, a, b));
NEXT; NEXT;
} }
CASE(OP_MUL) { CASE(OP_MUL) {
pic_value a, b; pic_value a, b;
check_condition(MUL, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_mul(pic, a, b)); PUSH(pic_mul(pic, a, b));
NEXT; NEXT;
} }
CASE(OP_DIV) { CASE(OP_DIV) {
pic_value a, b; pic_value a, b;
check_condition(DIV, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_div(pic, a, b)); PUSH(pic_div(pic, a, b));
NEXT; NEXT;
} }
CASE(OP_EQ) { CASE(OP_EQ) {
pic_value a, b; pic_value a, b;
check_condition(EQ, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_eq(pic, a, b))); PUSH(pic_bool_value(pic, pic_eq(pic, a, b)));
NEXT; NEXT;
} }
CASE(OP_LE) { CASE(OP_LE) {
pic_value a, b; pic_value a, b;
check_condition(LT, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_le(pic, a, b))); PUSH(pic_bool_value(pic, pic_le(pic, a, b)));
NEXT; NEXT;
} }
CASE(OP_LT) { CASE(OP_LT) {
pic_value a, b; pic_value a, b;
check_condition(LE, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_lt(pic, a, b))); PUSH(pic_bool_value(pic, pic_lt(pic, a, b)));
NEXT; NEXT;
} }
CASE(OP_GE) { CASE(OP_GE) {
pic_value a, b; pic_value a, b;
check_condition(LT, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_ge(pic, a, b))); PUSH(pic_bool_value(pic, pic_ge(pic, a, b)));
NEXT; NEXT;
} }
CASE(OP_GT) { CASE(OP_GT) {
pic_value a, b; pic_value a, b;
check_condition(LE, 2);
b = POP(); b = POP();
a = POP(); a = POP();
(void)POP();
PUSH(pic_bool_value(pic, pic_gt(pic, a, b))); PUSH(pic_bool_value(pic, pic_gt(pic, a, b)));
NEXT; NEXT;
} }