Coverage report: /home/ellis/comp/ext/ironclad/src/opt/sbcl/x86oid-vm.lisp

KindCoveredAll%
expression02452 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; x86oid-vm.lisp
2
 #+(and (or x86 x86-64) ironclad-assembly)
3
 (defpackage :ironclad-vm
4
   ;; more recent SBCL exports various symbols making this package
5
   ;; definition more concise. This is the backward-compatible way.
6
   (:use #:common-lisp
7
         #:sb-c     ; for DEFINE-VOP and SC-IS
8
         #:sb-assem ; for INST, GEN-LABEL
9
         #:sb-vm)   ; for primtype names, SCs, constants
10
   (:shadow #:ea) ; in case SB-VM exports it
11
   (:import-from #:sb-vm
12
                 #:positive-fixnum #:unsigned-num
13
                 #:descriptor-reg #:unsigned-reg #:double-reg #:immediate
14
                 #:simple-array-unsigned-byte-8
15
                 #:simple-array-unsigned-byte-32
16
                 #+x86-64 #:simple-array-unsigned-byte-64
17
                 #+x86-64 #:rax-offset #+x86-64 #:rcx-offset))
18
 
19
 #+(and (or x86 x86-64) ironclad-assembly)
20
 (in-package :ironclad-vm)
21
 
22
 #+(and x86 ironclad-assembly)
23
 (eval-when (:compile-toplevel :load-toplevel :execute)
24
   (defun ea (displacement &optional base index (scale 1))
25
     (sb-vm::make-ea :dword
26
                     :base base
27
                     :index index
28
                     :scale scale
29
                     :disp (or displacement 0)))
30
   (setf (fdefinition 'dword-ea) (fdefinition 'ea))
31
   (defmacro dword-inst (name &rest operands)
32
     `(inst ,name ,@operands)))
33
 
34
 #+(and x86-64 ironclad-assembly)
35
 (eval-when (:compile-toplevel :load-toplevel :execute)
36
   #+ironclad-sb-vm-ea
37
   (progn ; Newer SBCL (>= 1.4.11)
38
     (setf (fdefinition 'ea) (fdefinition 'sb-vm::ea))
39
     (setf (fdefinition 'dword-ea) (fdefinition 'ea))
40
     (defmacro dword-inst (name &rest operands)
41
       (case name
42
         (bswap
43
          ;; The '(bswap :dword r)' notation is only supported
44
          ;; on SBCL > 1.5.9.
45
          (if (ignore-errors (sb-ext:assert-version->= 1 5 9 17) t)
46
              `(inst bswap :dword ,@operands)
47
              `(inst bswap (sb-vm::reg-in-size ,@operands :dword))))
48
         (t
49
          `(inst ,name :dword ,@operands)))))
50
   #-ironclad-sb-vm-ea
51
   (progn ; Older SBCL (< 1.4.11)
52
     (defun ea (displacement &optional base index (scale 1))
53
       (sb-vm::make-ea :qword
54
                       :base base
55
                       :index index
56
                       :scale scale
57
                       :disp (or displacement 0)))
58
     (defun dword-ea (displacement &optional base index (scale 1))
59
       (sb-vm::make-ea :dword
60
                       :base base
61
                       :index index
62
                       :scale scale
63
                       :disp (or displacement 0)))
64
     (defmacro dword-inst (name &rest operands)
65
       `(inst ,name ,@(mapcar (lambda (operand)
66
                                `(if (tn-p ,operand)
67
                                     (sb-vm::reg-in-size ,operand :dword)
68
                                     ,operand))
69
                              operands)))))
70
 
71
 #+(and (or x86 x86-64) ironclad-assembly)
