guile/guile-vm/src .cvsignore Makefile.am vm-sn...

[Keisuke Nishida]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Keisuke Nishida <address@hidden>        00/09/27 16:29:46

Modified files:
        guile-vm/src   : .cvsignore Makefile.am vm-snarf.h vm.c vm.h 
                         vm_engine.c vm_engine.h 

Log message:
        Indirect threaded.  Performance is the same as before.  Wow\!

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/.cvsignore.diff?r1=1.2&r2=1.3
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/Makefile.am.diff?r1=1.1.1.1&r2=1.2
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/vm-snarf.h.diff?r1=1.1.1.1&r2=1.2
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/vm.c.diff?r1=1.6&r2=1.7
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/vm.h.diff?r1=1.2&r2=1.3
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/vm_engine.c.diff?r1=1.4&r2=1.5
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-vm/src/vm_engine.h.diff?r1=1.4&r2=1.5

Patches:
Index: guile/guile-vm/src/.cvsignore
diff -u guile/guile-vm/src/.cvsignore:1.2 guile/guile-vm/src/.cvsignore:1.3
--- guile/guile-vm/src/.cvsignore:1.2   Tue Aug 22 09:02:45 2000
+++ guile/guile-vm/src/.cvsignore       Wed Sep 27 16:29:45 2000
@@ -10,7 +10,8 @@
 Makefile
 Makefile.in
 *.x
-*.vi
-*.op
+*.inst
+*.label
+*.opcode
 *.lo
 *.la
Index: guile/guile-vm/src/Makefile.am
diff -u guile/guile-vm/src/Makefile.am:1.1 guile/guile-vm/src/Makefile.am:1.2
--- guile/guile-vm/src/Makefile.am:1.1  Tue Aug 22 08:54:19 2000
+++ guile/guile-vm/src/Makefile.am      Wed Sep 27 16:29:45 2000
@@ -11,8 +11,9 @@
 noinst_HEADERS = vm.h vm_engine.h vm-snarf.h
 EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_number.c \
             test.scm guile-compile.in
-BUILT_SOURCES = vm_system.vi vm_scheme.vi vm_number.vi \
-               vm_system.op vm_scheme.op vm_number.op vm.x
+BUILT_SOURCES = vm_system.inst vm_scheme.inst vm_number.inst \
+               vm_system.label vm_scheme.label vm_number.label \
+               vm_system.opcode vm_scheme.opcode vm_number.opcode vm.x
 
 CFLAGS = -g -O2 -Wall
 INCLUDES = $(GUILE_CFLAGS)
@@ -21,16 +22,20 @@
 MAINTAINERCLEANFILES = Makefile.in config.h.in stamp-h.in
 
 SNARF = guile-snarf
-SUFFIXES = .x .vi .op
+SUFFIXES = .x .inst .label .opcode
 .c.x:
        $(SNARF) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
        || { rm $@; false; }
 
-.c.vi:
+.c.inst:
        $(SNARF) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
        || { rm $@; false; }
 
-.c.op:
+.c.label:
+       $(SNARF) -DSCM_SNARF_LABEL $(DEFS) $(INCLUDES) $(CPPFLAGS) \
+       $(CFLAGS) $< > $@ || { rm $@; false; }
+
+.c.opcode:
        $(SNARF) -DSCM_SNARF_OPCODE $(DEFS) $(INCLUDES) $(CPPFLAGS) \
        $(CFLAGS) $< > $@ || { rm $@; false; }
 
Index: guile/guile-vm/src/vm-snarf.h
diff -u guile/guile-vm/src/vm-snarf.h:1.1 guile/guile-vm/src/vm-snarf.h:1.2
--- guile/guile-vm/src/vm-snarf.h:1.1   Tue Aug 22 08:54:19 2000
+++ guile/guile-vm/src/vm-snarf.h       Wed Sep 27 16:29:45 2000
@@ -65,22 +65,36 @@
 
 #else /* SCM_MAGIC_SNARFER */
 #ifndef SCM_SNARF_OPCODE
+#ifndef SCM_SNARF_LABEL
 
 /*
- * These will go to *.vi
+ * These will go to *.inst
  */
 #define SCM_DEFINE_INSTRUCTION(TAG,NAME,TYPE) \
-  SCM_SNARF_INIT_START {VM_OPCODE(TAG), TYPE, NAME, VM_ADDR(TAG), SCM_BOOL_F, 
NULL, 0, 0},
+  SCM_SNARF_INIT_START {VM_OPCODE(TAG), TYPE, NAME, SCM_BOOL_F, NULL, 0, 0},
 #define SCM_DEFINE_VM_FUNCTION(TAG,SNAME,NAME,NARGS,RESTP) \
