(system vm instruction) rtl-instruction-list -> (language rtl) instruction-list

* libguile/instructions.c (struct scm_instruction, fetch_instruction_table)
  (scm_instruction_list): Remove rtl_ infix.
* libguile/instructions.h: Adapt.

* module/system/vm/instruction.scm: Remove.

* module/language/rtl.scm: Export instruction-list from here.

* module/Makefile.am:
* module/language/cps/primitives.scm:
* module/system/vm/assembler.scm:
* module/system/vm/disassembler.scm:
* module/system/vm/frame.scm:
* module/system/vm/program.scm:
* module/system/vm/trace.scm:
* module/system/vm/traps.scm: Adapt.

12 files changed, 29 insertions, 65 deletions

diff --git a/libguile/instructions.c b/libguile/instructions.c
index 3dc15c2ff..eb2a685cf 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -76,14 +76,14 @@ static SCM word_type_symbols[] =
 #define OP(n,type) ((type) << (n*TYPE_WIDTH))
 
 /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of
-   arguments each RTL instruction takes.  This piece of code is the only
+   arguments each instruction takes.  This piece of code is the only
    bit that actually interprets that language.  These macro definitions
    encode the operand types into bits in a 32-bit integer.
 
-   (rtl-instruction-list) parses those encoded values into lists of
-   symbols, one for each 32-bit word that the operator takes.  (system
-   vm rtl) uses those word types to generate assemblers and
-   disassemblers for the instructions.  */
+   (instruction-list) parses those encoded values into lists of symbols,
+   one for each 32-bit word that the operator takes.  This list is used
+   by Scheme to generate assemblers and disassemblers for the
+   instructions.  */
 
 #define OP1(type0) \
   (OP (0, type0))
