riscv-utils

 1(import riscv test)
 2(import (chicken condition))
 3
 4(define exception-raised #t)
 5(define-syntax test-exception
 6  (syntax-rules ()
 7    ((test-exception body ...)
 8     (call-with-current-continuation
 9       (lambda (con)
10         (with-exception-handler
11           (lambda (e) (con exception-raised))
12           (lambda ()
13             (begin
14              (begin body ...)
15              (con (not exception-raised))))))))))
16
17(test-group "encode R-type"
18  (test "encode add instruction"
19    add-instr
20    (r-type (get-opcode 'ADD) (get-funct3 'ADD) (get-funct7 'ADD)
21            12 10 11))
22
23  (test "encode add instruction with invalid RD"
24    exception-raised
25    (test-exception
26      (r-type (get-opcode 'ADD) (get-funct3 'ADD) (get-funct7 'ADD) 12 10 42))))
27
28(test-group "encode I-type"
29  (test "encode addi instruction"
30    addi-instr
31    (i-type (get-opcode 'ADDI) (get-funct3 'ADDI) 6 5 42))
32
33  (test "encode addi with negative immediate"
34    -23
35    (instr-i-imm (i-type (get-opcode 'ADDI) (get-funct3 'ADDI) 6 5 -23)))
36
37  (test "encode addi with invalide immediate"
38    exception-raised
39    (test-exception
40      (i-type (get-opcode 'ADDI) (get-funct3 'ADDI) 6 5 2048))))
41
42(test-group "encode S-type"
43  (test "encode sw instruction"
44    sw-instr
45    (s-type (get-opcode 'SW) (get-funct3 'SW) 9 1 23))
46
47  (test "encode sw instruction with invalid immediate"
48    exception-raised
49    (test-exception
50      (s-type (get-opcode 'SW) (get-funct3 'SW) 9 1 (expt 2 12)))))
51
52(test-group "encode B-type"
53  (test "encode beq instruction"
54    beq-instr
55    (b-type (get-opcode 'BEQ) (get-funct3 'BEQ) 10 11 32))
56
57  (test "encode beq instruction with negative immediate"
58    -2048
59    (instr-b-imm (b-type (get-opcode 'BEQ) (get-funct3 'BEQ) 10 11 -2048))))
60
61(test-group "encode U-type"
62  (test "encode lui instruction"
63    lui-instr
64    (u-type (get-opcode 'LUI) 28 #xfffff))
65
66  (test "encode lui instruction with invalid immediate"
67    exception-raised
68    (test-exception
69      (u-type (get-opcode 'LUI) 28 (expt 2 20)))))
70
71(test-group "encode J-type"
72  (test "encode jal instruction"
73    jal-instr
74    (j-type (get-opcode 'JAL) 1 32)))