1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00

Rename "RTL" to "bytecode"

"RTL" didn't make any sense, and now that there's no other bytecode to
disambiguate against, just call it bytecode.

* module/Makefile.am:
* module/ice-9/eval-string.scm:
* module/language/bytecode.scm:
* module/language/bytecode/spec.scm:
* module/language/cps/arities.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/compile-rtl.scm:
* module/language/cps/contification.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/primitives.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/spec.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/rtl.scm:
* module/language/rtl/spec.scm:
* module/scripts/compile.scm:
* module/system/base/compile.scm:
* module/system/repl/common.scm:
* module/system/vm/assembler.scm:
* module/system/vm/debug.scm:
* module/system/vm/disassembler.scm:
* module/system/vm/dwarf.scm:
* test-suite/tests/cross-compilation.test:
* test-suite/tests/dwarf.test:
* test-suite/tests/rtl-compilation.test:
* test-suite/tests/rtl.test:
* test-suite/vm/run-vm-tests.scm: Fixups.
This commit is contained in:
Andy Wingo 2013-12-02 21:31:47 +01:00
parent 7f71030837
commit 691697de09
24 changed files with 132 additions and 132 deletions

View file

@ -57,7 +57,7 @@ SOURCES = \
language/tree-il.scm \
$(TREE_IL_LANG_SOURCES) \
$(CPS_LANG_SOURCES) \
$(RTL_LANG_SOURCES) \
$(BYTECODE_LANG_SOURCES) \
$(VALUE_LANG_SOURCES) \
$(SCHEME_LANG_SOURCES) \
$(SYSTEM_BASE_SOURCES) \
@ -120,7 +120,7 @@ CPS_LANG_SOURCES = \
language/cps.scm \
language/cps/arities.scm \
language/cps/closure-conversion.scm \
language/cps/compile-rtl.scm \
language/cps/compile-bytecode.scm \
language/cps/constructors.scm \
language/cps/contification.scm \
language/cps/dfg.scm \
@ -132,9 +132,9 @@ CPS_LANG_SOURCES = \
language/cps/specialize-primcalls.scm \
language/cps/verify.scm
RTL_LANG_SOURCES = \
language/rtl.scm \
language/rtl/spec.scm
BYTECODE_LANG_SOURCES = \
language/bytecode.scm \
language/bytecode/spec.scm
VALUE_LANG_SOURCES = \
language/value/spec.scm

View file

