make symbol -> opcode lookup faster

* libguile/instructions.c (fetch_instruction_table)
  (scm_lookup_instruction_by_name): Rework so we lazily load instructions
  into an array keyed by opcode, and a hash table keyed by symbolic name.
  Much faster, in this hot spot of compilation.

* libguile/vm-engine.c (vm_run): Use malloc instead of scm_gc_malloc,
  given that we aren't ever going to free this thing.

* libguile/vm-expand.h (VM_DEFINE_FUNCTION, VM_DEFINE_LOADER): Rework to
  always be aliases to VM_DEFINE_INSTRUCTION.
  (VM_DEFINE_INSTRUCTION): In the table case, update to work with
  fetch_instruction_table().

libguile/instructions.c

@@ -57,16 +57,7 @@ struct scm_instruction {
 				   -1 for insns like `call' which can take
 				   any number of arguments.  */
   char npush;			/* the number of values pushed */
-};
+  SCM symname;                  /* filled in later */
-
-static struct scm_instruction scm_instruction_table[] = {
-#define VM_INSTRUCTION_TO_TABLE 1
-#include "vm-expand.h"
-#include "vm-i-system.i"
-#include "vm-i-scheme.i"
-#include "vm-i-loader.i"
-#undef VM_INSTRUCTION_TO_TABLE
-  {scm_op_last}
 };
 
 #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar)               \
@@ -76,27 +67,58 @@ static struct scm_instruction scm_instruction_table[] = {
   } while (0)
 
 
+static struct scm_instruction*
+fetch_instruction_table ()
+{
+  static struct scm_instruction *table = NULL;
+
+  if (SCM_UNLIKELY (!table))
+    {
+      size_t bytes = scm_op_last * sizeof(struct scm_instruction);
+      int i;
+      table = malloc (bytes);
+      memset (table, 0, bytes);
+#define VM_INSTRUCTION_TO_TABLE 1
+#include "vm-expand.h"
+#include "vm-i-system.i"
+#include "vm-i-scheme.i"
+#include "vm-i-loader.i"
+#undef VM_INSTRUCTION_TO_TABLE
+      for (i = 0; i < scm_op_last; i++)
+        {
+          table[i].opcode = i;
+          if (table[i].name)
+            table[i].symname = scm_from_locale_symbol (table[i].name);
+          else
+            table[i].symname = SCM_BOOL_F;
+        }
+    }
+  return table;
+}
+
 static struct scm_instruction *
 scm_lookup_instruction_by_name (SCM name)
 {
-  struct scm_instruction *ip;
+  static SCM instructions_by_name = SCM_BOOL_F;
-  char *symbol;
+  struct scm_instruction *table = fetch_instruction_table ();
+  SCM op;
 
-  if (SCM_SYMBOLP (name))
+  if (SCM_UNLIKELY (SCM_FALSEP (instructions_by_name)))
-    for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
     { 
-	symbol = scm_to_locale_string (scm_symbol_to_string (name));
+      int i;
-	if ((symbol) && (strcmp (ip->name, symbol) == 0))
+      instructions_by_name = scm_make_hash_table (SCM_I_MAKINUM (scm_op_last));
-	  {
+      for (i = 0; i < scm_op_last; i++)
-	    free (symbol);
+        if (scm_is_true (table[i].symname))
-	    return ip;
+          scm_hashq_set_x (instructions_by_name, table[i].symname,
+                           SCM_I_MAKINUM (i));
+      instructions_by_name = scm_permanent_object (instructions_by_name);
     }
   
-	if (symbol)
+  op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED);
-	  free (symbol);
+  if (SCM_I_INUMP (op))
-      }
+    return &table[SCM_I_INUM (op)];
 
-  return 0;
+  return NULL;
 }
 
 
@@ -109,8 +131,9 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
 {
   SCM list = SCM_EOL;
   struct scm_instruction *ip;
-  for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
+  for (ip = fetch_instruction_table (); ip->opcode != scm_op_last; ip++)
-    list = scm_cons (scm_from_locale_symbol (ip->name), list);
+    if (ip->name)
+      list = scm_cons (ip->symname, list);
   return scm_reverse_x (list, SCM_EOL);
 }
 #undef FUNC_NAME
@@ -173,18 +196,19 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_opcode_to_instruction
 {
-  struct scm_instruction *ip;
   int opcode;
+  SCM ret = SCM_BOOL_F;
 
   SCM_MAKE_VALIDATE (1, op, I_INUMP);
   opcode = SCM_I_INUM (op);
 
-  for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
+  if (opcode < scm_op_last)
-    if (opcode == ip->opcode)
+    ret = fetch_instruction_table ()[opcode].symname;
-      return scm_from_locale_symbol (ip->name);
 
+  if (scm_is_false (ret))
     scm_wrong_type_arg_msg (FUNC_NAME, 1, op, "INSTRUCTION_P");
-  return SCM_BOOL_F; /* not reached */
+
+  return ret;
 }
 #undef FUNC_NAME
 

libguile/vm-engine.c

@@ -80,8 +80,7 @@ vm_run (SCM vm, SCM program, SCM args)
   if (SCM_UNLIKELY (!jump_table))
     {
       int i;
-      jump_table = scm_gc_malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof(void*),
+      jump_table = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof(void*));
-                                  "jump table");
       for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
         jump_table[i] = &&vm_error_bad_instruction;
 #define VM_INSTRUCTION_TO_LABEL 1

libguile/vm-expand.h

@@ -52,19 +52,24 @@
 #endif /* not HAVE_LABELS_AS_VALUES */
 #endif /* VM_LABEL */
 
-#undef VM_DEFINE_INSTRUCTION
 #undef VM_DEFINE_FUNCTION
 #undef VM_DEFINE_LOADER
-#ifdef VM_INSTRUCTION_TO_TABLE
+#define VM_DEFINE_FUNCTION(code,tag,name,nargs) \
+  VM_DEFINE_INSTRUCTION(code,tag,name,0,nargs,1)
+#define VM_DEFINE_LOADER(code,tag,name)         \
+  VM_DEFINE_INSTRUCTION(code,tag,name,-1,0,1)
+
+#undef VM_DEFINE_INSTRUCTION
 /*
  * These will go to scm_instruction_table in instructions.c
  */
-#define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush) \
+#ifdef VM_INSTRUCTION_TO_TABLE
-  {VM_OPCODE (tag), name, len, npop, npush},
+#define VM_DEFINE_INSTRUCTION(code_,tag_,name_,len_,npop_,npush_) \
-#define VM_DEFINE_FUNCTION(code,tag,name,nargs) \
+  table[VM_OPCODE (tag_)].opcode = VM_OPCODE (tag_);               \
-  {VM_OPCODE (tag), name, 0, nargs, 1},
+  table[VM_OPCODE (tag_)].name = name_;                            \
-#define VM_DEFINE_LOADER(code,tag,name)         \
+  table[VM_OPCODE (tag_)].len = len_;                              \
-  {VM_OPCODE (tag), name, -1, 0, 1},
+  table[VM_OPCODE (tag_)].npop = npop_;                            \
+  table[VM_OPCODE (tag_)].npush = npush_;
 
 #else
 #ifdef VM_INSTRUCTION_TO_LABEL
@@ -72,8 +77,6 @@
  * These will go to jump_table in vm_engine.c
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	jump_table[VM_OPCODE (tag)] = VM_ADDR (tag);
-#define VM_DEFINE_FUNCTION(code,tag,name,nargs)			jump_table[VM_OPCODE (tag)] = VM_ADDR (tag);
-#define VM_DEFINE_LOADER(code,tag,name)				jump_table[VM_OPCODE (tag)] = VM_ADDR (tag);
 
 #else
 #ifdef VM_INSTRUCTION_TO_OPCODE
@@ -81,16 +84,12 @@
  * These will go to scm_opcode in instructions.h
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	VM_OPCODE (tag) = code,
-#define VM_DEFINE_FUNCTION(code,tag,name,nargs)			VM_OPCODE (tag) = code,
-#define VM_DEFINE_LOADER(code,tag,name)				VM_OPCODE (tag) = code,
 
 #else /* Otherwise */
 /*
  * These are directly included in vm_engine.c
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	VM_TAG (tag)
-#define VM_DEFINE_FUNCTION(code,tag,name,nargs)			VM_TAG (tag)
-#define VM_DEFINE_LOADER(code,tag,name)				VM_TAG (tag)
 
 #endif /* VM_INSTRUCTION_TO_OPCODE */
 #endif /* VM_INSTRUCTION_TO_LABEL */