/
llvm-simulator-rosette.rkt
205 lines (163 loc) · 6.28 KB
/
llvm-simulator-rosette.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
#lang s-exp rosette
(require "../simulator-rosette.rkt" "../ops-rosette.rkt" "../inst.rkt" "llvm-machine.rkt")
(provide llvm-simulator-rosette%)
(define llvm-simulator-rosette%
(class simulator-rosette%
(super-new)
(init-field machine)
(override interpret performance-cost get-constructor)
(define (get-constructor) llvm-simulator-rosette%)
(define bit (get-field bitwidth machine))
(define nop-id (get-field nop-id machine))
(define opcodes (get-field opcodes machine))
(define-syntax-rule (bvop op)
(lambda (x y) (finitize-bit (op x y))))
(define-syntax-rule (finitize-bit x) (finitize x bit))
(define (shl a b) (<< a b bit))
(define (ushr a b) (>>> a b bit))
(define bvadd (bvop +))
(define bvsub (bvop -))
(define bvmul (bvop *))
(define bvshl (bvop shl))
(define bvshr (bvop >>))
(define bvushr (bvop ushr))
(define bvsdiv (bvop quotient))
(define (bvudiv n d)
(if (< d 0)
(if (< n d) 1 0)
(let* ([q (shl (quotient (ushr n 2) d) 2)]
[r (- n (* q d))])
(finitize-bit (if (or (> r d) (< r 0)) q (add1 q))))))
(define (clz x)
(let ([mask (shl 1 (sub1 bit))]
[count 0]
[still #t])
(for ([i bit])
(when still
(let ([res (bitwise-and x mask)])
(set! x (shl x 1))
(if (= res 0)
(set! count (add1 count))
(set! still #f)))))
count))
;; Interpret a given program from a given state.
;; state: initial progstate
(define (interpret program state [ref #f])
(define out (vector-copy (progstate-var state)))
(define out-vec4
(for/vector ([vec (progstate-vec4 state)])
(and vec (vector-copy vec))))
(define mem (progstate-memory state))
(set! mem (and mem (send* mem clone (and ref (progstate-memory ref)))))
(define (interpret-step step)
(define op (inst-op step))
(define args (inst-args step))
(define (apply-scalar f val1 val2)
(for/vector ([i (vector-length val1)])
(f (vector-ref val1 i) (vector-ref val2 i))))
;; sub add
(define (rrr f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define b (vector-ref args 2))
(define val (f (vector-ref out a) (vector-ref out b)))
(vector-set! out d val))
;; sub add
(define (rrr-vec f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define b (vector-ref args 2))
(define val (apply-scalar f (vector-ref out-vec4 a) (vector-ref out-vec4 b)))
(vector-set! out-vec4 d val)
)
;; subi addi
(define (rri f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define b (vector-ref args 2))
(define val (f (vector-ref out a) b))
(vector-set! out d val))
;; subi addi
(define (rri-vec f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define b (vector-ref args 2))
(define val (apply-scalar f (vector-ref out-vec4 a) b))
(vector-set! out-vec4 d val))
;; subi addi
(define (rir f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define b (vector-ref args 2))
(define val (f a (vector-ref out b)))
(vector-set! out d val))
;; count leading zeros
(define (rr f)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(define val (f (vector-ref out a)))
(vector-set! out d val))
(define (load)
(define d (vector-ref args 0))
(define a (vector-ref args 1))
(vector-set! out d (send* mem load (vector-ref out a))))
(define (store)
(define val (vector-ref args 0))
(define addr (vector-ref args 1))
(send* mem store (vector-ref out addr) (vector-ref out val)))
(define-syntax inst-eq
(syntax-rules ()
((inst-eq x) (equal? x (vector-ref opcodes op)))
((inst-eq a b ...) (or (inst-eq a) (inst-eq b) ...))))
(cond
;; rrr
[(inst-eq `nop) (void)]
[(inst-eq `add) (rrr bvadd)]
[(inst-eq `sub) (rrr bvsub)]
[(inst-eq `mul) (rrr bvmul)]
[(inst-eq `sdiv) (rrr bvsdiv)]
[(inst-eq `udiv) (rrr bvudiv)]
[(inst-eq `and) (rrr bitwise-and)]
[(inst-eq `or) (rrr bitwise-ior)]
[(inst-eq `xor) (rrr bitwise-xor)]
[(inst-eq `lshr) (rrr bvushr)]
[(inst-eq `ashr) (rrr bvshr)]
[(inst-eq `shl) (rrr bvshl)]
;; rrr (vector)
[(inst-eq `add_v4) (rrr-vec bvadd)]
;; rri
[(inst-eq `add#) (rri bvadd)]
[(inst-eq `sub#) (rri bvsub)]
[(inst-eq `mul#) (rri bvmul)]
[(inst-eq `and#) (rri bitwise-and)]
[(inst-eq `or#) (rri bitwise-ior)]
[(inst-eq `xor#) (rri bitwise-xor)]
[(inst-eq `lshr#) (rri bvushr)]
[(inst-eq `ashr#) (rri bvshr)]
[(inst-eq `shl#) (rri bvshl)]
;; rri (vector)
[(inst-eq `add_v4#) (rri-vec bvadd)]
;; rir
[(inst-eq `_add) (rir bvadd)]
[(inst-eq `_sub) (rir bvsub)]
[(inst-eq `_mul) (rir bvmul)]
;; [(inst-eq `_and) (rir bitwise-and)]
;; [(inst-eq `_or) (rir bitwise-ior)]
;; [(inst-eq `_xor) (rir bitwise-xor)]
[(inst-eq `_lshr) (rir bvushr)]
[(inst-eq `_ashr) (rir bvshr)]
[(inst-eq `_shl) (rir bvshl)]
[(inst-eq `ctlz) (rr clz)]
[(inst-eq `store) (store)]
[(inst-eq `load) (load)]
[else (assert #f (format "simulator: undefine instruction ~a" op))]))
(for ([x program])
(interpret-step x))
(vector out out-vec4 mem)
)
(define (performance-cost program)
(define cost 0)
(for ([x program])
(unless (= (inst-op x) nop-id) (set! cost (add1 cost))))
cost)
))