@ -86,5 +86,5 @@
(if (or compile? (not (language-evaluator lang)))
((load-thunk-from-memory
(read-and-compile port #:from lang #:to 'rtl)))
(read-and-compile port #:from lang #:to 'bytecode)))
(read-and-eval port #:lang lang))))))))

View file

@ -1,4 +1,4 @@
;;; Register Transfer Language (RTL)
;;; Bytecode
;; Copyright (C) 2013 Free Software Foundation, Inc.
@ -18,11 +18,11 @@
;;; Code:
(define-module (language rtl)
(define-module (language bytecode)
#:use-module (ice-9 match)
#:use-module ((srfi srfi-1) #:select (fold))
#:export (instruction-list
rtl-instruction-arity
instruction-arity
builtin-name->index
builtin-index->name))
@ -31,7 +31,7 @@
(load-extension (string-append "libguile-" (effective-version))
"scm_init_vm_builtins")
(define (compute-rtl-instruction-arity name args)
(define (compute-instruction-arity name args)
(define (first-word-arity word)
(case word
((U8_X24) 0)
@ -74,17 +74,17 @@
(cached-toplevel-box . (1 . 3))
(cached-module-box . (1 . 4))))
(define (compute-rtl-instruction-arities)
(define (compute-instruction-arities)
(let ((table (make-hash-table)))
(for-each
(match-lambda
;; Put special cases here.
((name op '! . args)
(hashq-set! table name
(cons 0 (compute-rtl-instruction-arity name args))))
(cons 0 (compute-instruction-arity name args))))
((name op '<- . args)
(hashq-set! table name
(cons 1 (1- (compute-rtl-instruction-arity name args))))))
(cons 1 (1- (compute-instruction-arity name args))))))
(instruction-list))
(for-each (match-lambda
((name . arity)
@ -92,7 +92,7 @@
*macro-instruction-arities*)
table))
(define *rtl-instruction-arities* (delay (compute-rtl-instruction-arities)))
(define *instruction-arities* (delay (compute-instruction-arities)))
(define (rtl-instruction-arity name)
(hashq-ref (force *rtl-instruction-arities*) name))
(define (instruction-arity name)
(hashq-ref (force *instruction-arities*) name))

View file

@ -1,4 +1,4 @@
;;; Register Transfer Language (RTL)
;;; Bytecode
;; Copyright (C) 2013 Free Software Foundation, Inc.
@ -18,13 +18,13 @@
;;; Code:
(define-module (language rtl spec)
(define-module (language bytecode spec)
#:use-module (system base language)
#:use-module (system vm loader)
#:use-module (ice-9 binary-ports)
#:export (rtl))
#:export (bytecode))
(define (rtl->value x e opts)
(define (bytecode->value x e opts)
(let ((thunk (load-thunk-from-memory x)))
(if (eq? e (current-module))
;; save a cons in this case
@ -34,9 +34,9 @@
(set-current-module e)
(values (thunk) e e))))))
(define-language rtl
#:title "Register Transfer Language"
#:compilers `((value . ,rtl->value))
#:printer (lambda (rtl port) (put-bytevector port rtl))
(define-language bytecode
#:title "Bytecode"
#:compilers `((value . ,bytecode->value))
#:printer (lambda (bytecode port) (put-bytevector port bytecode))
#:reader get-bytevector-all
#:for-humans? #f)

View file

@ -131,7 +131,7 @@
;; Primcalls to return are in tail position.
($continue ktail src ,exp))
(($ $primcall (? (lambda (name)
(and (not (prim-rtl-instruction name))
(and (not (prim-instruction name))
(not (branching-primitive? name))))))
($continue k src ,exp))
(($ $primcall name args)
@ -139,7 +139,7 @@
((out . in)
(if (= in (length args))
(adapt-exp out k src
(let ((inst (prim-rtl-instruction name)))
(let ((inst (prim-instruction name)))
(if (and inst (not (eq? inst name)))
(build-cps-exp ($primcall inst args))
exp)))

View file

@ -18,12 +18,12 @@
;;; Commentary:
;;;
;;; Compiling CPS to RTL. The result is in the RTL language, which
;;; happens to be an ELF image as a bytecode.
;;; Compiling CPS to bytecode. The result is in the bytecode language,
;;; which happens to be an ELF image as a bytecode.
;;;
;;; Code:
(define-module (language cps compile-rtl)
(define-module (language cps compile-bytecode)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (language cps)
@ -38,7 +38,7 @@
#:use-module (language cps slot-allocation)
#:use-module (language cps specialize-primcalls)
#:use-module (system vm assembler)
#:export (compile-rtl))
#:export (compile-bytecode))
;; TODO: Local var names.
@ -305,7 +305,7 @@
(emit-bv-f64-ref asm dst (slot bv) (slot idx)))
(($ $primcall name args)
;; FIXME: Inline all the cases.
(let ((inst (prim-rtl-instruction name)))
(let ((inst (prim-instruction name)))
(emit-text asm `((,inst ,dst ,@(map slot args))))))))
(define (compile-effect label exp k nlocals)
@ -478,7 +478,7 @@
(_ (values))))
(define (compile-rtl exp env opts)
(define (compile-bytecode exp env opts)
(let* ((exp (fix-arities exp))
(exp (optimize exp opts))
(exp (convert-closures exp))

View file

@ -35,7 +35,7 @@
#:use-module (language cps)
#:use-module (language cps dfg)
#:use-module (language cps primitives)
#:use-module (language rtl)
#:use-module (language bytecode)
#:export (contify))
(define (compute-contification fun)

View file

@ -22,7 +22,7 @@
;;; they are calls, and indeed the later reify-primitives pass turns
;;; them into calls. Because no return arity checking is done for these
;;; primitives, if a later optimization pass simplifies the primcall to
;;; an RTL operation, the tail of the simplification has to be a
;;; a VM operation, the tail of the simplification has to be a
;;; primcall to 'values. Most of these primcalls can be elided, and
;;; that is the job of this pass.
;;;

View file

@ -26,13 +26,13 @@
#:use-module (ice-9 match)
#:use-module ((srfi srfi-1) #:select (fold))
#:use-module (srfi srfi-26)
#:use-module (language rtl)
#:export (prim-rtl-instruction
#:use-module (language bytecode)
#:export (prim-instruction
branching-primitive?
prim-arity
))
(define *rtl-instruction-aliases*
(define *instruction-aliases*
'((+ . add) (1+ . add1)
(- . sub) (1- . sub1)
(* . mul) (/ . div)
@ -87,24 +87,24 @@
(<= . (1 . 2))
(>= . (1 . 2))))
(define (compute-prim-rtl-instructions)
(define (compute-prim-instructions)
(let ((table (make-hash-table)))
(for-each
(match-lambda ((inst . _) (hashq-set! table inst inst)))
(instruction-list))
(for-each
(match-lambda ((prim . inst) (hashq-set! table prim inst)))
*rtl-instruction-aliases*)
*instruction-aliases*)
(for-each
(match-lambda ((inst . arity) (hashq-set! table inst inst)))
*macro-instruction-arities*)
table))
(define *prim-rtl-instructions* (delay (compute-prim-rtl-instructions)))
(define *prim-instructions* (delay (compute-prim-instructions)))
;; prim -> rtl-instruction | #f
(define (prim-rtl-instruction name)
(hashq-ref (force *prim-rtl-instructions*) name))
;; prim -> instruction | #f
(define (prim-instruction name)
(hashq-ref (force *prim-instructions*) name))
(define (branching-primitive? name)
(and (assq name *branching-primcall-arities*) #t))
@ -114,7 +114,7 @@
(define (prim-arity name)
(or (hashq-ref *prim-arities* name)
(let ((arity (cond
((prim-rtl-instruction name) => rtl-instruction-arity)
((prim-instruction name) => instruction-arity)
((assq name *branching-primcall-arities*) => cdr)
(else
(error "Primitive of unknown arity" name)))))

View file

@ -29,7 +29,7 @@
#:use-module (language cps)
#:use-module (language cps dfg)
#:use-module (language cps primitives)
#:use-module (language rtl)
#:use-module (language bytecode)
#:export (reify-primitives))
(define (module-box src module name public? bound? val-proc)
@ -144,7 +144,7 @@
($continue k src ($call proc ()))))
(($ $primcall name args)
(cond
((or (prim-rtl-instruction name) (branching-primitive? name))
((or (prim-instruction name) (branching-primitive? name))
;; Assume arities are correct.
term)
(else

View file

@ -21,7 +21,7 @@
(define-module (language cps spec)
#:use-module (system base language)
#:use-module (language cps)
#:use-module (language cps compile-rtl)
#:use-module (language cps compile-bytecode)
#:export (cps))
(define* (write-cps exp #:optional (port (current-output-port)))
@ -32,6 +32,6 @@
#:reader (lambda (port env) (read port))
#:printer write-cps
#:parser parse-cps
#:compilers `((rtl . ,compile-rtl))
#:compilers `((bytecode . ,compile-bytecode))
#:for-humans? #f
)

View file

@ -18,9 +18,9 @@
;;; Commentary:
;;;
;;; Some RTL operations can encode an immediate as an operand. This
;;; pass tranforms generic primcalls to these specialized primcalls, if
;;; possible.
;;; Some bytecode operations can encode an immediate as an operand.
;;; This pass tranforms generic primcalls to these specialized
;;; primcalls, if possible.
;;;
;;; Code:
@ -61,7 +61,7 @@
(($ $continue)
,term)))
(define (visit-primcall k src name args)
;; If we introduce an RTL op from a primcall without an RTL op, we
;; If we introduce a VM op from a primcall without a VM op, we
;; will need to ensure that the return arity matches. Rely on the
;; elide-values pass to clean up.
(define-syntax-rule (adapt-void exp)

View file

@ -139,7 +139,7 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
(cons #:O o)
o)))
(from (or (assoc-ref options 'from) 'scheme))
(to (or (assoc-ref options 'to) 'rtl))
(to (or (assoc-ref options 'to) 'bytecode))
(target (or (assoc-ref options 'target) %host-type))
(input-files (assoc-ref options 'input-files))
(output-file (assoc-ref options 'output-file))
@ -158,7 +158,7 @@ Compile each Guile source file FILE into a Guile object.
for a list of available warnings
-f, --from=LANG specify a source language other than `scheme'
-t, --to=LANG specify a target language other than `rtl'
-t, --to=LANG specify a target language other than `bytecode'
-T, --target=TRIPLET produce bytecode for host TRIPLET
Note that auto-compilation will be turned off.

View file

@ -133,7 +133,7 @@
(define* (compile-file file #:key
(output-file #f)
(from (current-language))
(to 'rtl)
(to 'bytecode)
(env (default-environment from))
(opts '())
(canonicalization 'relative))
@ -207,7 +207,7 @@
(define* (read-and-compile port #:key
(from (current-language))
(to 'rtl)
(to 'bytecode)
(env (default-environment from))
(opts '()))
(let ((from (ensure-language from))

View file

@ -177,7 +177,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(define (repl-compile repl form)
(let ((from (repl-language repl))
(opts (repl-compile-options repl)))
(compile form #:from from #:to 'rtl #:opts opts
(compile form #:from from #:to 'bytecode #:opts opts
#:env (current-module))))
(define (repl-expand repl form)

View file

@ -1,4 +1,4 @@
;;; Guile RTL assembler
;;; Guile bytecode assembler
;;; Copyright (C) 2001, 2009, 2010, 2012, 2013 Free Software Foundation, Inc.
;;;
@ -19,16 +19,16 @@
;;; Commentary:
;;;
;;; This module implements an assembler that creates an ELF image from
;;; RTL assembly and macro-assembly. The input can be given in
;;; bytecode assembly and macro-assembly. The input can be given in
;;; s-expression form, like ((OP ARG ...) ...). Internally there is a
;;; procedural interface, the emit-OP procedures, but that is not
;;; currently exported.
;;;
;;; "Primitive instructions" correspond to RTL VM operations.
;;; Assemblers for primitive instructions are generated programmatically
;;; 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.
;;; "Primitive instructions" correspond to VM operations. Assemblers
;;; for primitive instructions are generated programmatically 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.
;;;
;;; The assembler also handles some higher-level tasks, like creating
;;; the symbol table, other metadata sections, creating a constant table
@ -47,7 +47,7 @@
#:use-module (system vm dwarf)
#:use-module (system vm elf)
#:use-module (system vm linker)
#:use-module (language rtl)
#:use-module (language bytecode)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 vlist)
@ -63,7 +63,7 @@
;;; RTL code consists of 32-bit units, often subdivided in some way.
;;; Bytecode consists of 32-bit units, often subdivided in some way.
;;; These helpers create one 32-bit unit from multiple components.
(define-inlinable (pack-u8-u24 x y)
@ -136,7 +136,7 @@
;;; A <meta> entry collects metadata for one procedure. Procedures are
;;; written as contiguous ranges of RTL code.
;;; written as contiguous ranges of bytecode.
;;;
(define-syntax-rule (assert-match arg pattern kind)
(let ((x arg))
@ -179,7 +179,7 @@
;;; also maintains ancillary information such as the constant table, a
;;; relocation list, and so on.
;;;
;;; RTL code consists of 32-bit units. We emit RTL code using native
;;; Bytecode consists of 32-bit units. We emit bytecode using native
;;; endianness. If we're targeting a foreign endianness, we byte-swap
;;; the bytevector as a whole instead of conditionalizing each access.
;;;
@ -192,7 +192,7 @@
meta sources)
asm?
;; We write RTL code into what is logically a growable vector,
;; We write bytecode into what is logically a growable vector,
;; implemented as a list of blocks. asm-cur is the current block, and
;; asm-idx is the current index into that block, in 32-bit units.
;;
@ -203,9 +203,9 @@
;; beginning of an instruction (in u32 units). It is updated after
;; writing all the words for one primitive instruction. It models the
;; position of the instruction pointer during execution, given that
;; the RTL VM updates the IP only at the end of executing the
;; instruction, and is thus useful for computing offsets between two
;; points in a program.
;; the VM updates the IP only at the end of executing the instruction,
;; and is thus useful for computing offsets between two points in a
;; program.
;;
(start asm-start set-asm-start!)
@ -244,8 +244,8 @@
;;
(constants asm-constants set-asm-constants!)
;; A list of RTL instructions needed to initialize the constants.
;; Will run in a thunk with 2 local variables.
;; A list of instructions needed to initialize the constants. Will
;; run in a thunk with 2 local variables.
;;
(inits asm-inits set-asm-inits!)
@ -485,8 +485,8 @@ later by the linker."
(define (emit-text asm instructions)
"Assemble @var{instructions} using the assembler @var{asm}.
@var{instructions} is a sequence of RTL instructions, expressed as a
list of lists. This procedure can be called many times before calling
@var{instructions} is a sequence of instructions, expressed as a list of
lists. This procedure can be called many times before calling
@code{link-assembly}."
(for-each (lambda (inst)
(apply (or (hashq-ref assemblers (car inst))
@ -1203,10 +1203,10 @@ needed."
(define *bytecode-minor-version* 3)
(define (link-dynamic-section asm text rw rw-init)
"Link the dynamic section for an ELF image with RTL text, given the
writable data section @var{rw} needing fixup from the procedure with
label @var{rw-init}. @var{rw-init} may be false. If @var{rw} is true,
it will be added to the GC roots at runtime."
"Link the dynamic section for an ELF image with bytecode @var{text},
given the writable data section @var{rw} needing fixup from the
procedure with label @var{rw-init}. @var{rw-init} may be false. If
@var{rw} is true, it will be added to the GC roots at runtime."
(define-syntax-rule (emit-dynamic-section word-size %set-uword! reloc-type)
(let* ((endianness (asm-endianness asm))
(bv (make-bytevector (* word-size (if rw (if rw-init 12 10) 6)) 0))
@ -1316,8 +1316,8 @@ it will be added to the GC roots at runtime."
;;;
;;; All of the offsets and addresses are 32 bits. We can expand in the
;;; future to use 64-bit offsets if appropriate, but there are other
;;; aspects of RTL that constrain us to a total image that fits in 32
;;; bits, so for the moment we'll simplify the problem space.
;;; aspects of bytecode that constrain us to a total image that fits in
;;; 32 bits, so for the moment we'll simplify the problem space.
;;;
;;; The following flags values are defined:
;;;

View file

@ -18,8 +18,8 @@
;;; Commentary:
;;;
;;; Guile's RTL compiler and linker serialize debugging information into
;;; separate sections of the ELF image. This module reads those
;;; Guile's bytecode compiler and linker serialize debugging information
;;; into separate sections of the ELF image. This module reads those
;;; sections.
;;;
;;; Code:
@ -175,8 +175,8 @@ during the fold are omitted."
(define (find-debug-context addr)
"Find and return the debugging context corresponding to the ELF image
containing the address @var{addr}. @var{addr} is an integer. If no ELF
image is found, return @code{#f}. It's possible for an RTL program not
to have an ELF image if the program was defined in as a stub in C."
image is found, return @code{#f}. It's possible for an bytecode program
not to have an ELF image if the program was defined in as a stub in C."
(and=> (find-mapped-elf-image addr)
debug-context-from-image))

View file

@ -1,4 +1,4 @@
;;; Guile RTL disassembler
;;; Guile bytecode disassembler
;;; Copyright (C) 2001, 2009, 2010, 2012, 2013 Free Software Foundation, Inc.
;;;
@ -19,7 +19,7 @@
;;; Code:
(define-module (system vm disassembler)
#:use-module (language rtl)
#:use-module (language bytecode)
#:use-module (system vm elf)
#:use-module (system vm debug)
#:use-module (system vm program)

View file

@ -38,7 +38,7 @@
;;
;; The DIE nodes are contained in the .debug_info section of an ELF
;; file. Attributes within the DIE nodes link them to mapped ranges of
;; the ELF file (.rtl_text, .data, etc.).
;; the ELF file (.rtl-text, .data, etc.).
;;
;; A .debug_info section logically contains a series of debugging
;; "contributions", one for each compilation unit. Each contribution is

View file

@ -56,7 +56,7 @@
(string=? (native-os) (target-os)))
(native-word-size)
word-size))
(bv (compile '(hello-world) #:to 'rtl)))
(bv (compile '(hello-world) #:to 'bytecode)))
(and=> (parse-elf bv)
(lambda (elf)
(and (equal? (elf-byte-order elf) endian)
@ -83,7 +83,7 @@
(pass-if-exception "unknown target" exception:miscellaneous-error
(with-target "fcpu-unknown-gnu1.0"
(lambda ()
(compile '(ohai) #:to 'rtl)))))
(compile '(ohai) #:to 'bytecode)))))
;; Local Variables:
;; eval: (put 'with-target 'scheme-indent-function 1)

View file

@ -43,7 +43,7 @@
(let* ((port (open-input-string prog))
(bv (begin
(set-port-filename! port "foo.scm")
(read-and-compile port #:to 'rtl))))
(read-and-compile port #:to 'bytecode))))
(pass-if-equal 'success
((load-thunk-from-memory bv)))

View file

@ -1,4 +1,4 @@
;;;; rtl-compilation.test --- test suite for compiling via rtl -*- scheme -*-
;;;; rtl-compilation.test --- test suite for compiling via bytecode -*- scheme -*-
;;;;
;;;; Copyright (C) 2013 Free Software Foundation, Inc.
;;;;
@ -16,18 +16,18 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite rtl-compilation)
(define-module (test-suite bytecode-compilation)
#:use-module (test-suite lib)
#:use-module (system base compile)
#:use-module (system vm loader))
(define* (compile-via-rtl exp #:key peval? cse? (env (make-fresh-user-module)))
(define* (compile-via-bytecode exp #:key peval? cse? (env (make-fresh-user-module)))
(load-thunk-from-memory
(compile exp #:env env #:to 'rtl
(compile exp #:env env #:to 'bytecode
#:opts `(#:partial-eval? ,peval? #:cse? ,cse?))))
(define* (run-rtl exp #:key (env (make-fresh-user-module)))
(let ((thunk (compile-via-rtl exp #:env env)))
(define* (run-bytecode exp #:key (env (make-fresh-user-module)))
(let ((thunk (compile-via-bytecode exp #:env env)))
(save-module-excursion
(lambda ()
(set-current-module env)
@ -35,32 +35,32 @@
(with-test-prefix "tail context"
(pass-if-equal 1
(run-rtl '(let ((x 1)) x)))
(run-bytecode '(let ((x 1)) x)))
(pass-if-equal 1
(run-rtl 1))
(run-bytecode 1))
(pass-if-equal (if #f #f)
(run-rtl '(if #f #f)))
(run-bytecode '(if #f #f)))
(pass-if-equal "top-level define"
(list (if #f #f) 1)
(let ((mod (make-fresh-user-module)))
(let ((result (run-rtl '(define v 1) #:env mod)))
(let ((result (run-bytecode '(define v 1) #:env mod)))
(list result (module-ref mod 'v)))))
(pass-if-equal "top-level set!"
(list (if #f #f) 1)
(let ((mod (make-fresh-user-module)))
(module-define! mod 'v #f)
(let ((result (run-rtl '(set! v 1) #:env mod)))
(let ((result (run-bytecode '(set! v 1) #:env mod)))
(list result (module-ref mod 'v)))))
(pass-if-equal "top-level apply [single value]"
8
(let ((mod (make-fresh-user-module)))
(module-define! mod 'args '(2 3))
(run-rtl '(apply expt args) #:env mod)))
(run-bytecode '(apply expt args) #:env mod)))
(pass-if-equal "top-level apply [zero values]"
'()
@ -68,7 +68,7 @@
(module-define! mod 'proc (lambda () (values)))
(module-define! mod 'args '())
(call-with-values
(lambda () (run-rtl '(apply proc args) #:env mod))
(lambda () (run-bytecode '(apply proc args) #:env mod))
list)))
(pass-if-equal "top-level apply [two values]"
@ -77,45 +77,45 @@
(module-define! mod 'proc (lambda (n d) (floor/ n d)))
(module-define! mod 'args '(5 3))
(call-with-values
(lambda () (run-rtl '(apply proc args) #:env mod))
(lambda () (run-bytecode '(apply proc args) #:env mod))
list)))
(pass-if-equal "call-with-values"
'(1 2 3)
((run-rtl '(lambda (n d)
((run-bytecode '(lambda (n d)
(call-with-values (lambda () (floor/ n d))
(lambda (q r) (list q r (+ q r))))))
5 3))
(pass-if-equal cons
(run-rtl 'cons))
(run-bytecode 'cons))
(pass-if-equal 1
((run-rtl '(lambda () 1))))
((run-bytecode '(lambda () 1))))
(pass-if-equal 1
((run-rtl '(lambda (x) 1)) 2))
((run-bytecode '(lambda (x) 1)) 2))
(pass-if-equal 1
((run-rtl '(lambda (x) x)) 1))
((run-bytecode '(lambda (x) x)) 1))
(pass-if-equal 6
((((run-rtl '(lambda (x)
((((run-bytecode '(lambda (x)
(lambda (y)
(lambda (z)
(+ x y z))))) 1) 2) 3))
(pass-if-equal 1
(run-rtl '(identity 1)))
(run-bytecode '(identity 1)))
(pass-if-equal '(1 . 2)
(run-rtl '(cons 1 2)))
(run-bytecode '(cons 1 2)))
(pass-if-equal '(1 2)
(call-with-values (lambda () (run-rtl '(values 1 2))) list))
(call-with-values (lambda () (run-bytecode '(values 1 2))) list))
(pass-if-equal 28
((run-rtl '(lambda (x y z rest) (apply + x y z rest)))
((run-bytecode '(lambda (x y z rest) (apply + x y z rest)))
2 3 5 '(7 11)))
;; prompts
@ -135,7 +135,7 @@
(with-test-prefix "values context"
(pass-if-equal '(3 . 1)
(run-rtl
(run-bytecode
'(let ((rat (lambda (n d)
(call-with-values
(lambda () (floor/ n d))
@ -144,7 +144,7 @@
(rat 10 3)))))
(with-test-prefix "contification"
(pass-if ((run-rtl '(lambda (x)
(pass-if ((run-bytecode '(lambda (x)
(define (even? x)
(if (null? x) #t (odd? (cdr x))))
(define (odd? x)
@ -152,7 +152,7 @@
(even? x)))
'(1 2 3 4)))
(pass-if (not ((run-rtl '(lambda (x)
(pass-if (not ((run-bytecode '(lambda (x)
(define (even? x)
(if (null? x) #t (odd? (cdr x))))
(define (odd? x)
@ -161,7 +161,7 @@
'(1 2 3))))
(pass-if-equal '(#t)
((run-rtl '(lambda (x)
((run-bytecode '(lambda (x)
(define (even? x)
(if (null? x) #t (odd? (cdr x))))
(define (odd? x)
@ -171,7 +171,7 @@
;; An irreducible loop between even? and odd?.
(pass-if-equal '#t
((run-rtl '(lambda (x do-even?)
((run-bytecode '(lambda (x do-even?)
(define (even? x)
(if (null? x) #t (odd? (cdr x))))
(define (odd? x)
@ -183,7 +183,7 @@
(with-test-prefix "case-lambda"
(pass-if-equal "simple"
'(0 3 9 28)
(let ((proc (run-rtl '(case-lambda
(let ((proc (run-bytecode '(case-lambda
(() 0)
((x) x)
((x y) (+ x y))
@ -193,21 +193,21 @@
(pass-if-exception "no match"
exception:wrong-num-args
((run-rtl '(case-lambda ((x) x) ((x y) (+ x y))))
((run-bytecode '(case-lambda ((x) x) ((x y) (+ x y))))
1 2 3))
(pass-if-exception "zero clauses called with no args"
exception:wrong-num-args
((run-rtl '(case-lambda))))
((run-bytecode '(case-lambda))))
(pass-if-exception "zero clauses called with args"
exception:wrong-num-args
((run-rtl '(case-lambda)) 1)))
((run-bytecode '(case-lambda)) 1)))
(with-test-prefix "mixed contexts"
(pass-if-equal "sequences" '(3 4 5)
(let* ((pair (cons 1 2))
(result ((run-rtl '(lambda (pair)
(result ((run-bytecode '(lambda (pair)
(set-car! pair 3)
(set-cdr! pair 4)
5))
@ -217,4 +217,4 @@
result)))
(pass-if-equal "mutable lexicals" 2
(run-rtl '(let ((n 1)) (set! n 2) n))))
(run-bytecode '(let ((n 1)) (set! n 2) n))))

View file

@ -1,4 +1,4 @@
;;;; Low-level tests of the RTL assembler -*- mode: scheme; coding: utf-8; -*-
;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;;
@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (tests rtl)
(define-module (tests bytecode)
#:use-module (test-suite lib)
#:use-module (system vm assembler)
#:use-module (system vm program)
@ -26,7 +26,7 @@
(define (assemble-program instructions)
"Take the sequence of instructions @var{instructions}, assemble them
into RTL code, link an image, and load that image from memory. Returns
into bytecode, link an image, and load that image from memory. Returns
a procedure."
(let ((asm (make-assembler)))
(emit-text asm instructions)
@ -301,7 +301,7 @@ a procedure."
(begin-program top-incrementor
((name . top-incrementor)))
(begin-standard-arity () 3 #f)
(cached-module-box 1 (tests rtl) *top-val* #f #t)
(cached-module-box 1 (tests bytecode) *top-val* #f #t)
(box-ref 2 1)
(add1 2 2)
(box-set! 1 2)

View file

@ -37,7 +37,7 @@
(define (compile-to-objcode sexp)
"Compile the expression @var{sexp} into a VM program and return it."
(compile sexp #:from 'scheme #:to 'rtl))
(compile sexp #:from 'scheme #:to 'bytecode))
(define (run-vm-program bv)
"Run VM program contained into @var{bv}."