-  SCM_SNARF_INIT_START {VM_OPCODE(TAG), INST_NONE, NAME, VM_ADDR(TAG), 
SCM_BOOL_F, SNAME, NARGS, RESTP},
+  SCM_SNARF_INIT_START {VM_OPCODE(TAG), INST_NONE, NAME, SCM_BOOL_F, SNAME, 
NARGS, RESTP},
 
+#else /* SCM_SNARF_LABEL */
+
+/*
+ * These will go to *.label
+ */
+#define SCM_DEFINE_INSTRUCTION(TAG,NAME,TYPE) \
+  SCM_SNARF_INIT_START VM_ADDR(TAG),
+#define SCM_DEFINE_VM_FUNCTION(TAG,SNAME,NAME,NARGS,RESTP) \
+  SCM_SNARF_INIT_START VM_ADDR(TAG),
+
+#endif /* SCM_SNARF_LABEL */
 #else /* SCM_SNARF_OPCODE */
 
 /*
- * These will go to *.op
+ * These will go to *.opcode
  */
-#define SCM_DEFINE_INSTRUCTION(TAG,NAME,TYPE) SCM_SNARF_INIT_START 
VM_OPCODE(TAG),
-#define SCM_DEFINE_VM_FUNCTION(TAG,SNAME,NAME,NARGS,RESTP) 
SCM_SNARF_INIT_START VM_OPCODE(TAG),
+#define SCM_DEFINE_INSTRUCTION(TAG,NAME,TYPE) \
+  SCM_SNARF_INIT_START VM_OPCODE(TAG),
+#define SCM_DEFINE_VM_FUNCTION(TAG,SNAME,NAME,NARGS,RESTP) \
+  SCM_SNARF_INIT_START VM_OPCODE(TAG),
 
 #endif /* SCM_SNARF_OPCODE */
 #endif /* SCM_MAGIC_SNARFER */
Index: guile/guile-vm/src/vm.c
diff -u guile/guile-vm/src/vm.c:1.6 guile/guile-vm/src/vm.c:1.7
--- guile/guile-vm/src/vm.c:1.6 Fri Sep 22 10:38:36 2000
+++ guile/guile-vm/src/vm.c     Wed Sep 27 16:29:45 2000
@@ -114,21 +114,16 @@
  * Instruction
  */
 
-#define INSTRUCTION_HASH_SIZE op_last
-#define INSTRUCTION_HASH(ADDR) (((int) (ADDR) >> 1) % INSTRUCTION_HASH_SIZE)
+static long scm_instruction_tag;
 
-/* These variables are defined in VM engines when they are first called. */
-static struct scm_instruction *scm_regular_instruction_table = 0;
-static struct scm_instruction *scm_debug_instruction_table = 0;
-
-/* Hash table for finding instructions from addresses */
-static struct inst_hash {
-  void *addr;
-  struct scm_instruction *inst;
-  struct inst_hash *next;
-} *scm_instruction_hash_table[INSTRUCTION_HASH_SIZE];
+static struct scm_instruction scm_instruction_table[] = {
+#include "vm_system.inst"
+#include "vm_scheme.inst"
+#include "vm_number.inst"
+  {op_last}
+};
 
-static long scm_instruction_tag;
+#define SCM_INSTRUCTION(OP)    &scm_instruction_table[SCM_UNPACK (OP)]
 
 static SCM
 make_instruction (struct scm_instruction *instp)
@@ -155,35 +150,15 @@
 /* C interface */
 
 static struct scm_instruction *
-find_instruction_by_name (const char *name)
+scm_lookup_instruction (const char *name)
 {
   struct scm_instruction *p;
-  for (p = scm_regular_instruction_table; p->opcode != op_last; p++)
+  for (p = scm_instruction_table; p->opcode != op_last; p++)
     if (strcmp (name, p->name) == 0)
       return p;
   return 0;
 }
 
-static struct scm_instruction *
-find_instruction_by_code (SCM code)
-{
-  struct inst_hash *p;
-  void *addr = SCM_CODE_TO_ADDR (code);
-  for (p = scm_instruction_hash_table[INSTRUCTION_HASH (addr)]; p; p = p->next)
-    if (p->addr == addr)
-      return p->inst;
-  return 0;
-}
-
-#ifdef HAVE_LABELS_AS_VALUES
-static void *
-instruction_code_to_debug_addr (SCM code)
-{
-  struct scm_instruction *p = find_instruction_by_code (code);
-  return scm_debug_instruction_table[p->opcode].addr;
-}
-#endif
-
 /* Scheme interface */
 
 SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0,
