speed up bytecode compilation

This commit is contained in:
Yuichi Nishiwaki 2015-06-04 13:53:41 +09:00
parent 72baa9a52d
commit 531187bb2a
10 changed files with 95 additions and 74 deletions

View File

@ -189,11 +189,14 @@ pic_bool_boolean_eq_p(pic_state *pic)
void
pic_init_bool(pic_state *pic)
{
void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
pic_defun(pic, "eq?", pic_bool_eq_p);
pic_defun(pic, "eqv?", pic_bool_eqv_p);
pic_defun(pic, "equal?", pic_bool_equal_p);
pic_defun(pic, "not", pic_bool_not);
pic_defun_vm(pic, "not", pic->rNOT, pic_bool_not);
pic_defun(pic, "boolean?", pic_bool_boolean_p);
pic_defun(pic, "boolean=?", pic_bool_boolean_eq_p);
}

View File

@ -33,29 +33,11 @@ typedef struct analyze_scope {
typedef struct analyze_state {
pic_state *pic;
analyze_scope *scope;
pic_sym *rCONS, *rCAR, *rCDR, *rNILP;
pic_sym *rSYMBOLP, *rPAIRP;
pic_sym *rADD, *rSUB, *rMUL, *rDIV;
pic_sym *rEQ, *rLT, *rLE, *rGT, *rGE, *rNOT;
pic_sym *rVALUES, *rCALL_WITH_VALUES;
} analyze_state;
static bool push_scope(analyze_state *, pic_value);
static void pop_scope(analyze_state *);
#define register_symbol(pic, state, slot, name) do { \
state->slot = pic_intern_cstr(pic, name); \
} while (0)
#define register_renamed_symbol(pic, state, slot, lib, id) do { \
pic_sym *sym, *gsym; \
sym = pic_intern_cstr(pic, id); \
if (! pic_find_rename(pic, lib->env, sym, &gsym)) { \
pic_errorf(pic, "internal error! native VM procedure not found: %s", id); \
} \
state->slot = gsym; \
} while (0)
static analyze_state *
new_analyze_state(pic_state *pic)
{
@ -67,26 +49,6 @@ new_analyze_state(pic_state *pic)
state->pic = pic;
state->scope = NULL;
/* native VM procedures */
register_renamed_symbol(pic, state, rCONS, pic->PICRIN_BASE, "cons");
register_renamed_symbol(pic, state, rCAR, pic->PICRIN_BASE, "car");
register_renamed_symbol(pic, state, rCDR, pic->PICRIN_BASE, "cdr");
register_renamed_symbol(pic, state, rNILP, pic->PICRIN_BASE, "null?");
register_renamed_symbol(pic, state, rSYMBOLP, pic->PICRIN_BASE, "symbol?");
register_renamed_symbol(pic, state, rPAIRP, pic->PICRIN_BASE, "pair?");
register_renamed_symbol(pic, state, rADD, pic->PICRIN_BASE, "+");
register_renamed_symbol(pic, state, rSUB, pic->PICRIN_BASE, "-");
register_renamed_symbol(pic, state, rMUL, pic->PICRIN_BASE, "*");
register_renamed_symbol(pic, state, rDIV, pic->PICRIN_BASE, "/");
register_renamed_symbol(pic, state, rEQ, pic->PICRIN_BASE, "=");
register_renamed_symbol(pic, state, rLT, pic->PICRIN_BASE, "<");
register_renamed_symbol(pic, state, rLE, pic->PICRIN_BASE, "<=");
register_renamed_symbol(pic, state, rGT, pic->PICRIN_BASE, ">");
register_renamed_symbol(pic, state, rGE, pic->PICRIN_BASE, ">=");
register_renamed_symbol(pic, state, rNOT, pic->PICRIN_BASE, "not");
register_renamed_symbol(pic, state, rVALUES, pic->PICRIN_BASE, "values");
register_renamed_symbol(pic, state, rCALL_WITH_VALUES, pic->PICRIN_BASE, "call-with-values");
/* push initial scope */
push_scope(state, pic_nil_value());
@ -760,70 +722,70 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
else if (sym == pic->rQUOTE) {
return analyze_quote(state, obj);
}
else if (sym == state->rCONS) {
else if (sym == pic->rCONS) {
ARGC_ASSERT(2, "cons");
return CONSTRUCT_OP2(pic->sCONS);
}
else if (sym == state->rCAR) {
else if (sym == pic->rCAR) {
ARGC_ASSERT(1, "car");
return CONSTRUCT_OP1(pic->sCAR);
}
else if (sym == state->rCDR) {
else if (sym == pic->rCDR) {
ARGC_ASSERT(1, "cdr");
return CONSTRUCT_OP1(pic->sCDR);
}
else if (sym == state->rNILP) {
else if (sym == pic->rNILP) {
ARGC_ASSERT(1, "nil?");
return CONSTRUCT_OP1(pic->sNILP);
}
else if (sym == state->rSYMBOLP) {
else if (sym == pic->rSYMBOLP) {
ARGC_ASSERT(1, "symbol?");
return CONSTRUCT_OP1(pic->sSYMBOLP);
}
else if (sym == state->rPAIRP) {
else if (sym == pic->rPAIRP) {
ARGC_ASSERT(1, "pair?");
return CONSTRUCT_OP1(pic->sPAIRP);
}
else if (sym == state->rADD) {
else if (sym == pic->rADD) {
return analyze_add(state, obj, tailpos);
}
else if (sym == state->rSUB) {
else if (sym == pic->rSUB) {
return analyze_sub(state, obj);
}
else if (sym == state->rMUL) {
else if (sym == pic->rMUL) {
return analyze_mul(state, obj, tailpos);
}
else if (sym == state->rDIV) {
else if (sym == pic->rDIV) {
return analyze_div(state, obj);
}
else if (sym == state->rEQ) {
else if (sym == pic->rEQ) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sEQ);
}
else if (sym == state->rLT) {
else if (sym == pic->rLT) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sLT);
}
else if (sym == state->rLE) {
else if (sym == pic->rLE) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sLE);
}
else if (sym == state->rGT) {
else if (sym == pic->rGT) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sGT);
}
else if (sym == state->rGE) {
else if (sym == pic->rGE) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sGE);
}
else if (sym == state->rNOT) {
else if (sym == pic->rNOT) {
ARGC_ASSERT(1, "not");
return CONSTRUCT_OP1(pic->sNOT);
}
else if (sym == state->rVALUES) {
else if (sym == pic->rVALUES) {
return analyze_values(state, obj, tailpos);
}
else if (sym == state->rCALL_WITH_VALUES) {
else if (sym == pic->rCALL_WITH_VALUES) {
return analyze_call_with_values(state, obj, tailpos);
}
}

View File

@ -280,9 +280,12 @@ pic_cont_call_with_values(pic_state *pic)
void
pic_init_cont(pic_state *pic)
{
void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
pic_defun(pic, "call-with-current-continuation", pic_cont_callcc);
pic_defun(pic, "call/cc", pic_cont_callcc);
pic_defun(pic, "dynamic-wind", pic_cont_dynamic_wind);
pic_defun(pic, "values", pic_cont_values);
pic_defun(pic, "call-with-values", pic_cont_call_with_values);
pic_defun_vm(pic, "values", pic->rVALUES, pic_cont_values);
pic_defun_vm(pic, "call-with-values", pic->rCALL_WITH_VALUES, pic_cont_call_with_values);
}

View File

@ -521,6 +521,11 @@ gc_mark_global_symbols(pic_state *pic)
M(rDEFINE_SYNTAX); M(rIMPORT); M(rEXPORT);
M(rDEFINE_LIBRARY); M(rIN_LIBRARY);
M(rCOND_EXPAND);
M(rCONS); M(rCAR); M(rCDR); M(rNILP);
M(rSYMBOLP); M(rPAIRP);
M(rADD); M(rSUB); M(rMUL); M(rDIV);
M(rEQ); M(rLT); M(rLE); M(rGT); M(rGE); M(rNOT);
M(rVALUES); M(rCALL_WITH_VALUES);
}
static void

View File

@ -113,6 +113,11 @@ typedef struct {
pic_sym *rDEFINE_SYNTAX, *rIMPORT, *rEXPORT;
pic_sym *rDEFINE_LIBRARY, *rIN_LIBRARY;
pic_sym *rCOND_EXPAND;
pic_sym *rCONS, *rCAR, *rCDR, *rNILP;
pic_sym *rSYMBOLP, *rPAIRP;
pic_sym *rADD, *rSUB, *rMUL, *rDIV;
pic_sym *rEQ, *rLT, *rLE, *rGT, *rGE, *rNOT;
pic_sym *rVALUES, *rCALL_WITH_VALUES;
struct pic_lib *PICRIN_BASE;
struct pic_lib *PICRIN_USER;

View File

@ -801,6 +801,8 @@ pic_number_sqrt(pic_state *pic)
void
pic_init_number(pic_state *pic)
{
void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
size_t ai = pic_gc_arena_preserve(pic);
pic_defun(pic, "number?", pic_number_real_p);
@ -814,17 +816,17 @@ pic_init_number(pic_state *pic)
pic_defun(pic, "inexact?", pic_number_inexact_p);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "=", pic_number_eq);
pic_defun(pic, "<", pic_number_lt);
pic_defun(pic, ">", pic_number_gt);
pic_defun(pic, "<=", pic_number_le);
pic_defun(pic, ">=", pic_number_ge);
pic_defun_vm(pic, "=", pic->rEQ, pic_number_eq);
pic_defun_vm(pic, "<", pic->rLT, pic_number_lt);
pic_defun_vm(pic, ">", pic->rGT, pic_number_gt);
pic_defun_vm(pic, "<=", pic->rLE, pic_number_le);
pic_defun_vm(pic, ">=", pic->rGE, pic_number_ge);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "+", pic_number_add);
pic_defun(pic, "-", pic_number_sub);
pic_defun(pic, "*", pic_number_mul);
pic_defun(pic, "/", pic_number_div);
pic_defun_vm(pic, "+", pic->rADD, pic_number_add);
pic_defun_vm(pic, "-", pic->rSUB, pic_number_sub);
pic_defun_vm(pic, "*", pic->rMUL, pic_number_mul);
pic_defun_vm(pic, "/", pic->rDIV, pic_number_div);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "abs", pic_number_abs);

View File

@ -760,13 +760,16 @@ pic_pair_assoc(pic_state *pic)
void
pic_init_pair(pic_state *pic)
{
pic_defun(pic, "pair?", pic_pair_pair_p);
pic_defun(pic, "cons", pic_pair_cons);
pic_defun(pic, "car", pic_pair_car);
pic_defun(pic, "cdr", pic_pair_cdr);
void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
pic_defun_vm(pic, "pair?", pic->rPAIRP, pic_pair_pair_p);
pic_defun_vm(pic, "cons", pic->rCONS, pic_pair_cons);
pic_defun_vm(pic, "car", pic->rCAR, pic_pair_car);
pic_defun_vm(pic, "cdr", pic->rCDR, pic_pair_cdr);
pic_defun_vm(pic, "null?", pic->rNILP, pic_pair_null_p);
pic_defun(pic, "set-car!", pic_pair_set_car);
pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
pic_defun(pic, "null?", pic_pair_null_p);
pic_defun(pic, "caar", pic_pair_caar);
pic_defun(pic, "cadr", pic_pair_cadr);

View File

@ -304,6 +304,24 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
R(rDEFINE_LIBRARY, "define-library");
R(rIN_LIBRARY, "in-library");
R(rCOND_EXPAND, "cond-expand");
R(rCONS, "cons");
R(rCAR, "car");
R(rCDR, "cdr");
R(rNILP, "null?");
R(rSYMBOLP, "symbol?");
R(rPAIRP, "pair?");
R(rADD, "+");
R(rSUB, "-");
R(rMUL, "*");
R(rDIV, "/");
R(rEQ, "=");
R(rLT, "<");
R(rLE, "<=");
R(rGT, ">");
R(rGE, ">=");
R(rNOT, "not");
R(rVALUES, "values");
R(rCALL_WITH_VALUES, "call-with-values");
pic_gc_arena_restore(pic, ai);
/* root tables */

View File

@ -119,7 +119,10 @@ pic_symbol_string_to_symbol(pic_state *pic)
void
pic_init_symbol(pic_state *pic)
{
pic_defun(pic, "symbol?", pic_symbol_symbol_p);
void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
pic_defun_vm(pic, "symbol?", pic->rSYMBOLP, pic_symbol_symbol_p);
pic_defun(pic, "symbol->string", pic_symbol_symbol_to_string);
pic_defun(pic, "string->symbol", pic_symbol_string_to_symbol);

View File

@ -466,6 +466,23 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
pic_define(pic, name, pic_obj_value(proc));
}
void
pic_defun_vm(pic_state *pic, const char *name, pic_sym *rename, pic_func_t func)
{
struct pic_proc *proc;
pic_sym *sym;
proc = pic_make_proc(pic, func, name);
sym = pic_intern_cstr(pic, name);
pic_put_rename(pic, pic->lib->env, sym, rename);
pic_dict_set(pic, pic->globals, rename, pic_obj_value(proc));
pic_export(pic, sym);
}
void
pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv)
{