72
 (progn
73
   (define-vop (fill-block-ub8)
74
     (:policy :fast-safe)
75
     (:args (block :scs (descriptor-reg))
76
            (buffer :scs (descriptor-reg))
77
            (offset :scs (unsigned-reg immediate) :target buffer-index))
78
     (:variant-vars big-endian-p bytes-to-copy 64-bit-p)
79
     (:temporary (:sc unsigned-reg) temp buffer-index block-index)
80
     (:generator 50
81
       (let* ((data-offset (- (* n-word-bytes vector-data-offset)
82
                              other-pointer-lowtag))
83
              (block-disp (+ data-offset bytes-to-copy))
84
              (immediate-offset (sc-is offset immediate))
85
              (unroll (if immediate-offset 2 1))
86
              (loop (gen-label)))
87
         (flet ((ea-for-buffer (&optional (offset 0))
88
                  (if immediate-offset
89
                      (ea (+ block-disp offset) buffer block-index n-word-bytes)
90
                      (ea data-offset buffer buffer-index)))
91
                (ea-for-block (&optional (offset 0))
92
                  (ea (+ block-disp offset) block block-index n-word-bytes))
93
                (handle-endianness (x)
94
                  (when big-endian-p
95
                    (inst bswap x)
96
                    #+x86-64
97
                    (unless 64-bit-p
98
                      (inst rol x 32)))))
99
           (unless immediate-offset
100
             (move buffer-index offset))
101
           (inst mov block-index (- (truncate bytes-to-copy n-word-bytes)))
102
           (emit-label loop)
103
           (inst mov temp (ea-for-buffer 0))
104
           (when immediate-offset
105
             (inst mov buffer-index (ea-for-buffer n-word-bytes)))
106
           (handle-endianness temp)
107
           (when immediate-offset
108
             (handle-endianness buffer-index))
109
           (inst mov (ea-for-block) temp)
110
           (when immediate-offset
111
             (inst mov (ea-for-block n-word-bytes) buffer-index))
112
           (unless immediate-offset
113
             (inst add buffer-index n-word-bytes))
114
           (inst add block-index unroll)
115
           (inst jmp :nz loop)))))
116
 
117
   (define-vop (fill-block-ub8-le fill-block-ub8)
118
     (:translate ironclad::fill-block-ub8-le)
119
     (:arg-types simple-array-unsigned-byte-32
120
                 simple-array-unsigned-byte-8
121
                 positive-fixnum)
122
     (:variant nil 64 nil))
123
 
124
   (define-vop (fill-block-ub8-be fill-block-ub8)
125
     (:translate ironclad::fill-block-ub8-be)
126
     (:arg-types simple-array-unsigned-byte-32
127
                 simple-array-unsigned-byte-8
128
                 positive-fixnum)
129
     (:variant t 64 nil))
130
 
131
   #+x86-64
132
   (define-vop (fill-block-ub8-le/64 fill-block-ub8)
133
     (:translate ironclad::fill-block-ub8-le/64)
134
     (:arg-types simple-array-unsigned-byte-64
135
                 simple-array-unsigned-byte-8
136
                 positive-fixnum)
137
     ;; Yes.  Really.  Inconsistent naming FTW.
138
     (:variant nil 64 t))
139
 
140
   #+x86-64
141
   (define-vop (fill-block-ub8-be/64 fill-block-ub8)
142
     (:translate ironclad::fill-block-ub8-be/64)
143
     (:arg-types simple-array-unsigned-byte-64
144
                 simple-array-unsigned-byte-8
145
                 positive-fixnum)
146
     (:variant t 128 t))
147
 
148
   (define-vop (expand-block)
149
     (:translate ironclad::expand-block)
150
     (:policy :fast-safe)
151
     (:args (block :scs (descriptor-reg)))
152
     (:arg-types simple-array-unsigned-byte-32)
153
     (:temporary (:sc unsigned-reg) temp count)
154
     (:generator 100
155
       (flet ((block-word (elem-offset)
156
                (let ((disp (+ (- (* n-word-bytes vector-data-offset)
157
                                  other-pointer-lowtag)
158
                               (* 4 elem-offset))))
159
                  (dword-ea disp block count 4))))
160
         (let ((loop (gen-label)))
161
           (inst mov count 16)
162
           (emit-label loop)
163
           (dword-inst mov temp (block-word -3))
164
           (dword-inst xor temp (block-word -8))
165
           (dword-inst xor temp (block-word -14))
166
           (dword-inst xor temp (block-word -16))
167
           (dword-inst rol temp 1)
168
           (dword-inst mov (block-word 0) temp)
169
           (inst add count 1)
170
           (inst cmp count 79)
171
           (inst jmp :le loop)))))
172
 
173
   (define-vop (sha256-expand-block)
174
     (:translate ironclad::sha256-expand-block)
175
     (:policy :fast-safe)
176
     (:args (block :scs (descriptor-reg)))
177
     (:arg-types simple-array-unsigned-byte-32)
178
     (:temporary (:sc unsigned-reg) t1 t2 t3 t4 count)
179
     (:generator 100
180
       (flet ((block-word (elem-offset)
181
                (let ((disp (+ (- (* n-word-bytes vector-data-offset)
182
                                  other-pointer-lowtag)
183
                               (* 4 elem-offset))))
184
                  (dword-ea disp block count 4))))
185
         (let ((loop (gen-label)))
186
           ;; The code could definitely be improved for x86-64 by using
187
           ;; more temporaries, but this version works on both 32- and
188
           ;; 64-bit and eliminates many of the stupidities in the modular
189
           ;; arithmetic version (mostly on 64-bit, but some lameness in
190
           ;; the 32-bit version as well).
191
           (inst mov count 16)
192
           (emit-label loop)
193
           (dword-inst mov t1 (block-word -2))
194
           ;; sigma1
195
           (dword-inst mov t2 t1)
196
           (dword-inst rol t2 15)
197
           (dword-inst mov t3 t1)
198
           (dword-inst rol t3 13)
199
           (dword-inst xor t2 t3)
200
           (dword-inst shr t1 10)
201
           (dword-inst xor t1 t2)
202
           (dword-inst mov t2 (block-word -15))
203
           ;; sigma0
204
           (dword-inst mov t3 t2)
205
           (dword-inst rol t3 25)
206
           (dword-inst mov t4 t2)
207
           (dword-inst rol t4 14)
208
           (dword-inst xor t3 t4)
209
           (dword-inst shr t2 3)
210
           (dword-inst xor t2 t3)
211
           (dword-inst add t1 (block-word -7))
212
           (dword-inst add t2 (block-word -16))
213
           (dword-inst add t1 t2)
214
           (dword-inst mov (block-word 0) t1)
215
           (inst add count 1)
216
           (inst cmp count 63)
217
           (inst jmp :le loop)))))
218
 
219
 ;;; Implementing this for x86 would require nasty hacks with
220
 ;;; pseudo-atomic.  Might just be worth it for the speed increase,
221
 ;;; though.  The code is also probably not scheduled optimally.
222
   #+x86-64
223
   (define-vop (update-sha1-block)
224
     (:translate ironclad::%update-sha1-block)
225
     (:policy :fast-safe)
226
     (:args (regs :scs (descriptor-reg) :target result)
227
            (block :scs (descriptor-reg)))
228
     (:arg-types simple-array-unsigned-byte-32 simple-array-unsigned-byte-32)
229
     (:results (result :scs (descriptor-reg)))
230
     (:result-types simple-array-unsigned-byte-32)
231
     (:temporary (:sc unsigned-reg) a b c d e t1 t2)
232
     (:generator 1000
233
       (let ((k1 #x5a827999)
234
             (k2 #x6ed9eba1)
235
             (k3 #x-70e44324)
236
             (k4 #x-359d3e2a))
237
         (labels ((block/reg-ea (base index)
238
                    (let ((disp (+ (- (* n-word-bytes vector-data-offset)
239
                                      other-pointer-lowtag)
240
                                   (* 4 index))))
241
                      (dword-ea disp base)))
242
                  (f1 (a b c d e n)
243
                    (dword-inst mov t2 a)
244
                    (dword-inst mov t1 c)
245
                    (dword-inst rol t2 5)
246
                    (dword-inst xor t1 d)
247
                    (dword-inst add t2 (block/reg-ea block n))
248
                    (dword-inst and t1 b)
249
                    (dword-inst xor t1 d)
250
                    (dword-inst lea e (ea k1 t1 e))
251
                    (dword-inst rol b 30)
252
                    (dword-inst add e t2))
253
                  (f2/4 (a b c d e n k)
254
                    (dword-inst mov t2 a)
255
                    (dword-inst mov t1 d)
256
                    (dword-inst rol t2 5)
257
                    (dword-inst xor t1 c)
258
                    (dword-inst add t2 (block/reg-ea block n))
259
                    (dword-inst xor t1 b)
260
                    (dword-inst lea e (ea k t1 e))
261
                    (dword-inst rol b 30)
262
                    (dword-inst add e t2))
263
                  (f2 (a b c d e n)
264
                    (f2/4 a b c d e n k2))
265
                  (f4 (a b c d e n)
266
                    (f2/4 a b c d e n k4))
267
                  (f3 (a b c d e n)
268
                    (dword-inst mov t2 c)
269
                    (dword-inst mov t1 c)
270
                    (dword-inst and t2 b)
271
                    (dword-inst or t1 b)
272
                    (dword-inst and t1 d)
273
                    (dword-inst or t1 t2)
274
                    (dword-inst mov t2 a)
275
                    (dword-inst rol t2 5)
276
                    (dword-inst add t2 (block/reg-ea block n))
277
                    (dword-inst rol b 30)
278
                    (dword-inst lea e (ea k3 t1 e))
279
                    (dword-inst add e t2))
280
                  (sha1-rounds (start end f)
281
                    (let ((xvars (ironclad::make-circular-list a b c d e)))
282
                      (loop for i from start upto end
283
                            for vars on xvars by #'cddddr
284
                            do (multiple-value-bind (a b c d e)
285
                                   (apply #'values (ironclad::circular-list-subseq vars 0 5))
286
                                 (funcall f a b c d e i))))))
287
           (dword-inst mov a (block/reg-ea regs 0))
288
           (dword-inst mov b (block/reg-ea regs 1))
289
           (dword-inst mov c (block/reg-ea regs 2))
290
           (dword-inst mov d (block/reg-ea regs 3))
291
           (dword-inst mov e (block/reg-ea regs 4))
292
           (sha1-rounds 0 19 #'f1)
293
           (sha1-rounds 20 39 #'f2)
294
           (sha1-rounds 40 59 #'f3)
295
           (sha1-rounds 60 79 #'f4)
296
           (dword-inst add (block/reg-ea regs 0) a)
297
           (dword-inst add (block/reg-ea regs 1) b)
298
           (dword-inst add (block/reg-ea regs 2) c)
299
           (dword-inst add (block/reg-ea regs 3) d)
300
           (dword-inst add (block/reg-ea regs 4) e)
301
           (move result regs)))))
302
 
303
   #+x86-64
304
   (define-vop (salsa-core-fast)
305
     (:translate ironclad::x-salsa-core)
306
     (:policy :fast-safe)
307
     (:args (buffer :scs (descriptor-reg))
308
            (state :scs (descriptor-reg)))
309
     (:info n-rounds)
310
     (:arg-types (:constant (signed-byte 61))
311
                 simple-array-unsigned-byte-8
312
                 simple-array-unsigned-byte-32)
313
     (:temporary (:sc double-reg) x0 x1 x2 x3)
314
     (:temporary (:sc unsigned-reg) r0 r1 r2 r3 temp count)
315
     (:generator 1000
316
       (labels ((nth-xmm-mem (base i)
317
                  (let ((disp (+ (- (* n-word-bytes vector-data-offset)
318
                                    other-pointer-lowtag)
319
                                 (* 16 i))))
320
                    (ea disp base)))
321
                (nth-buffer-dword (i)
322
                  (let ((disp (+ (- (* n-word-bytes vector-data-offset)
323
                                    other-pointer-lowtag)
324
                                 (* 4 i))))
325
                    (dword-ea disp buffer)))
326
                (quarter-round (y0 y1 y2 y3)
327
                  ;; x[y0] = XOR(x[y0],ROTATE(PLUS(x[y3],x[y2]), 7));
328
                  ;; x[y1] = XOR(x[y1],ROTATE(PLUS(x[y0],x[y3]), 9));
329
                  ;; x[y2] = XOR(x[y2],ROTATE(PLUS(x[y1],x[y0]),13));
330
                  ;; x[y3] = XOR(x[y3],ROTATE(PLUS(x[y2],x[y1]),18));
331
                  (dword-inst mov r2 (nth-buffer-dword y2))
332
                  (dword-inst mov r3 (nth-buffer-dword y3))
333
 
334
                  (dword-inst lea r0 (ea 0 r3 r2))
335
                  (dword-inst rol r0 7)
336
                  (dword-inst xor r0 (nth-buffer-dword y0))
337
 
338
                  (dword-inst lea r1 (ea 0 r0 r3))
339
                  (dword-inst rol r1 9)
340
                  (dword-inst xor r1 (nth-buffer-dword y1))
341
 
342
                  (dword-inst lea temp (ea 0 r1 r0))
343
                  (dword-inst rol temp 13)
344
                  (dword-inst xor r2 temp)
345
 
346
                  (dword-inst lea temp (ea 0 r2 r1))
347
                  (dword-inst rol temp 18)
348
                  (dword-inst xor r3 temp)
349
 
350
                  (dword-inst mov (nth-buffer-dword y0) r0)
351
                  (dword-inst mov (nth-buffer-dword y1) r1)
352
                  (dword-inst mov (nth-buffer-dword y2) r2)
353
                  (dword-inst mov (nth-buffer-dword y3) r3)))
354
         ;; copy state to the output buffer
355
         (inst movdqu x0 (nth-xmm-mem state 0))
356
         (inst movdqu x1 (nth-xmm-mem state 1))
357
         (inst movdqu x2 (nth-xmm-mem state 2))
358
         (inst movdqu x3 (nth-xmm-mem state 3))
359
         (inst movdqu (nth-xmm-mem buffer 0) x0)
360
         (inst movdqu (nth-xmm-mem buffer 1) x1)
361
         (inst movdqu (nth-xmm-mem buffer 2) x2)
362
         (inst movdqu (nth-xmm-mem buffer 3) x3)
363
 
364
         (let ((repeat (gen-label)))
365
           (inst mov count n-rounds)
366
           (emit-label repeat)
367
           (quarter-round 4 8 12 0)
368
           (quarter-round 9 13 1 5)
369
           (quarter-round 14 2 6 10)
370
           (quarter-round 3 7 11 15)
371
 
372
           (quarter-round 1 2 3 0)
373
           (quarter-round 6 7 4 5)
374
           (quarter-round 11 8 9 10)
375
           (quarter-round 12 13 14 15)
376
           (inst sub count 1)
377
           (inst jmp :nz repeat))
378
 
379
         (inst paddd x0 (nth-xmm-mem buffer 0))
380
         (inst paddd x1 (nth-xmm-mem buffer 1))
381
         (inst paddd x2 (nth-xmm-mem buffer 2))
382
         (inst paddd x3 (nth-xmm-mem buffer 3))
383
         (inst movdqu (nth-xmm-mem buffer 0) x0)
384
         (inst movdqu (nth-xmm-mem buffer 1) x1)
385
         (inst movdqu (nth-xmm-mem buffer 2) x2)
386
         (inst movdqu (nth-xmm-mem buffer 3) x3))))
387
 
388
   #+x86-64
389
   (define-vop (chacha-core-fast)
390
     (:translate ironclad::x-chacha-core)
391
     (:policy :fast-safe)
392
     (:args (buffer :scs (descriptor-reg))
393
            (state :scs (descriptor-reg)))
394
     (:info n-rounds)
395
     (:arg-types (:constant (signed-byte 61))
396
                 simple-array-unsigned-byte-8
397
                 simple-array-unsigned-byte-32)
398
     (:temporary (:sc double-reg) x0 x1 x2 x3 y0 y1 y2 y3 t0)
399
     (:temporary (:sc unsigned-reg) count)
400
     (:generator 1000
401
       (flet ((nth-xmm-mem (base i)
402
                (let ((disp (+ (- (* n-word-bytes vector-data-offset)
403
                                  other-pointer-lowtag)
404
                               (* 16 i))))
405
                  (ea disp base)))
406
              (chacha-round ()
407
                (inst paddd y0 y1)
408
                (inst pxor y3 y0)
409
                (inst movdqa t0 y3)
410
                (inst pslld-imm y3 16)
411
                (inst psrld-imm t0 16)
412
                (inst por y3 t0)
413
 
414
                (inst paddd y2 y3)
415
                (inst pxor y1 y2)
416
                (inst movdqa t0 y1)
417
                (inst pslld-imm y1 12)
418
                (inst psrld-imm t0 20)
419
                (inst por y1 t0)
420
 
421
                (inst paddd y0 y1)
422
                (inst pxor y3 y0)
423
                (inst movdqa t0 y3)
424
                (inst pslld-imm y3 8)
425
                (inst psrld-imm t0 24)
426
                (inst por y3 t0)
427
 
428
                (inst paddd y2 y3)
429
                (inst pxor y1 y2)
430
                (inst movdqa t0 y1)
431
                (inst pslld-imm y1 7)
432
                (inst psrld-imm t0 25)
433
                (inst por y1 t0)))
434
         (inst movdqu x0 (nth-xmm-mem state 0))
435
         (inst movdqu x1 (nth-xmm-mem state 1))
436
         (inst movdqu x2 (nth-xmm-mem state 2))
437
         (inst movdqu x3 (nth-xmm-mem state 3))
438
         (inst movdqa y0 x0)
439
         (inst movdqa y1 x1)
440
         (inst movdqa y2 x2)
441
         (inst movdqa y3 x3)
442
 
443
         (let ((repeat (gen-label)))
444
           (inst mov count n-rounds)
445
           (emit-label repeat)
446
 
447
           (chacha-round)
448
           (inst pshufd y1 y1 #b00111001)
449
           (inst pshufd y2 y2 #b01001110)
450
           (inst pshufd y3 y3 #b10010011)
451
 
452
           (chacha-round)
453
           (inst pshufd y1 y1 #b10010011)
454
           (inst pshufd y2 y2 #b01001110)
455
           (inst pshufd y3 y3 #b00111001)
456
 
457
           (inst sub count 1)
458
           (inst jmp :nz repeat))
459
 
460
         (inst paddd x0 y0)
461
         (inst paddd x1 y1)
462
         (inst paddd x2 y2)
463
         (inst paddd x3 y3)
464
         (inst movdqu (nth-xmm-mem buffer 0) x0)
465
         (inst movdqu (nth-xmm-mem buffer 1) x1)
466
         (inst movdqu (nth-xmm-mem buffer 2) x2)
467
         (inst movdqu (nth-xmm-mem buffer 3) x3))))
468
 
469
   #+x86-64
470
   (define-vop (pclmulqdq-support-p)
471
     (:translate ironclad::pclmulqdq-support-p)
472
     (:policy :fast-safe)
473
     (:conditional :c)
474
     (:temporary (:sc unsigned-reg :offset rax-offset) eax)
475
     (:temporary (:sc unsigned-reg :offset rcx-offset) ecx)
476
     (:generator 10
477
       (inst mov eax 1)
478
       (inst cpuid)
479
       (inst bt ecx 1)))
480
 
481
   #+x86-64
482
   (define-vop (aes-ni-support-p)
483
     (:translate ironclad::aes-ni-support-p)
484
     (:policy :fast-safe)
485
     (:conditional :c)
486
     (:temporary (:sc unsigned-reg :offset rax-offset) eax)
487
     (:temporary (:sc unsigned-reg :offset rcx-offset) ecx)
488
     (:generator 10
489
       (inst mov eax 1)
490
       (inst cpuid)
491
       (inst bt ecx 25)))
492
 
493
   #+x86-64
494
   (define-vop (aes-ni-generate-round-keys)
495
     (:translate ironclad::aes-ni-generate-round-keys)
496
     (:policy :fast-safe)
497
     (:args (key :scs (descriptor-reg))
498
            (key-length :scs (unsigned-reg))
499
            (encryption-keys :scs (descriptor-reg))
500
            (decryption-keys :scs (descriptor-reg)))
501
     (:arg-types simple-array-unsigned-byte-8
502
                 unsigned-num
503
                 simple-array-unsigned-byte-32
504
                 simple-array-unsigned-byte-32)
505
     (:temporary (:sc double-reg) x0 x1 x2 x3 x4 x5 x6)
506
     (:generator 1000
507
       (labels ((buffer-mem (base i)
508
                  (let ((disp (+ (- (* n-word-bytes vector-data-offset)
509
                                    other-pointer-lowtag)
510
                                 (* 16 i))))
511
                    (ea disp base)))
512
                (expand-key-128 ()
513
                  (inst pshufd x1 x1 #b11111111)
514
                  (inst shufps x2 x0 #b00010000)
515
                  (inst pxor x0 x2)
516
                  (inst shufps x2 x0 #b10001100)
517
                  (inst pxor x0 x2)
518
                  (inst pxor x0 x1))
519
                (expand-key-192a ()
520
                  (inst pshufd x1 x1 #b01010101)
521
                  (inst shufps x2 x0 #b00010000)
522
                  (inst pxor x0 x2)
523
                  (inst shufps x2 x0 #b10001100)
524
                  (inst pxor x0 x2)
525
                  (inst pxor x0 x1)
526
                  (inst movdqa x4 x3)
527
                  (inst movdqa x5 x3)
528
                  (inst pslldq x4 4)
529
                  (inst pshufd x6 x0 #b11111111)
530
                  (inst pxor x3 x6)
531
                  (inst pxor x3 x4)
532
                  (inst movdqa x1 x0)
533
                  (inst shufps x5 x0 #b01000100)
534
                  (inst shufps x1 x3 #b01001110))
535
                (expand-key-192b ()
536
                  (inst pshufd x1 x1 #b01010101)
537
                  (inst shufps x2 x0 #b00010000)
538
                  (inst pxor x0 x2)
539
                  (inst shufps x2 x0 #b10001100)
540
                  (inst pxor x0 x2)
541
                  (inst pxor x0 x1)
542
                  (inst movdqa x4 x3)
543
                  (inst pslldq x4 4)
544
                  (inst pshufd x5 x0 #b11111111)
545
                  (inst pxor x3 x5)
546
                  (inst pxor x3 x4))
547
                (expand-key-256a ()
548
                  (expand-key-128))
549
                (expand-key-256b ()
550
                  (inst pshufd x1 x1 #b10101010)
551
                  (inst shufps x2 x3 #b00010000)
552
                  (inst pxor x3 x2)
553
                  (inst shufps x2 x3 #b10001100)
554
                  (inst pxor x3 x2)
555
                  (inst pxor x3 x1)))
556
         (let ((key-192 (gen-label))
557
               (key-128 (gen-label))
558
               (end (gen-label)))
559
           (inst pxor x2 x2)
560
           (inst movdqu x0 (buffer-mem key 0))
561
           (inst cmp key-length 24)
562
           (inst jmp :b key-128)
563
           (inst jmp :z key-192)
564
 
565
           (inst movdqu x3 (buffer-mem key 1))
566
           (inst movdqu (buffer-mem encryption-keys 0) x0)
567
           (inst movdqu (buffer-mem decryption-keys 14) x0)
568
           (inst movdqu (buffer-mem encryption-keys 1) x3)
569
           (inst aesimc x6 x3)
570
           (inst movdqu (buffer-mem decryption-keys 13) x6)
571
           (inst aeskeygenassist x1 x3 1)
572
           (expand-key-256a)
573
           (inst movdqu (buffer-mem encryption-keys 2) x0)
574
           (inst aesimc x6 x0)
575
           (inst movdqu (buffer-mem decryption-keys 12) x6)
576
           (inst aeskeygenassist x1 x0 1)
577
           (expand-key-256b)
578
           (inst movdqu (buffer-mem encryption-keys 3) x3)
579
           (inst aesimc x6 x3)
580
           (inst movdqu (buffer-mem decryption-keys 11) x6)
581
           (inst aeskeygenassist x1 x3 2)
582
           (expand-key-256a)
583
           (inst movdqu (buffer-mem encryption-keys 4) x0)
584
           (inst aesimc x6 x0)
585
           (inst movdqu (buffer-mem decryption-keys 10) x6)
586
           (inst aeskeygenassist x1 x0 2)
587
           (expand-key-256b)
588
           (inst movdqu (buffer-mem encryption-keys 5) x3)
589
           (inst aesimc x6 x3)
590
           (inst movdqu (buffer-mem decryption-keys 9) x6)
591
           (inst aeskeygenassist x1 x3 4)
592
           (expand-key-256a)
593
           (inst movdqu (buffer-mem encryption-keys 6) x0)
594
           (inst aesimc x6 x0)
595
           (inst movdqu (buffer-mem decryption-keys 8) x6)
596
           (inst aeskeygenassist x1 x0 4)
597
           (expand-key-256b)
598
           (inst movdqu (buffer-mem encryption-keys 7) x3)
599
           (inst aesimc x6 x3)
600
           (inst movdqu (buffer-mem decryption-keys 7) x6)
601
           (inst aeskeygenassist x1 x3 8)
602
           (expand-key-256a)
603
           (inst movdqu (buffer-mem encryption-keys 8) x0)
604
           (inst aesimc x6 x0)
605
           (inst movdqu (buffer-mem decryption-keys 6) x6)
606
           (inst aeskeygenassist x1 x0 8)
607
           (expand-key-256b)
608
           (inst movdqu (buffer-mem encryption-keys 9) x3)
609
           (inst aesimc x6 x3)
610
           (inst movdqu (buffer-mem decryption-keys 5) x6)
611
           (inst aeskeygenassist x1 x3 16)
612
           (expand-key-256a)
613
           (inst movdqu (buffer-mem encryption-keys 10) x0)
614
           (inst aesimc x6 x0)
615
           (inst movdqu (buffer-mem decryption-keys 4) x6)
616
           (inst aeskeygenassist x1 x0 16)
617
           (expand-key-256b)
618
           (inst movdqu (buffer-mem encryption-keys 11) x3)
619
           (inst aesimc x6 x3)
620
           (inst movdqu (buffer-mem decryption-keys 3) x6)
621
           (inst aeskeygenassist x1 x3 32)
622
           (expand-key-256a)
623
           (inst movdqu (buffer-mem encryption-keys 12) x0)
624
           (inst aesimc x6 x0)
625
           (inst movdqu (buffer-mem decryption-keys 2) x6)
626
           (inst aeskeygenassist x1 x0 32)
627
           (expand-key-256b)
628
           (inst movdqu (buffer-mem encryption-keys 13) x3)
629
           (inst aesimc x6 x3)
630
           (inst movdqu (buffer-mem decryption-keys 1) x6)
631
           (inst aeskeygenassist x1 x3 64)
632
           (expand-key-256a)
633
           (inst movdqu (buffer-mem encryption-keys 14) x0)
634
           (inst movdqu (buffer-mem decryption-keys 0) x0)
635
           (inst jmp end)
636
 
637
           (emit-label key-192)
638
           (inst movdqu x3 (buffer-mem key 1))
639
           (inst movdqu (buffer-mem encryption-keys 0) x0)
640
           (inst movdqu (buffer-mem decryption-keys 12) x0)
641
           (inst aeskeygenassist x1 x3 1)
642
           (expand-key-192a)
643
           (inst movdqu (buffer-mem encryption-keys 1) x5)
644
           (inst aesimc x6 x5)
645
           (inst movdqu (buffer-mem decryption-keys 11) x6)
646
           (inst movdqu (buffer-mem encryption-keys 2) x1)
647
           (inst aesimc x6 x1)
648
           (inst movdqu (buffer-mem decryption-keys 10) x6)
649
           (inst aeskeygenassist x1 x3 2)
650
           (expand-key-192b)
651
           (inst movdqu (buffer-mem encryption-keys 3) x0)
652
           (inst aesimc x6 x0)
653
           (inst movdqu (buffer-mem decryption-keys 9) x6)
654
           (inst aeskeygenassist x1 x3 4)
655
           (expand-key-192a)
656
           (inst movdqu (buffer-mem encryption-keys 4) x5)
657
           (inst aesimc x6 x5)
658
           (inst movdqu (buffer-mem decryption-keys 8) x6)
659
           (inst movdqu (buffer-mem encryption-keys 5) x1)
660
           (inst aesimc x6 x1)
661
           (inst movdqu (buffer-mem decryption-keys 7) x6)
662
           (inst aeskeygenassist x1 x3 8)
663
           (expand-key-192b)
664
           (inst movdqu (buffer-mem encryption-keys 6) x0)
665
           (inst aesimc x6 x0)
666
           (inst movdqu (buffer-mem decryption-keys 6) x6)
667
           (inst aeskeygenassist x1 x3 16)
668
           (expand-key-192a)
669
           (inst movdqu (buffer-mem encryption-keys 7) x5)
670
           (inst aesimc x6 x5)
671
           (inst movdqu (buffer-mem decryption-keys 5) x6)
672
           (inst movdqu (buffer-mem encryption-keys 8) x1)
673
           (inst aesimc x6 x1)
674
           (inst movdqu (buffer-mem decryption-keys 4) x6)
675
           (inst aeskeygenassist x1 x3 32)
676
           (expand-key-192b)
677
           (inst movdqu (buffer-mem encryption-keys 9) x0)
678
           (inst aesimc x6 x0)
679
           (inst movdqu (buffer-mem decryption-keys 3) x6)
680
           (inst aeskeygenassist x1 x3 64)
681
           (expand-key-192a)
682
           (inst movdqu (buffer-mem encryption-keys 10) x5)
683
           (inst aesimc x6 x5)
684
           (inst movdqu (buffer-mem decryption-keys 2) x6)
685
           (inst movdqu (buffer-mem encryption-keys 11) x1)
686
           (inst aesimc x6 x1)
687
           (inst movdqu (buffer-mem decryption-keys 1) x6)
688
           (inst aeskeygenassist x1 x3 128)
689
           (expand-key-192b)
690
           (inst movdqu (buffer-mem encryption-keys 12) x0)
691
           (inst movdqu (buffer-mem decryption-keys 0) x0)
692
           (inst jmp end)
693
 
694
           (emit-label key-128)
695
           (inst movdqu (buffer-mem encryption-keys 0) x0)
696
           (inst movdqu (buffer-mem decryption-keys 10) x0)
697
           (inst aeskeygenassist x1 x0 1)
698
           (expand-key-128)
699
           (inst movdqu (buffer-mem encryption-keys 1) x0)
700
           (inst aesimc x6 x0)
701
           (inst movdqu (buffer-mem decryption-keys 9) x6)
702
           (inst aeskeygenassist x1 x0 2)
703
           (expand-key-128)
704
           (inst movdqu (buffer-mem encryption-keys 2) x0)
705
           (inst aesimc x6 x0)
706
           (inst movdqu (buffer-mem decryption-keys 8) x6)
707
           (inst aeskeygenassist x1 x0 4)
708
           (expand-key-128)
709
           (inst movdqu (buffer-mem encryption-keys 3) x0)
710
           (inst aesimc x6 x0)
711
           (inst movdqu (buffer-mem decryption-keys 7) x6)
712
           (inst aeskeygenassist x1 x0 8)
713
           (expand-key-128)
714
           (inst movdqu (buffer-mem encryption-keys 4) x0)
715
           (inst aesimc x6 x0)
716
           (inst movdqu (buffer-mem decryption-keys 6) x6)
717
           (inst aeskeygenassist x1 x0 16)
718
           (expand-key-128)
719
           (inst movdqu (buffer-mem encryption-keys 5) x0)
720
           (inst aesimc x6 x0)
721
           (inst movdqu (buffer-mem decryption-keys 5) x6)
722
           (inst aeskeygenassist x1 x0 32)
723
           (expand-key-128)
724
           (inst movdqu (buffer-mem encryption-keys 6) x0)
725
           (inst aesimc x6 x0)
726
           (inst movdqu (buffer-mem decryption-keys 4) x6)
727
           (inst aeskeygenassist x1 x0 64)
728
           (expand-key-128)
729
           (inst movdqu (buffer-mem encryption-keys 7) x0)
730
           (inst aesimc x6 x0)
731
           (inst movdqu (buffer-mem decryption-keys 3) x6)
732
           (inst aeskeygenassist x1 x0 128)
733
           (expand-key-128)
734
           (inst movdqu (buffer-mem encryption-keys 8) x0)
735
           (inst aesimc x6 x0)
736
           (inst movdqu (buffer-mem decryption-keys 2) x6)
737
           (inst aeskeygenassist x1 x0 27)
738
           (expand-key-128)
739
           (inst movdqu (buffer-mem encryption-keys 9) x0)
740
           (inst aesimc x6 x0)
741
           (inst movdqu (buffer-mem decryption-keys 1) x6)
742
           (inst aeskeygenassist x1 x0 54)
743
           (expand-key-128)
744
           (inst movdqu (buffer-mem encryption-keys 10) x0)
745
           (inst movdqu (buffer-mem decryption-keys 0) x0)
746
           (emit-label end)))))
747
 
748
   #+x86-64
749
   (define-vop (aes-ni-encrypt)
750
     (:translate ironclad::aes-ni-encrypt)
751
     (:policy :fast-safe)
752
     (:args (plaintext :scs (descriptor-reg))
753
            (plaintext-start :scs (unsigned-reg))
754
            (ciphertext :scs (descriptor-reg))
755
            (ciphertext-start :scs (unsigned-reg))
756
            (round-keys :scs (descriptor-reg))
757
            (n-rounds :scs (unsigned-reg)))
758
     (:arg-types simple-array-unsigned-byte-8
759
                 unsigned-num
760
                 simple-array-unsigned-byte-8
761
                 unsigned-num
762
                 simple-array-unsigned-byte-32
763
                 unsigned-num)
764
     (:temporary (:sc double-reg) x0 x1)
765
     (:generator 1000
766
       (flet ((buffer-mem (base offset)
767
                (let ((disp (- (* n-word-bytes vector-data-offset)
768
                               other-pointer-lowtag)))
769
                  (ea disp base offset)))
770
              (round-key (i)
771
                (let ((disp (+ (- (* n-word-bytes vector-data-offset)
772
                                  other-pointer-lowtag)
773
                               (* 16 i))))
774
                  (ea disp round-keys))))
775
         (let ((last-round (gen-label)))
776
           (inst movdqu x0 (buffer-mem plaintext plaintext-start))
777
           (inst movdqu x1 (round-key 0))
778
           (inst pxor x0 x1)
779
           (inst movdqu x1 (round-key 1))
780
           (inst aesenc x0 x1)
781
           (inst movdqu x1 (round-key 2))
782
           (inst aesenc x0 x1)
783
           (inst movdqu x1 (round-key 3))
784
           (inst aesenc x0 x1)
785
           (inst movdqu x1 (round-key 4))
786
           (inst aesenc x0 x1)
787
           (inst movdqu x1 (round-key 5))
788
           (inst aesenc x0 x1)
789
           (inst movdqu x1 (round-key 6))
790
           (inst aesenc x0 x1)
791
           (inst movdqu x1 (round-key 7))
792
           (inst aesenc x0 x1)
793
           (inst movdqu x1 (round-key 8))
794
           (inst aesenc x0 x1)
795
           (inst movdqu x1 (round-key 9))
796
           (inst aesenc x0 x1)
797
           (inst movdqu x1 (round-key 10))
798
           (inst cmp n-rounds 10)
799
           (inst jmp :z last-round)
800
           (inst aesenc x0 x1)
801
           (inst movdqu x1 (round-key 11))
802
           (inst aesenc x0 x1)
803
           (inst movdqu x1 (round-key 12))
804
           (inst cmp n-rounds 12)
805
           (inst jmp :z last-round)
806
           (inst aesenc x0 x1)
807
           (inst movdqu x1 (round-key 13))
808
           (inst aesenc x0 x1)
809
           (inst movdqu x1 (round-key 14))
810
           (emit-label last-round)
811
           (inst aesenclast x0 x1)
812
           (inst movdqu (buffer-mem ciphertext ciphertext-start) x0)))))
813
 
814
   #+x86-64
815
   (define-vop (aes-ni-decrypt)
816
     (:translate ironclad::aes-ni-decrypt)
817
     (:policy :fast-safe)
818
     (:args (ciphertext :scs (descriptor-reg))
819
            (ciphertext-start :scs (unsigned-reg))
820
            (plaintext :scs (descriptor-reg))
821
            (plaintext-start :scs (unsigned-reg))
822
            (round-keys :scs (descriptor-reg))
823
            (n-rounds :scs (unsigned-reg)))
824
     (:arg-types simple-array-unsigned-byte-8
825
                 unsigned-num
826
                 simple-array-unsigned-byte-8
827
                 unsigned-num
828
                 simple-array-unsigned-byte-32
829
                 unsigned-num)
830
     (:temporary (:sc double-reg) x0 x1)
831
     (:generator 1000
832
       (flet ((buffer-mem (base offset)
833
                (let ((disp (- (* n-word-bytes vector-data-offset)
834
                               other-pointer-lowtag)))
835
                  (ea disp base offset)))
836
              (round-key (i)
837
                (let ((disp (+ (- (* n-word-bytes vector-data-offset)
838
                                  other-pointer-lowtag)
839
                               (* 16 i))))
840
                  (ea disp round-keys))))
841
         (let ((last-round (gen-label)))
842
           (inst movdqu x0 (buffer-mem ciphertext ciphertext-start))
843
           (inst movdqu x1 (round-key 0))
844
           (inst pxor x0 x1)
845
           (inst movdqu x1 (round-key 1))
846
           (inst aesdec x0 x1)
847
           (inst movdqu x1 (round-key 2))
848
           (inst aesdec x0 x1)
849
           (inst movdqu x1 (round-key 3))
850
           (inst aesdec x0 x1)
851
           (inst movdqu x1 (round-key 4))
852
           (inst aesdec x0 x1)
853
           (inst movdqu x1 (round-key 5))
854
           (inst aesdec x0 x1)
855
           (inst movdqu x1 (round-key 6))
856
           (inst aesdec x0 x1)
857
           (inst movdqu x1 (round-key 7))
858
           (inst aesdec x0 x1)
859
           (inst movdqu x1 (round-key 8))
860
           (inst aesdec x0 x1)
861
           (inst movdqu x1 (round-key 9))
862
           (inst aesdec x0 x1)
863
           (inst movdqu x1 (round-key 10))
864
           (inst cmp n-rounds 10)
865
           (inst jmp :z last-round)
866
           (inst aesdec x0 x1)
867
           (inst movdqu x1 (round-key 11))
868
           (inst aesdec x0 x1)
869
           (inst movdqu x1 (round-key 12))
870
           (inst cmp n-rounds 12)
871
           (inst jmp :z last-round)
872
           (inst aesdec x0 x1)
873
           (inst movdqu x1 (round-key 13))
874
           (inst aesdec x0 x1)
875
           (inst movdqu x1 (round-key 14))
876
           (emit-label last-round)
877
           (inst aesdeclast x0 x1)
878
           (inst movdqu (buffer-mem plaintext plaintext-start) x0)))))
879
 
880
   #+x86-64
881
   (define-vop (fast-blake2s-mixing)
882
     (:translate ironclad::fast-blake2s-mixing)
883
     (:policy :fast-safe)
884
     (:args (va :scs (unsigned-reg) :target ra)
885
            (vb :scs (unsigned-reg) :target rb)
886
            (vc :scs (unsigned-reg) :target rc)
887
            (vd :scs (unsigned-reg) :target rd)
888
            (x :scs (unsigned-reg))
889
            (y :scs (unsigned-reg)))
890
     (:arg-types unsigned-num
891
                 unsigned-num
892
                 unsigned-num
893
                 unsigned-num
894
                 unsigned-num
895
                 unsigned-num)
896
     (:results (ra :scs (unsigned-reg) :from (:argument 0))
897
               (rb :scs (unsigned-reg) :from (:argument 1))
898
               (rc :scs (unsigned-reg) :from (:argument 2))
899
               (rd :scs (unsigned-reg) :from (:argument 3)))
900
     (:result-types unsigned-num
901
                    unsigned-num
902
                    unsigned-num
903
                    unsigned-num)
904
     (:generator 1000
905
       (move ra va)
906
       (move rb vb)
907
       (move rc vc)
908
       (move rd vd)
909
       (dword-inst add ra rb)
910
       (dword-inst add ra x)
911
       (dword-inst xor rd ra)
912
       (dword-inst ror rd 16)
913
       (dword-inst add rc rd)
914
       (dword-inst xor rb rc)
915
       (dword-inst ror rb 12)
916
       (dword-inst add ra rb)
917
       (dword-inst add ra y)
918
       (dword-inst xor rd ra)
919
       (dword-inst ror rd 8)
920
       (dword-inst add rc rd)
921
       (dword-inst xor rb rc)
922
       (dword-inst ror rb 7)))
923
 
924
   #+x86-64
925
   (define-vop (gmac-mul-fast)
926
     (:translate ironclad::gmac-mul-fast)
927
     (:policy :fast-safe)
928
     (:args (accumulator :scs (descriptor-reg))
929
            (key :scs (descriptor-reg)))
930
     (:arg-types simple-array-unsigned-byte-8
931
                 simple-array-unsigned-byte-8)
932
     (:temporary (:sc double-reg) x0 x1 x2 x3 x4 x5 x6 x7 x8 x9)
933
     (:generator 1000
934
       (flet ((buffer-mem (base)
935
                (let ((disp (- (* n-word-bytes vector-data-offset)
936
                               other-pointer-lowtag)))
937
                  (ea disp base))))
938
         (inst movdqu x0 (buffer-mem accumulator))
939
         (inst movdqu x1 (buffer-mem key))
940
         (inst movdqa x3 x0)
941
         (inst pclmulqdq x3 x1 0)
942
         (inst movdqa x4 x0)
943
         (inst pclmulqdq x4 x1 16)
944
         (inst movdqa x5 x0)
945
         (inst pclmulqdq x5 x1 1)
946
         (inst movdqa x6 x0)
947
         (inst pclmulqdq x6 x1 17)
948
         (inst pxor x4 x5)
949
         (inst movdqa x5 x4)
950
         (inst psrldq x4 8)
951
         (inst pslldq x5 8)
952
         (inst pxor x3 x5)
953
         (inst pxor x6 x4)
954
         (inst movdqa x7 x3)
955
         (inst movdqa x8 x6)
956
         (inst pslld-imm x3 1)
957
         (inst pslld-imm x6 1)
958
         (inst psrld-imm x7 31)
959
         (inst psrld-imm x8 31)
960
         (inst movdqa x9 x7)
961
         (inst pslldq x8 4)
962
         (inst pslldq x7 4)
963
         (inst psrldq x9 12)
964
         (inst por x3 x7)
965
         (inst por x6 x8)
966
         (inst por x6 x9)
967
         (inst movdqa x7 x3)
968
         (inst movdqa x8 x3)
969
         (inst movdqa x9 x3)
970
         (inst pslld-imm x7 31)
971
         (inst pslld-imm x8 30)
972
         (inst pslld-imm x9 25)
973
         (inst pxor x7 x8)
974
         (inst pxor x7 x9)
975
         (inst movdqa x8 x7)
976
         (inst pslldq x7 12)
977
         (inst psrldq x8 4)
978
         (inst pxor x3 x7)
979
         (inst movdqa x2 x3)
980
         (inst movdqa x4 x3)
981
         (inst movdqa x5 x3)
982
         (inst psrld-imm x2 1)
983
         (inst psrld-imm x4 2)
984
         (inst psrld-imm x5 7)
985
         (inst pxor x2 x4)
986
         (inst pxor x2 x5)
987
         (inst pxor x2 x8)
988
         (inst pxor x3 x2)
989
         (inst pxor x6 x3)
990
         (inst movdqu (buffer-mem accumulator) x6))))
991
 
992
   #+x86-64
993
   (define-vop (xor128)
994
     (:translate ironclad::xor128)
995
     (:policy :fast-safe)
996
     (:args (in1 :scs (descriptor-reg))
997
            (start-in1 :scs (unsigned-reg))
998
            (in2 :scs (descriptor-reg))
999
            (start-in2 :scs (unsigned-reg))
1000
            (out :scs (descriptor-reg))
1001
            (start-out :scs (unsigned-reg)))
1002
     (:arg-types simple-array-unsigned-byte-8
1003
                 positive-fixnum
1004
                 simple-array-unsigned-byte-8
1005
                 positive-fixnum
1006
                 simple-array-unsigned-byte-8
1007
                 positive-fixnum)
1008
     (:temporary (:sc double-reg) x0 x1)
1009
     (:generator 1000
1010
       (flet ((buffer-mem (base offset)
1011
                (let ((disp (- (* n-word-bytes vector-data-offset)
1012
                               other-pointer-lowtag)))
1013
                  (ea disp base offset))))
1014
         (inst movdqu x0 (buffer-mem in1 start-in1))
1015
         (inst movdqu x1 (buffer-mem in2 start-in2))
1016
         (inst pxor x0 x1)
1017
         (inst movdqu (buffer-mem out start-out) x0))))
1018
 
1019
   #+x86-64
1020
   (define-vop (mov128)
1021
     (:translate ironclad::mov128)
1022
     (:policy :fast-safe)
1023
     (:args (in :scs (descriptor-reg))
1024
            (start-in :scs (unsigned-reg))
1025
            (out :scs (descriptor-reg))
1026
            (start-out :scs (unsigned-reg)))
1027
     (:arg-types simple-array-unsigned-byte-8
1028
                 positive-fixnum
1029
                 simple-array-unsigned-byte-8
1030
                 positive-fixnum)
1031
     (:temporary (:sc double-reg) x0)
1032
     (:generator 1000
1033
       (flet ((buffer-mem (base offset)
1034
                (let ((disp (- (* n-word-bytes vector-data-offset)
1035
                               other-pointer-lowtag)))
1036
                  (ea disp base offset))))
1037
         (inst movdqu x0 (buffer-mem in start-in))
1038
         (inst movdqu (buffer-mem out start-out) x0))))
1039
 
1040
   (define-vop (swap32)
1041
     (:translate ironclad::swap32)
1042
     (:policy :fast-safe)
1043
     (:args (n :scs (unsigned-reg) :target r))
1044
     (:arg-types unsigned-num)
1045
     (:results (r :scs (unsigned-reg)))
1046
     (:result-types unsigned-num)
1047
     (:generator 2
1048
       (move r n)
1049
       (dword-inst bswap r)))
1050
 
1051
   #+x86-64
1052
   (define-vop (swap64)
1053
     (:translate ironclad::swap64)
1054
     (:policy :fast-safe)
1055
     (:args (n :scs (unsigned-reg) :target r))
1056
     (:arg-types unsigned-num)
1057
     (:results (r :scs (unsigned-reg)))
1058
     (:result-types unsigned-num)
1059
     (:generator 2
1060
       (move r n)
1061
       (inst bswap r)))
1062
 
1063
   (define-vop (inc-counter-block)
1064
     (:translate ironclad::inc-counter-block)
1065
     (:policy :fast-safe)
1066
     (:args (size :scs (unsigned-reg) :target idx)
1067
            (counter :scs (descriptor-reg)))
1068
     (:arg-types positive-fixnum
1069
                 simple-array-unsigned-byte-8)
1070
     (:temporary (:sc unsigned-reg) idx)
1071
     (:generator 1000
1072
       (let ((start (gen-label))
1073
             (end (gen-label)))
1074
         (move idx size)
1075
         (inst stc)
1076
         (emit-label start)
1077
         #.(let ((disp '(- (* n-word-bytes vector-data-offset)
1078
                         other-pointer-lowtag 1)))
1079
             #+ironclad-sb-vm-ea
1080
             `(inst adc :byte (ea ,disp counter idx) 0)
1081
             #-ironclad-sb-vm-ea
1082
             `(inst adc (sb-vm::make-ea :byte :base counter :index idx :disp ,disp) 0))
1083
         (inst jmp :nc end)
1084
         (inst dec idx)
1085
         (inst jmp :nz start)
1086
         (emit-label end)))))