diff options
-rw-r--r-- | libguile/instructions.c | 41 | ||||
-rw-r--r-- | libguile/instructions.h | 2 | ||||
-rw-r--r-- | module/Makefile.am | 1 | ||||
-rw-r--r-- | module/language/cps/primitives.scm | 2 | ||||
-rw-r--r-- | module/language/rtl.scm | 9 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 8 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 2 | ||||
-rw-r--r-- | module/system/vm/frame.scm | 1 | ||||
-rw-r--r-- | module/system/vm/instruction.scm | 25 | ||||
-rw-r--r-- | module/system/vm/program.scm | 1 | ||||
-rw-r--r-- | module/system/vm/trace.scm | 1 | ||||
-rw-r--r-- | module/system/vm/traps.scm | 1 |
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 |