@@ -219,7 +194,7 @@
 #define FUNC_NAME s_scm_instruction_name_p
 {
   SCM_VALIDATE_SYMBOL (1, name);
-  return SCM_BOOL (find_instruction_by_name (SCM_SYMBOL_CHARS (name)));
+  return SCM_BOOL (scm_lookup_instruction (SCM_SYMBOL_CHARS (name)));
 }
 #undef FUNC_NAME
 
@@ -231,7 +206,7 @@
   struct scm_instruction *p;
   SCM_VALIDATE_SYMBOL (1, name);
 
-  p = find_instruction_by_name (SCM_SYMBOL_CHARS (name));
+  p = scm_lookup_instruction (SCM_SYMBOL_CHARS (name));
   if (!p)
     SCM_MISC_ERROR ("No such instruction: ~S", SCM_LIST1 (name));
 
@@ -246,7 +221,7 @@
 {
   SCM list = SCM_EOL;
   struct scm_instruction *p;
-  for (p = scm_regular_instruction_table; p->opcode != op_last; p++)
+  for (p = scm_instruction_table; p->opcode != op_last; p++)
     list = scm_cons (p->obj, list);
   return scm_reverse_x (list, SCM_EOL);
 }
@@ -338,7 +313,7 @@
 
   for (i = 0; i < size; i++)
     {
-      p = find_instruction_by_code (base[i]);
+      p = SCM_INSTRUCTION (base[i]);
       switch (p->type)
        {
        case INST_NONE:
@@ -472,9 +447,9 @@
 
       /* Process instruction */
       if (!SCM_SYMBOLP (old[i])
-         || !(p = find_instruction_by_name (SCM_SYMBOL_CHARS (old[i]))))
+         || !(p = scm_lookup_instruction (SCM_SYMBOL_CHARS (old[i]))))
        SCM_MISC_ERROR ("Invalid instruction: ~S", SCM_LIST1 (old[i]));
-      new[i] = SCM_ADDR_TO_CODE (p->addr);
+      new[i] = SCM_PACK (p->opcode);
 
       /* Process arguments */
       if (p->type == INST_NONE)
@@ -543,7 +518,7 @@
       struct scm_instruction *p;
 
       /* Process instruction */
-      p = find_instruction_by_code (old[i]);
+      p = SCM_INSTRUCTION (old[i]);
       if (!p)
        {
        broken:
@@ -1010,7 +985,7 @@
 
   p = SCM_VM_ADDRESS (addr);
 
-  inst = find_instruction_by_code (*p);
+  inst = SCM_INSTRUCTION (*p);
   if (!inst)
     SCM_MISC_ERROR ("Broken bytecode", SCM_LIST1 (addr));
 
@@ -1135,7 +1110,7 @@
 static SCM scm_regular_vm (SCM vm, SCM program);
 static SCM scm_debug_vm (SCM vm, SCM program);
 
-#define VM_CODE(name) SCM_ADDR_TO_CODE (find_instruction_by_name (name)->addr)
+#define VM_CODE(name) SCM_PACK (scm_lookup_instruction (name)->opcode)
 
 SCM_DEFINE (scm_vm_run, "vm-run", 2, 0, 0,
            (SCM vm, SCM program),
@@ -1256,7 +1231,6 @@
   /* Initialize the module */
   scm_module_vm = scm_make_module (scm_read_0str ("(vm vm)"));
   old_module = scm_select_module (scm_module_vm);
-
   init_name_property ();
   init_instruction_type ();
   init_bytecode_type ();
@@ -1264,37 +1238,15 @@
   init_vm_frame_type ();
   init_vm_cont_type ();
   init_vm_type ();
-
 #include "vm.x"
-
   scm_select_module (old_module);
 
-  /* Initialize instruction tables */
   {
-    int i;
     struct scm_instruction *p;
-
-    SCM vm = make_vm (0);
-    scm_regular_vm (vm, SCM_BOOL_F);
-    scm_debug_vm (vm, SCM_BOOL_F);
-
-    /* hash table */
-    for (i = 0; i < INSTRUCTION_HASH_SIZE; i++)
-      scm_instruction_hash_table[i] = NULL;
-
-    for (p = scm_regular_instruction_table; p->opcode != op_last; p++)
+    for (p = scm_instruction_table; p->opcode != op_last; p++)
       {
-       int hash;
-       struct inst_hash *data;
-       SCM inst = scm_permanent_object (make_instruction (p));
-       p->obj = inst;
+       p->obj = scm_permanent_object (make_instruction (p));
        if (p->restp) p->type = INST_INUM;
-       hash = INSTRUCTION_HASH (p->addr);
-       data = scm_must_malloc (sizeof (*data), "inst_hash");
-       data->addr = p->addr;
-       data->inst = p;
-       data->next = scm_instruction_hash_table[hash];
-       scm_instruction_hash_table[hash] = data;
       }
   }
 }
Index: guile/guile-vm/src/vm.h
diff -u guile/guile-vm/src/vm.h:1.2 guile/guile-vm/src/vm.h:1.3
--- guile/guile-vm/src/vm.h:1.2 Tue Aug 22 12:02:22 2000
+++ guile/guile-vm/src/vm.h     Wed Sep 27 16:29:45 2000
@@ -51,9 +51,9 @@
 
 /* Opcode */
 enum scm_opcode {
-#include "vm_system.op"
-#include "vm_scheme.op"
-#include "vm_number.op"
+#include "vm_system.opcode"
+#include "vm_scheme.opcode"
+#include "vm_number.opcode"
   op_last
 };
 
@@ -73,7 +73,6 @@
   enum scm_opcode opcode;      /* opcode */
   enum scm_inst_type type;     /* argument type */
   char *name;                  /* instruction name */
-  void *addr;                  /* instruction address */
   SCM obj;                     /* instruction object */
   /* fields for VM functions */
   char *sname;                 /* Scheme procedure name */
Index: guile/guile-vm/src/vm_engine.c
diff -u guile/guile-vm/src/vm_engine.c:1.4 guile/guile-vm/src/vm_engine.c:1.5
--- guile/guile-vm/src/vm_engine.c:1.4  Sun Sep 10 15:36:28 2000
+++ guile/guile-vm/src/vm_engine.c      Wed Sep 27 16:29:45 2000
@@ -45,14 +45,11 @@
 
 /* VM names */
 #undef VM_NAME
-#undef VM_TABLE
 #if VM_ENGINE == SCM_VM_REGULAR_ENGINE
 #define VM_NAME                scm_regular_vm
-#define VM_TABLE       scm_regular_instruction_table
 #else
 #if VM_ENGINE == SCM_VM_DEBUG_ENGINE
 #define VM_NAME                scm_debug_vm
-#define VM_TABLE       scm_debug_instruction_table
 #endif
 #endif
 
@@ -79,20 +76,12 @@
   SCM hook_args = SCM_LIST1 (vm);
 #endif
 
-  /* Initialize the instruction table at the first time.
-   * This code must be here because the following table contains
-   * pointers to the labels defined in this function.  */
-  if (!VM_TABLE)
-    {
-      static struct scm_instruction table[] = {
-#include "vm_system.vi"
-#include "vm_scheme.vi"
-#include "vm_number.vi"
-       { op_last }
-      };
-      VM_TABLE = table;
-      return SCM_UNSPECIFIED;
-    }
+  /* Jump talbe */
+  static void *jump_table[] = {
+#include "vm_system.label"
+#include "vm_scheme.label"
+#include "vm_number.label"
+  };
 
   /* Initialize the VM */
   vmp     = SCM_VM_DATA (vm);
Index: guile/guile-vm/src/vm_engine.h
diff -u guile/guile-vm/src/vm_engine.h:1.4 guile/guile-vm/src/vm_engine.h:1.5
--- guile/guile-vm/src/vm_engine.h:1.4  Fri Sep  1 23:59:13 2000
+++ guile/guile-vm/src/vm_engine.h      Wed Sep 27 16:29:45 2000
@@ -348,11 +348,7 @@
 
 #undef VM_GOTO_NEXT
 #if HAVE_LABELS_AS_VALUES
-#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
-#define VM_GOTO_NEXT()         goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ())
-#else /* not SCM_VM_DEBUG_ENGINE */
-#define VM_GOTO_NEXT()         goto *SCM_CODE_TO_ADDR (FETCH ())
-#endif
+#define VM_GOTO_NEXT()         goto *jump_table[SCM_UNPACK (FETCH ())]
 #else /* not HAVE_LABELS_AS_VALUES */
 #define VM_GOTO_NEXT()         goto vm_start
 #endif