speed up bytecode compilation

extlib/benz/bool.c

@@ -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);
 }

extlib/benz/codegen.c

@@ -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);
       }
     }

extlib/benz/cont.c

@@ -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);
 }

extlib/benz/gc.c

@@ -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

extlib/benz/include/picrin.h

@@ -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;

extlib/benz/number.c

@@ -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_vm(pic, "=", pic->rEQ, pic_number_eq);
-  pic_defun(pic, "<", pic_number_lt);
+  pic_defun_vm(pic, "<", pic->rLT, pic_number_lt);
-  pic_defun(pic, ">", pic_number_gt);
+  pic_defun_vm(pic, ">", pic->rGT, pic_number_gt);
-  pic_defun(pic, "<=", pic_number_le);
+  pic_defun_vm(pic, "<=", pic->rLE, pic_number_le);
-  pic_defun(pic, ">=", pic_number_ge);
+  pic_defun_vm(pic, ">=", pic->rGE, pic_number_ge);
   pic_gc_arena_restore(pic, ai);
 
-  pic_defun(pic, "+", pic_number_add);
+  pic_defun_vm(pic, "+", pic->rADD, pic_number_add);
-  pic_defun(pic, "-", pic_number_sub);
+  pic_defun_vm(pic, "-", pic->rSUB, pic_number_sub);
-  pic_defun(pic, "*", pic_number_mul);
+  pic_defun_vm(pic, "*", pic->rMUL, pic_number_mul);
-  pic_defun(pic, "/", pic_number_div);
+  pic_defun_vm(pic, "/", pic->rDIV, pic_number_div);
   pic_gc_arena_restore(pic, ai);
 
   pic_defun(pic, "abs", pic_number_abs);

extlib/benz/pair.c

@@ -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);
+  void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t);
-  pic_defun(pic, "cons", pic_pair_cons);
+
-  pic_defun(pic, "car", pic_pair_car);
+  pic_defun_vm(pic, "pair?", pic->rPAIRP, pic_pair_pair_p);
-  pic_defun(pic, "cdr", pic_pair_cdr);
+  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);

extlib/benz/state.c

@@ -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 */

extlib/benz/symbol.c

@@ -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);
 

extlib/benz/vm.c

@@ -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)
 {