diff --git a/src/.cvsignore b/src/.cvsignore index 6f2800581..0ca232e65 100644 --- a/src/.cvsignore +++ b/src/.cvsignore @@ -10,7 +10,8 @@ stamp-h.in Makefile Makefile.in *.x -*.vi -*.op +*.inst +*.label +*.opcode *.lo *.la diff --git a/src/Makefile.am b/src/Makefile.am index 552690df9..c5b9b30b4 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -11,8 +11,9 @@ libguilevm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic 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 @@ DISTCLEANFILES = $(BUILT_SOURCES) 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; } diff --git a/src/vm-snarf.h b/src/vm-snarf.h index 8956e32c9..8e35ac1a3 100644 --- a/src/vm-snarf.h +++ b/src/vm-snarf.h @@ -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 */ diff --git a/src/vm.c b/src/vm.c index 414ddb7f6..43e554fff 100644 --- a/src/vm.c +++ b/src/vm.c @@ -114,22 +114,17 @@ init_name_property () * Instruction */ -#define INSTRUCTION_HASH_SIZE op_last -#define INSTRUCTION_HASH(ADDR) (((int) (ADDR) >> 1) % INSTRUCTION_HASH_SIZE) - -/* 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 long scm_instruction_tag; +static struct scm_instruction scm_instruction_table[] = { +#include "vm_system.inst" +#include "vm_scheme.inst" +#include "vm_number.inst" + {op_last} +}; + +#define SCM_INSTRUCTION(OP) &scm_instruction_table[SCM_UNPACK (OP)] + static SCM make_instruction (struct scm_instruction *instp) { @@ -155,35 +150,15 @@ init_instruction_type () /* 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 @@ SCM_DEFINE (scm_instruction_name_p, "instruction-name?", 1, 0, 0, #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 @@ SCM_DEFINE (scm_symbol_to_instruction, "symbol->instruction", 1, 0, 0, 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_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, { 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 @@ mark_bytecode (SCM bytecode) 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 @@ SCM_DEFINE (scm_make_bytecode, "make-bytecode", 1, 0, 0, /* 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 @@ SCM_DEFINE (scm_bytecode_decode, "bytecode-decode", 1, 0, 0, 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 @@ SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 2, 0, 0, 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 @@ SCM_SYMBOL (sym_debug, "debug"); 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 @@ scm_init_vm () /* 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 @@ scm_init_vm () 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; } } } diff --git a/src/vm.h b/src/vm.h index 4de9a5039..a1320f1b3 100644 --- a/src/vm.h +++ b/src/vm.h @@ -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 @@ struct scm_instruction { 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 */ diff --git a/src/vm_engine.c b/src/vm_engine.c index dbf68c534..9d459b17b 100644 --- a/src/vm_engine.c +++ b/src/vm_engine.c @@ -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 @@ VM_NAME (SCM vm, SCM program) 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); diff --git a/src/vm_engine.h b/src/vm_engine.h index e8fb3cf88..151e5969c 100644 --- a/src/vm_engine.h +++ b/src/vm_engine.h @@ -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