@@ -101,7 +101,7 @@ static SCM word_type_symbols[] =
 #define WORD_TYPE(n, word) \
   (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
 
-struct scm_rtl_instruction {
+struct scm_instruction {
   enum scm_rtl_opcode opcode;	/* opcode */
   const char *name;		/* instruction name */
   scm_t_uint32 meta;
@@ -109,25 +109,18 @@ struct scm_rtl_instruction {
 };
 
 
-#define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar)               \
-  do {                                                                \
-    cvar = scm_lookup_instruction_by_name (var);                      \
-    SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P");     \
-  } while (0)
-
-
 static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 
-static const struct scm_rtl_instruction*
-fetch_rtl_instruction_table ()
+static const struct scm_instruction*
+fetch_instruction_table ()
 {
-  static struct scm_rtl_instruction *table = NULL;
+  static struct scm_instruction *table = NULL;
 
   scm_i_pthread_mutex_lock (&itable_lock);
   if (SCM_UNLIKELY (!table))
     {
-      size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_rtl_instruction);
+      size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction);
       int i;
       table = malloc (bytes);
       memset (table, 0, bytes);
@@ -153,14 +146,14 @@ fetch_rtl_instruction_table ()
 
 /* Scheme interface */
 
-SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0,
+SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
 	    (void),
 	    "")
-#define FUNC_NAME s_scm_rtl_instruction_list
+#define FUNC_NAME s_scm_instruction_list
 {
   SCM list = SCM_EOL;
   int i;
-  const struct scm_rtl_instruction *ip = fetch_rtl_instruction_table ();
+  const struct scm_instruction *ip = fetch_instruction_table ();
   for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
     if (ip[i].name)
       {
@@ -216,16 +209,16 @@ scm_bootstrap_instructions (void)
                             "scm_init_instructions",
                             (scm_t_extension_init_func)scm_init_instructions,
                             NULL);
+}
 
+void
+scm_init_instructions (void)
+{
 #define INIT(type) \
   word_type_symbols[type] = scm_from_utf8_symbol (#type);
     FOR_EACH_INSTRUCTION_WORD_TYPE (INIT)
 #undef INIT
-}
 
-void
-scm_init_instructions (void)
-{
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/instructions.x"
 #endif
diff --git a/libguile/instructions.h b/libguile/instructions.h
index fc9bce8ee..214a9469b 100644
--- a/libguile/instructions.h
+++ b/libguile/instructions.h
@@ -78,7 +78,7 @@ enum scm_rtl_opcode
 #define SCM_VM_NUM_INSTRUCTIONS (1<<8)
 #define SCM_VM_INSTRUCTION_MASK (SCM_VM_NUM_INSTRUCTIONS-1)
 
-SCM_INTERNAL SCM scm_rtl_instruction_list (void);
+SCM_INTERNAL SCM scm_instruction_list (void);
 
 SCM_INTERNAL void scm_bootstrap_instructions (void);
 SCM_INTERNAL void scm_init_instructions (void);
diff --git a/module/Makefile.am b/module/Makefile.am
index 3074fd9e2..d3878cd3e 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -355,7 +355,6 @@ SYSTEM_SOURCES =				\
   system/vm/elf.scm				\
   system/vm/linker.scm				\
   system/vm/frame.scm				\
-  system/vm/instruction.scm			\
   system/vm/objcode.scm				\
   system/vm/program.scm				\
   system/vm/trace.scm				\
diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm
index 323f62371..5a5fadc63 100644
--- a/module/language/cps/primitives.scm
+++ b/module/language/cps/primitives.scm
@@ -91,7 +91,7 @@
   (let ((table (make-hash-table)))
     (for-each
      (match-lambda ((inst . _) (hashq-set! table inst inst)))
-     (rtl-instruction-list))
+     (instruction-list))
     (for-each
      (match-lambda ((prim . inst) (hashq-set! table prim inst)))
      *rtl-instruction-aliases*)
diff --git a/module/language/rtl.scm b/module/language/rtl.scm
index 8ec9fe2f6..89b9ac84b 100644
--- a/module/language/rtl.scm
+++ b/module/language/rtl.scm
@@ -21,13 +21,14 @@
 (define-module (language rtl)
   #:use-module (ice-9 match)
   #:use-module ((srfi srfi-1) #:select (fold))
-  #:use-module (system vm instruction)
-  #:re-export (rtl-instruction-list)
-  #:export (rtl-instruction-arity
+  #:export (instruction-list
+            rtl-instruction-arity
             builtin-name->index
             builtin-index->name))
 
 (load-extension (string-append "libguile-" (effective-version))
+                "scm_init_instructions")
+(load-extension (string-append "libguile-" (effective-version))
                 "scm_init_vm_builtins")
 
 (define (compute-rtl-instruction-arity name args)
@@ -84,7 +85,7 @@
       ((name op '<- . args)
        (hashq-set! table name
                    (cons 1 (1- (compute-rtl-instruction-arity name args))))))
-     (rtl-instruction-list))
+     (instruction-list))
     (for-each (match-lambda
                ((name . arity)
                 (hashq-set! table name arity)))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 7c1d58982..7a0cdcc1a 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -26,7 +26,7 @@
 ;;;
 ;;; "Primitive instructions" correspond to RTL VM operations.
 ;;; Assemblers for primitive instructions are generated programmatically
-;;; from (rtl-instruction-list), which itself is derived from the VM
+;;; from (instruction-list), which itself is derived from the VM
 ;;; sources.  There are also "macro-instructions" like "label" or
 ;;; "load-constant" that expand to 0 or more primitive instructions.
 ;;;
@@ -44,10 +44,10 @@
 
 (define-module (system vm assembler)
   #:use-module (system base target)
-  #:use-module (system vm instruction)
   #:use-module (system vm dwarf)
   #:use-module (system vm elf)
   #:use-module (system vm linker)
+  #:use-module (language rtl)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 vlist)
@@ -342,7 +342,7 @@ later by the linker."
 
 ;;;
 ;;; Primitive assemblers are defined by expanding `assembler' for each
-;;; opcode in `(rtl-instruction-list)'.
+;;; opcode in `(instruction-list)'.
 ;;;
 
 (eval-when (expand compile load eval)
@@ -476,7 +476,7 @@ later by the linker."
       ((visit-opcodes macro arg ...)
        (with-syntax (((inst ...)
                       (map (lambda (x) (datum->syntax #'macro x))
-                           (rtl-instruction-list))))
+                           (instruction-list))))
          #'(begin
              (macro arg ... . inst)
              ...))))))
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index cfc8a15f3..6e8c6315c 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -48,7 +48,7 @@
       ((visit-opcodes macro arg ...)
        (with-syntax (((inst ...)
                       (map (lambda (x) (datum->syntax #'macro x))
-                           (rtl-instruction-list))))
+                           (instruction-list))))
          #'(begin
              (macro arg ... . inst)
              ...))))))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 3c0cbb53a..a5de861e4 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -21,7 +21,6 @@
 (define-module (system vm frame)
   #:use-module (system base pmatch)
   #:use-module (system vm program)
-  #:use-module (system vm instruction)
   #:export (frame-bindings
             frame-lookup-binding
             frame-binding-ref frame-binding-set!
diff --git a/module/system/vm/instruction.scm b/module/system/vm/instruction.scm
deleted file mode 100644
index 78d9db137..000000000
--- a/module/system/vm/instruction.scm
+++ /dev/null
@@ -1,25 +0,0 @@
-;;; Guile VM instructions
-
-;; Copyright (C) 2001, 2010, 2012, 2013 Free Software Foundation, Inc.
-
-;;; This library is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public
-;;; License as published by the Free Software Foundation; either
-;;; version 3 of the License, or (at your option) any later version.
-;;;
-;;; This library is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Code:
-
-(define-module (system vm instruction)
-  #:export (rtl-instruction-list))
-
-(load-extension (string-append "libguile-" (effective-version))
-                "scm_init_instructions")
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index bbb9ef712..a2d774dcd 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -20,7 +20,6 @@
 
 (define-module (system vm program)
   #:use-module (ice-9 match)
-  #:use-module (system vm instruction)
   #:use-module (system vm debug)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 717013fc7..0135b39f3 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -25,7 +25,6 @@
   #:use-module (system vm program)
   #:use-module (system vm traps)
   #:use-module (rnrs bytevectors)
-  #:use-module (system vm instruction)
   #:use-module (ice-9 format)
   #:export (trace-calls-in-procedure
             trace-calls-to-procedure
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index c7ee2a05a..2d1a09aae 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -60,7 +60,6 @@
   #:use-module (system vm debug)
   #:use-module (system vm frame)
   #:use-module (system vm program)
-  #:use-module (system vm instruction)
   #:use-module (system xref)
   #:use-module (rnrs bytevectors)
   #:export (trap-at-procedure-call