speed up bytecode compilation
This commit is contained in:
parent
72baa9a52d
commit
531187bb2a
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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)
|
||||
{
|
||||
|
|
Loading…
Reference in New Issue