Commit | Line | Data |
---|---|---|
53e28ed9 AW |
1 | ;;;; test assembly to bytecode compilation -*- scheme -*- |
2 | ;;;; | |
3 | ;;;; This library is free software; you can redistribute it and/or | |
4 | ;;;; modify it under the terms of the GNU Lesser General Public | |
5 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 6 | ;;;; version 3 of the License, or (at your option) any later version. |
53e28ed9 AW |
7 | ;;;; |
8 | ;;;; This library is distributed in the hope that it will be useful, | |
9 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
11 | ;;;; Lesser General Public License for more details. | |
12 | ;;;; | |
13 | ;;;; You should have received a copy of the GNU Lesser General Public | |
14 | ;;;; License along with this library; if not, write to the Free Software | |
15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
16 | ||
17 | (define-module (test-suite tests asm-to-bytecode) | |
44362a10 | 18 | #:use-module (rnrs bytevector) |
53e28ed9 AW |
19 | #:use-module (test-suite lib) |
20 | #:use-module (system vm instruction) | |
6f787028 | 21 | #:use-module (language assembly compile-bytecode)) |
53e28ed9 AW |
22 | |
23 | (define (munge-bytecode v) | |
24 | (let ((newv (make-u8vector (vector-length v)))) | |
25 | (let lp ((i 0)) | |
26 | (if (= i (vector-length v)) | |
27 | newv | |
28 | (let ((x (vector-ref v i))) | |
29 | (u8vector-set! newv i (if (symbol? x) | |
30 | (instruction->opcode x) | |
31 | x)) | |
32 | (lp (1+ i))))))) | |
33 | ||
34 | (define (comp-test x y) | |
35 | (let* ((y (munge-bytecode y)) | |
36 | (len (u8vector-length y)) | |
37 | (v (make-u8vector len)) | |
38 | (i 0)) | |
39 | (define (write-byte b) (u8vector-set! v i b) (set! i (1+ i))) | |
40 | (define (get-addr) i) | |
41 | (run-test `(length ,x) #t | |
42 | (lambda () | |
6f787028 | 43 | (write-bytecode x write-byte get-addr '()) |
53e28ed9 AW |
44 | (= i len))) |
45 | (run-test `(compile-equal? ,x ,y) #t | |
46 | (lambda () | |
47 | (equal? v y))))) | |
48 | ||
44362a10 LC |
49 | (define (u32->u8-list x) |
50 | ;; Return a 4 uint8 list corresponding to the host's native representation | |
51 | ;; of X, a uint32. | |
52 | (let ((bv (make-bytevector 4))) | |
53 | (bytevector-u32-native-set! bv 0 x) | |
54 | (bytevector->u8-list bv))) | |
55 | ||
56 | \f | |
53e28ed9 AW |
57 | (with-test-prefix "compiler" |
58 | (with-test-prefix "asm-to-bytecode" | |
59 | ||
60 | (comp-test '(make-int8 3) | |
61 | #(make-int8 3)) | |
62 | ||
63 | (comp-test `(load-integer ,(string (integer->char 0))) | |
64 | #(load-integer 0 0 1 0)) | |
65 | ||
66 | (comp-test `(load-integer ,(string (integer->char 255))) | |
67 | #(load-integer 0 0 1 255)) | |
68 | ||
69 | (comp-test `(load-integer ,(string (integer->char 1) (integer->char 0))) | |
70 | #(load-integer 0 0 2 1 0)) | |
71 | ||
72 | (comp-test '(load-number "3.14") | |
73 | (vector 'load-number 0 0 4 (char->integer #\3) (char->integer #\.) | |
74 | (char->integer #\1) (char->integer #\4))) | |
75 | ||
76 | (comp-test '(load-string "foo") | |
77 | (vector 'load-string 0 0 3 (char->integer #\f) (char->integer #\o) | |
78 | (char->integer #\o))) | |
79 | ||
80 | (comp-test '(load-symbol "foo") | |
81 | (vector 'load-symbol 0 0 3 (char->integer #\f) (char->integer #\o) | |
82 | (char->integer #\o))) | |
83 | ||
84 | (comp-test '(load-keyword "qux") | |
85 | (vector 'load-keyword 0 0 3 (char->integer #\q) (char->integer #\u) | |
86 | (char->integer #\x))) | |
44362a10 | 87 | |
476e3572 | 88 | (comp-test '(load-program 3 2 1 () 3 #f (make-int8 3) (return)) |
44362a10 LC |
89 | (list->vector |
90 | `(load-program | |
476e3572 | 91 | 3 2 1 0 ;; nargs, nrest, nlocs, unused |
44362a10 LC |
92 | ,@(u32->u8-list 3) ;; len |
93 | ,@(u32->u8-list 0) ;; metalen | |
94 | make-int8 3 | |
95 | return))) | |
1f1ec13b | 96 | |
476e3572 AW |
97 | (comp-test '(load-program 3 2 1 () 3 |
98 | (load-program 3 2 1 () 3 | |
1f1ec13b AW |
99 | #f |
100 | (make-int8 3) (return)) | |
101 | (make-int8 3) (return)) | |
44362a10 LC |
102 | (list->vector |
103 | `(load-program | |
476e3572 | 104 | 3 2 1 0 ;; nargs, nrest, nlocs, unused |
44362a10 LC |
105 | ,@(u32->u8-list 3) ;; len |
106 | ,@(u32->u8-list (+ 3 12)) ;; metalen | |
107 | make-int8 3 | |
108 | return | |
476e3572 | 109 | 3 2 1 0 ;; nargs, nrest, nlocs, unused |
44362a10 LC |
110 | ,@(u32->u8-list 3) ;; len |
111 | ,@(u32->u8-list 0) ;; metalen | |
112 | make-int8 3 | |
113 | return))))) |