(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.

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
+   (instruction-list) parses those encoded values into lists of symbols,
-   symbols, one for each 32-bit word that the operator takes.  (system
+   one for each 32-bit word that the operator takes.  This list is used
-   vm rtl) uses those word types to generate assemblers and
+   by Scheme to generate assemblers and disassemblers for the
-   disassemblers for the instructions.  */
+   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*
+static const struct scm_instruction*
-fetch_rtl_instruction_table ()
+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);
-
-#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)
 {
+#define INIT(type) \
+  word_type_symbols[type] = scm_from_utf8_symbol (#type);
+    FOR_EACH_INSTRUCTION_WORD_TYPE (INIT)
+#undef INIT
+
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/instructions.x"
 #endif

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

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				\

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*)

module/language/rtl.scm

@@ -21,12 +21,13 @@
 (define-module (language rtl)
   #:use-module (ice-9 match)
   #:use-module ((srfi srfi-1) #:select (fold))
-  #:use-module (system vm instruction)
+  #:export (instruction-list
-  #:re-export (rtl-instruction-list)
+            rtl-instruction-arity
-  #:export (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")
 
@@ -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)))

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)
              ...))))))

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)
              ...))))))

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!

module/system/vm/instruction.scm

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

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)

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

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