-;;;; 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.
+;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 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 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)
(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)
'((begin-program countdown
((name . countdown)))
(begin-standard-arity (x) 4 #f)
+ (definition x 1)
(br fix-body)
(label loop-head)
(br-if-= 2 1 #f out)
(begin-program accum
((name . accum)))
(begin-standard-arity (x) 4 #f)
+ (definition x 1)
(free-ref 2 0 0)
(box-ref 3 2)
(add 3 3 1)
'((begin-program call
((name . call)))
(begin-standard-arity (f) 7 #f)
+ (definition f 1)
(mov 5 1)
(call 5 1)
(receive 2 5 7)
'((begin-program call-with-3
((name . call-with-3)))
(begin-standard-arity (f) 7 #f)
+ (definition f 1)
(mov 5 1)
(load-constant 6 3)
(call 5 2)
'((begin-program call
((name . call)))
(begin-standard-arity (f) 2 #f)
+ (definition f 1)
(mov 0 1)
(tail-call 1)
(end-arity)
'((begin-program call-with-3
((name . call-with-3)))
(begin-standard-arity (f) 2 #f)
+ (definition f 1)
(mov 0 1) ;; R0 <- R1
(load-constant 1 3) ;; R1 <- 3
(tail-call 2)
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
(begin-standard-arity (x) 3 #f)
+ (definition x 1)
(cached-toplevel-box 2 sqrt-scope sqrt #t)
(box-ref 0 2)
(tail-call 2)
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
(begin-standard-arity (x) 3 #f)
+ (definition x 1)
(cached-module-box 2 (guile) sqrt #t #t)
(box-ref 0 2)
(tail-call 2)
(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)
(end-arity)
(end-program))))))
-(with-test-prefix "simply procedure arity"
+(with-test-prefix "simple procedure arity"
(pass-if-equal "#<procedure foo ()>"
(object->string
(assemble-program
(assemble-program
'((begin-program foo ((name . foo)))
(begin-standard-arity (x y) 3 #f)
+ (definition x 1)
+ (definition y 2)
(load-constant 1 42)
(return 1)
(end-arity)
(assemble-program
'((begin-program foo ((name . foo)))
(begin-opt-arity (x) (y) z 4 #f)
+ (definition x 1)
+ (definition y 2)
+ (definition z 3)
(load-constant 1 42)
(return 1)
(end-arity)