Coverage report: /home/ellis/comp/ext/ironclad/src/ciphers/serpent.lisp

KindCoveredAll%
expression0252 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; serpent.lisp -- implementation of the Serpent block cipher
2
 (in-package :crypto)
3
 
4
 ;;; S-Boxes
5
 (defmacro serpent-sbox0 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
6
   `(setf ,r3 (logxor ,r3 ,r0)
7
          ,t0 ,r1
8
          ,r1 (logand ,r1 ,r3)
9
          ,t0 (logxor ,t0 ,r2)
10
          ,r1 (logxor ,r1 ,r0)
11
          ,r0 (logior ,r0 ,r3)
12
          ,r0 (logxor ,r0 ,t0)
13
          ,t0 (logxor ,t0 ,r3)
14
          ,r3 (logxor ,r3 ,r2)
15
          ,r2 (logior ,r2 ,r1)
16
          ,r2 (logxor ,r2 ,t0)
17
          ,t0 (mod32lognot ,t0)
18
          ,t0 (logior ,t0 ,r1)
19
          ,r1 (logxor ,r1 ,r3)
20
          ,r1 (logxor ,r1 ,t0)
21
          ,r3 (logior ,r3 ,r0)
22
          ,r1 (logxor ,r1 ,r3)
23
          ,t0 (logxor ,t0 ,r3)
24
          ,o0 ,r1
25
          ,o1 ,t0
26
          ,o2 ,r2
27
          ,o3 ,r0))
28
 
29
 (defmacro serpent-sbox0-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
30
   `(setf ,r2 (mod32lognot ,r2)
31
          ,t0 ,r1
32
          ,r1 (logior ,r1 ,r0)
33
          ,t0 (mod32lognot ,t0)
34
          ,r1 (logxor ,r1 ,r2)
35
          ,r2 (logior ,r2 ,t0)
36
          ,r1 (logxor ,r1 ,r3)
37
          ,r0 (logxor ,r0 ,t0)
38
          ,r2 (logxor ,r2 ,r0)
39
          ,r0 (logand ,r0 ,r3)
40
          ,t0 (logxor ,t0 ,r0)
41
          ,r0 (logior ,r0 ,r1)
42
          ,r0 (logxor ,r0 ,r2)
43
          ,r3 (logxor ,r3 ,t0)
44
          ,r2 (logxor ,r2 ,r1)
45
          ,r3 (logxor ,r3 ,r0)
46
          ,r3 (logxor ,r3 ,r1)
47
          ,r2 (logand ,r2 ,r3)
48
          ,t0 (logxor ,t0 ,r2)
49
          ,o0 ,r0
50
          ,o1 ,t0
51
          ,o2 ,r1
52
          ,o3 ,r3))
53
 
54
 (defmacro serpent-sbox1 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
55
   `(setf ,r0 (mod32lognot ,r0)
56
          ,r2 (mod32lognot ,r2)
57
          ,t0 ,r0
58
          ,r0 (logand ,r0 ,r1)
59
          ,r2 (logxor ,r0 ,r2)
60
          ,r0 (logior ,r0 ,r3)
61
          ,r3 (logxor ,r3 ,r2)
62
          ,r1 (logxor ,r1 ,r0)
63
          ,r0 (logxor ,r0 ,t0)
64
          ,t0 (logior ,t0 ,r1)
65
          ,r1 (logxor ,r1 ,r3)
66
          ,r2 (logior ,r2 ,r0)
67
          ,r2 (logand ,r2 ,t0)
68
          ,r0 (logxor ,r0 ,r1)
69
          ,r1 (logand ,r1 ,r2)
70
          ,r1 (logxor ,r1 ,r0)
71
          ,r0 (logand ,r0 ,r2)
72
          ,r0 (logxor ,r0 ,t0)
73
          ,o0 ,r2
74
          ,o1 ,r0
75
          ,o2 ,r3
76
          ,o3 ,r1))
77
 
78
 (defmacro serpent-sbox1-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
79
   `(setf ,t0 ,r1
80
          ,r1 (logxor ,r1 ,r3)
81
          ,r3 (logand ,r3 ,r1)
82
          ,t0 (logxor ,t0 ,r2)
83
          ,r3 (logxor ,r3 ,r0)
84
          ,r0 (logior ,r0 ,r1)
85
          ,r2 (logxor ,r2 ,r3)
86
          ,r0 (logxor ,r0 ,t0)
87
          ,r0 (logior ,r0 ,r2)
88
          ,r1 (logxor ,r1 ,r3)
89
          ,r0 (logxor ,r0 ,r1)
90
          ,r1 (logior ,r1 ,r3)
91
          ,r1 (logxor ,r1 ,r0)
92
          ,t0 (mod32lognot ,t0)
93
          ,t0 (logxor ,t0 ,r1)
94
          ,r1 (logior ,r1 ,r0)
95
          ,r1 (logxor ,r1 ,r0)
96
          ,r1 (logior ,r1 ,t0)
97
          ,r3 (logxor ,r3 ,r1)
98
          ,o0 ,t0
99
          ,o1 ,r0
100
          ,o2 ,r3
101
          ,o3 ,r2))
102
 
103
 (defmacro serpent-sbox2 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
104
   `(setf ,t0 ,r0
105
          ,r0 (logand ,r0 ,r2)
106
          ,r0 (logxor ,r0 ,r3)
107
          ,r2 (logxor ,r2 ,r1)
108
          ,r2 (logxor ,r2 ,r0)
109
          ,r3 (logior ,r3 ,t0)
110
          ,r3 (logxor ,r3 ,r1)
111
          ,t0 (logxor ,t0 ,r2)
112
          ,r1 ,r3
113
          ,r3 (logior ,r3 ,t0)
114
          ,r3 (logxor ,r3 ,r0)
115
          ,r0 (logand ,r0 ,r1)
116
          ,t0 (logxor ,t0 ,r0)
117
          ,r1 (logxor ,r1 ,r3)
118
          ,r1 (logxor ,r1 ,t0)
119
          ,t0 (mod32lognot ,t0)
120
          ,o0 ,r2
121
          ,o1 ,r3
122
          ,o2 ,r1
123
          ,o3 ,t0))
124
 
125
 (defmacro serpent-sbox2-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
126
   `(setf ,r2 (logxor ,r2 ,r3)
127
          ,r3 (logxor ,r3 ,r0)
128
          ,t0 ,r3
129
          ,r3 (logand ,r3 ,r2)
130
          ,r3 (logxor ,r3 ,r1)
131
          ,r1 (logior ,r1 ,r2)
132
          ,r1 (logxor ,r1 ,t0)
133
          ,t0 (logand ,t0 ,r3)
134
          ,r2 (logxor ,r2 ,r3)
135
          ,t0 (logand ,t0 ,r0)
136
          ,t0 (logxor ,t0 ,r2)
137
          ,r2 (logand ,r2 ,r1)
138
          ,r2 (logior ,r2 ,r0)
139
          ,r3 (mod32lognot ,r3)
140
          ,r2 (logxor ,r2 ,r3)
141
          ,r0 (logxor ,r0 ,r3)
142
          ,r0 (logand ,r0 ,r1)
143
          ,r3 (logxor ,r3 ,t0)
144
          ,r3 (logxor ,r3 ,r0)
145
          ,o0 ,r1
146
          ,o1 ,t0
147
          ,o2 ,r2
148
          ,o3 ,r3))
149
 
150
 (defmacro serpent-sbox3 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
151
   `(setf ,t0 ,r0
152
          ,r0 (logior ,r0 ,r3)
153
          ,r3 (logxor ,r3 ,r1)
154
          ,r1 (logand ,r1 ,t0)
155
          ,t0 (logxor ,t0 ,r2)
156
          ,r2 (logxor ,r2 ,r3)
157
          ,r3 (logand ,r3 ,r0)
158
          ,t0 (logior ,t0 ,r1)
159
          ,r3 (logxor ,r3 ,t0)
160
          ,r0 (logxor ,r0 ,r1)
161
          ,t0 (logand ,t0 ,r0)
162
          ,r1 (logxor ,r1 ,r3)
163
          ,t0 (logxor ,t0 ,r2)
164
          ,r1 (logior ,r1 ,r0)
165
          ,r1 (logxor ,r1 ,r2)
166
          ,r0 (logxor ,r0 ,r3)
167
          ,r2 ,r1
168
          ,r1 (logior ,r1 ,r3)
169
          ,r1 (logxor ,r1 ,r0)
170
          ,o0 ,r1
171
          ,o1 ,r2
172
          ,o2 ,r3
173
          ,o3 ,t0))
174
 
175
 (defmacro serpent-sbox3-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
176
   `(setf ,t0 ,r2
177
          ,r2 (logxor ,r2 ,r1)
178
          ,r0 (logxor ,r0 ,r2)
179
          ,t0 (logand ,t0 ,r2)
180
          ,t0 (logxor ,t0 ,r0)
181
          ,r0 (logand ,r0 ,r1)
182
          ,r1 (logxor ,r1 ,r3)
183
          ,r3 (logior ,r3 ,t0)
184
          ,r2 (logxor ,r2 ,r3)
185
          ,r0 (logxor ,r0 ,r3)
186
          ,r1 (logxor ,r1 ,t0)
187
          ,r3 (logand ,r3 ,r2)
188
          ,r3 (logxor ,r3 ,r1)
189
          ,r1 (logxor ,r1 ,r0)
190
          ,r1 (logior ,r1 ,r2)
191
          ,r0 (logxor ,r0 ,r3)
192
          ,r1 (logxor ,r1 ,t0)
193
          ,r0 (logxor ,r0 ,r1)
194
          ,o0 ,r2
195
          ,o1 ,r1
196
          ,o2 ,r3
197
          ,o3 ,r0))
198
 
199
 (defmacro serpent-sbox4 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
200
   `(setf ,r1 (logxor ,r1 ,r3)
201
          ,r3 (mod32lognot ,r3)
202
          ,r2 (logxor ,r2 ,r3)
203
          ,r3 (logxor ,r3 ,r0)
204
          ,t0 ,r1
205
          ,r1 (logand ,r1 ,r3)
206
          ,r1 (logxor ,r1 ,r2)
207
          ,t0 (logxor ,t0 ,r3)
208
          ,r0 (logxor ,r0 ,t0)
209
          ,r2 (logand ,r2 ,t0)
210
          ,r2 (logxor ,r2 ,r0)
211
          ,r0 (logand ,r0 ,r1)
212
          ,r3 (logxor ,r3 ,r0)
213
          ,t0 (logior ,t0 ,r1)
214
          ,t0 (logxor ,t0 ,r0)
215
          ,r0 (logior ,r0 ,r3)
216
          ,r0 (logxor ,r0 ,r2)
217
          ,r2 (logand ,r2 ,r3)
218
          ,r0 (mod32lognot ,r0)
219
          ,t0 (logxor ,t0 ,r2)
220
          ,o0 ,r1
221
          ,o1 ,t0
222
          ,o2 ,r0
223
          ,o3 ,r3))
224
 
225
 (defmacro serpent-sbox4-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
226
   `(setf ,t0 ,r2
227
          ,r2 (logand ,r2 ,r3)
228
          ,r2 (logxor ,r2 ,r1)
229
          ,r1 (logior ,r1 ,r3)
230
          ,r1 (logand ,r1 ,r0)
231
          ,t0 (logxor ,t0 ,r2)
232
          ,t0 (logxor ,t0 ,r1)
233
          ,r1 (logand ,r1 ,r2)
234
          ,r0 (mod32lognot ,r0)
235
          ,r3 (logxor ,r3 ,t0)
236
          ,r1 (logxor ,r1 ,r3)
237
          ,r3 (logand ,r3 ,r0)
238
          ,r3 (logxor ,r3 ,r2)
239
          ,r0 (logxor ,r0 ,r1)
240
          ,r2 (logand ,r2 ,r0)
241
          ,r3 (logxor ,r3 ,r0)
242
          ,r2 (logxor ,r2 ,t0)
243
          ,r2 (logior ,r2 ,r3)
244
          ,r3 (logxor ,r3 ,r0)
245
          ,r2 (logxor ,r2 ,r1)
246
          ,o0 ,r0
247
          ,o1 ,r3
248
          ,o2 ,r2
249
          ,o3 ,t0))
250
 
251
 (defmacro serpent-sbox5 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
252
   `(setf ,r0 (logxor ,r0 ,r1)
253
          ,r1 (logxor ,r1 ,r3)
254
          ,r3 (mod32lognot ,r3)
255
          ,t0 ,r1
256
          ,r1 (logand ,r1 ,r0)
257
          ,r2 (logxor ,r2 ,r3)
258
          ,r1 (logxor ,r1 ,r2)
259
          ,r2 (logior ,r2 ,t0)
260
          ,t0 (logxor ,t0 ,r3)
261
          ,r3 (logand ,r3 ,r1)
262
          ,r3 (logxor ,r3 ,r0)
263
          ,t0 (logxor ,t0 ,r1)
264
          ,t0 (logxor ,t0 ,r2)
265
          ,r2 (logxor ,r2 ,r0)
266
          ,r0 (logand ,r0 ,r3)
267
          ,r2 (mod32lognot ,r2)
268
          ,r0 (logxor ,r0 ,t0)
269
          ,t0 (logior ,t0 ,r3)
270
          ,r2 (logxor ,r2 ,t0)
271
          ,o0 ,r1
272
          ,o1 ,r3
273
          ,o2 ,r0
274
          ,o3 ,r2))
275
 
276
 (defmacro serpent-sbox5-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
277
   `(setf ,r1 (mod32lognot ,r1)
278
          ,t0 ,r3
279
          ,r2 (logxor ,r2 ,r1)
280
          ,r3 (logior ,r3 ,r0)
281
          ,r3 (logxor ,r3 ,r2)
282
          ,r2 (logior ,r2 ,r1)
283
          ,r2 (logand ,r2 ,r0)
284
          ,t0 (logxor ,t0 ,r3)
285
          ,r2 (logxor ,r2 ,t0)
286
          ,t0 (logior ,t0 ,r0)
287
          ,t0 (logxor ,t0 ,r1)
288
          ,r1 (logand ,r1 ,r2)
289
          ,r1 (logxor ,r1 ,r3)
290
          ,t0 (logxor ,t0 ,r2)
291
          ,r3 (logand ,r3 ,t0)
292
          ,t0 (logxor ,t0 ,r1)
293
          ,r3 (logxor ,r3 ,t0)
294
          ,t0 (mod32lognot ,t0)
295
          ,r3 (logxor ,r3 ,r0)
296
          ,o0 ,r1
297
          ,o1 ,t0
298
          ,o2 ,r3
299
          ,o3 ,r2))
300
 
301
 (defmacro serpent-sbox6 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
302
   `(setf ,r2 (mod32lognot ,r2)
303
          ,t0 ,r3
304
          ,r3 (logand ,r3 ,r0)
305
          ,r0 (logxor ,r0 ,t0)
306
          ,r3 (logxor ,r3 ,r2)
307
          ,r2 (logior ,r2 ,t0)
308
          ,r1 (logxor ,r1 ,r3)
309
          ,r2 (logxor ,r2 ,r0)
310
          ,r0 (logior ,r0 ,r1)
311
          ,r2 (logxor ,r2 ,r1)
312
          ,t0 (logxor ,t0 ,r0)
313
          ,r0 (logior ,r0 ,r3)
314
          ,r0 (logxor ,r0 ,r2)
315
          ,t0 (logxor ,t0 ,r3)
316
          ,t0 (logxor ,t0 ,r0)
317
          ,r3 (mod32lognot ,r3)
318
          ,r2 (logand ,r2 ,t0)
319
          ,r2 (logxor ,r2 ,r3)
320
          ,o0 ,r0
321
          ,o1 ,r1
322
          ,o2 ,t0
323
          ,o3 ,r2))
324
 
325
 (defmacro serpent-sbox6-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
326
   `(setf ,r0 (logxor ,r0 ,r2)
327
          ,t0 ,r2
328
          ,r2 (logand ,r2 ,r0)
329
          ,t0 (logxor ,t0 ,r3)
330
          ,r2 (mod32lognot ,r2)
331
          ,r3 (logxor ,r3 ,r1)
332
          ,r2 (logxor ,r2 ,r3)
333
          ,t0 (logior ,t0 ,r0)
334
          ,r0 (logxor ,r0 ,r2)
335
          ,r3 (logxor ,r3 ,t0)
336
          ,t0 (logxor ,t0 ,r1)
337
          ,r1 (logand ,r1 ,r3)
338
          ,r1 (logxor ,r1 ,r0)
339
          ,r0 (logxor ,r0 ,r3)
340
          ,r0 (logior ,r0 ,r2)
341
          ,r3 (logxor ,r3 ,r1)
342
          ,t0 (logxor ,t0 ,r0)
343
          ,o0 ,r1
344
          ,o1 ,r2
345
          ,o2 ,t0
346
          ,o3 ,r3))
347
 
348
 (defmacro serpent-sbox7 (r0 r1 r2 r3 o0 o1 o2 o3 t0)
349
   `(setf ,t0 ,r1
350
          ,r1 (logior ,r1 ,r2)
351
          ,r1 (logxor ,r1 ,r3)
352
          ,t0 (logxor ,t0 ,r2)
353
          ,r2 (logxor ,r2 ,r1)
354
          ,r3 (logior ,r3 ,t0)
355
          ,r3 (logand ,r3 ,r0)
356
          ,t0 (logxor ,t0 ,r2)
357
          ,r3 (logxor ,r3 ,r1)
358
          ,r1 (logior ,r1 ,t0)
359
          ,r1 (logxor ,r1 ,r0)
360
          ,r0 (logior ,r0 ,t0)
361
          ,r0 (logxor ,r0 ,r2)
362
          ,r1 (logxor ,r1 ,t0)
363
          ,r2 (logxor ,r2 ,r1)
364
          ,r1 (logand ,r1 ,r0)
365
          ,r1 (logxor ,r1 ,t0)
366
          ,r2 (mod32lognot ,r2)
367
          ,r2 (logior ,r2 ,r0)
368
          ,t0 (logxor ,t0 ,r2)
369
          ,o0 ,t0
370
          ,o1 ,r3
371
          ,o2 ,r1
372
          ,o3 ,r0))
373
 
374
 (defmacro serpent-sbox7-inverse (r0 r1 r2 r3 o0 o1 o2 o3 t0)
375
   `(setf ,t0 ,r2
376
          ,r2 (logxor ,r2 ,r0)
377
          ,r0 (logand ,r0 ,r3)
378
          ,t0 (logior ,t0 ,r3)
379
          ,r2 (mod32lognot ,r2)
380
          ,r3 (logxor ,r3 ,r1)
381
          ,r1 (logior ,r1 ,r0)
382
          ,r0 (logxor ,r0 ,r2)
383
          ,r2 (logand ,r2 ,t0)
384
          ,r3 (logand ,r3 ,t0)
385
          ,r1 (logxor ,r1 ,r2)
386
          ,r2 (logxor ,r2 ,r0)
387
          ,r0 (logior ,r0 ,r2)
388
          ,t0 (logxor ,t0 ,r1)
389
          ,r0 (logxor ,r0 ,r3)
390
          ,r3 (logxor ,r3 ,t0)
391
          ,t0 (logior ,t0 ,r0)
392
          ,r3 (logxor ,r3 ,r2)
393
          ,t0 (logxor ,t0 ,r2)
394
          ,o0 ,r3
395
          ,o1 ,r0
396
          ,o2 ,r1
397
          ,o3 ,t0))
398
 
399
 
400
 ;;; Linear transformation
401
 
402
 (defmacro serpent-linear-transformation (r0 r1 r2 r3)
403
   `(setf ,r0 (rol32 ,r0 13)
404
          ,r2 (rol32 ,r2 3)
405
          ,r1 (logxor ,r1 ,r0 ,r2)
406
          ,r3 (logxor ,r3 ,r2 (mod32ash ,r0 3))
407
          ,r1 (rol32 ,r1 1)
408
          ,r3 (rol32 ,r3 7)
409
          ,r0 (logxor ,r0 ,r1 ,r3)
410
          ,r2 (logxor ,r2 ,r3 (mod32ash ,r1 7))
411
          ,r0 (rol32 ,r0 5)
412
          ,r2 (rol32 ,r2 22)))
413
 
414
 (defmacro serpent-linear-transformation-inverse (r0 r1 r2 r3)
415
   `(setf ,r2 (rol32 ,r2 10)
416
          ,r0 (rol32 ,r0 27)
417
          ,r2 (logxor ,r2 ,r3 (mod32ash ,r1 7))
418
          ,r0 (logxor ,r0 ,r1 ,r3)
419
          ,r3 (rol32 ,r3 25)
420
          ,r1 (rol32 ,r1 31)
421
          ,r3 (logxor ,r3 ,r2 (mod32ash ,r0 3))
422
          ,r1 (logxor ,r1 ,r0 ,r2)
423
          ,r2 (rol32 ,r2 29)
424
          ,r0 (rol32 ,r0 19)))
425
 
426
 
427
 ;;; Key schedule
428
 
429
 (defconstant +serpent-phi+ #x9e3779b9)
430
 
431
 (defclass serpent (cipher 16-byte-block-mixin)
432
   ((subkeys :accessor serpent-subkeys
433
             :type (simple-array (unsigned-byte 32) (33 4)))))
434
 
435
 (defun serpent-pad-key (key)
436
   (let ((padded-key (make-array 8 :element-type '(unsigned-byte 32)))
437
         (len (floor (length key) 4)))
438
     (dotimes (i len)
439
       (setf (aref padded-key i) (ub32ref/le key (* i 4))))
440
     (when (< len 8)
441
       (setf (aref padded-key len) 1)
442
       (loop for i from (1+ len) below 8
443
             do (setf (aref padded-key i) 0)))
444
     padded-key))
445
 
446
 (defun serpent-generate-subkeys (key)
447
   (declare (type (simple-array (unsigned-byte 32) (8)) key)
448
            (optimize (speed 3) (space 0) (safety 0) (debug 0)))
449
   (let ((subkeys (make-array '(33 4) :element-type '(unsigned-byte 32)))
450
         (w (copy-seq key))
451
         (ws (make-array 4 :element-type '(unsigned-byte 32)))
452
         (wt (make-array 4 :element-type '(unsigned-byte 32)))
453
         (t0 0)
454
         (t1 0)
455
         (t2 0)
456
         (t3 0)
457
         (t4 0))
458
     (declare (type (simple-array (unsigned-byte 32) (33 4)) subkeys)
459
              (type (simple-array (unsigned-byte 32) (8)) w)
460
              (type (simple-array (unsigned-byte 32) (4)) ws wt)
461
              (type (unsigned-byte 32) t0 t1 t2 t3 t4))
462
     (macrolet ((expand-key4 (wo r)
463
                  `(setf (aref ,wo 0) (rol32 (logxor (aref w ,(mod (+ r 0) 8))
464
                                                     (aref w ,(mod (+ r 3) 8))
465
                                                     (aref w ,(mod (+ r 5) 8))
466
                                                     (aref w ,(mod (+ r 7) 8))
467
                                                     +serpent-phi+
468
                                                     ,(+ r 0))
469
                                             11)
470
                         (aref w ,(mod (+ r 0) 8)) (aref ,wo 0)
471
                         (aref ,wo 1) (rol32 (logxor (aref w ,(mod (+ r 1) 8))
472
                                                     (aref w ,(mod (+ r 4) 8))
473
                                                     (aref w ,(mod (+ r 6) 8))
474
                                                     (aref w ,(mod (+ r 0) 8))
475
                                                     +serpent-phi+
476
                                                     ,(+ r 1))
477
                                             11)
478
                         (aref w ,(mod (+ r 1) 8)) (aref ,wo 1)
479
                         (aref ,wo 2) (rol32 (logxor (aref w ,(mod (+ r 2) 8))
480
                                                     (aref w ,(mod (+ r 5) 8))
481
                                                     (aref w ,(mod (+ r 7) 8))
482
                                                     (aref w ,(mod (+ r 1) 8))
483
                                                     +serpent-phi+
484
                                                     ,(+ r 2))
485
                                             11)
486
                         (aref w ,(mod (+ r 2) 8)) (aref ,wo 2)
487
                         (aref ,wo 3) (rol32 (logxor (aref w ,(mod (+ r 3) 8))
488
                                                     (aref w ,(mod (+ r 6) 8))
489
                                                     (aref w ,(mod (+ r 0) 8))
490
                                                     (aref w ,(mod (+ r 2) 8))
491
                                                     +serpent-phi+
492
                                                     ,(+ r 3))
493
                                             11)
494
                         (aref w ,(mod (+ r 3) 8)) (aref ,wo 3)))
495
 
496
                (make-subkeys ()
497
                  (loop for i from 0 to 15
498
                        for sbox-a = (read-from-string (format nil "serpent-sbox~d" (mod (- 3 (* 2 i)) 8)))
499
                        for sbox-b = (read-from-string (format nil "serpent-sbox~d" (mod (- 2 (* 2 i)) 8)))
500
                        append (list `(expand-key4 ws ,(* 8 i))
501
                                     `(expand-key4 wt ,(+ (* 8 i) 4))
502
                                     `(setf t0 (aref ws 0)
503
                                            t1 (aref ws 1)
504
                                            t2 (aref ws 2)
505
                                            t3 (aref ws 3))
506
                                     `(,sbox-a t0 t1 t2 t3 (aref ws 0) (aref ws 1) (aref ws 2) (aref ws 3) t4)
507
                                     `(setf (aref subkeys ,(* 2 i) 0) (aref ws 0)
508
                                            (aref subkeys ,(* 2 i) 1) (aref ws 1)
509
                                            (aref subkeys ,(* 2 i) 2) (aref ws 2)
510
                                            (aref subkeys ,(* 2 i) 3) (aref ws 3))
511
                                     `(setf t0 (aref wt 0)
512
                                            t1 (aref wt 1)
513
                                            t2 (aref wt 2)
514
                                            t3 (aref wt 3))
515
                                     `(,sbox-b t0 t1 t2 t3 (aref wt 0) (aref wt 1) (aref wt 2) (aref wt 3) t4)
516
                                     `(setf (aref subkeys ,(1+ (* 2 i)) 0) (aref wt 0)
517
                                            (aref subkeys ,(1+ (* 2 i)) 1) (aref wt 1)
518
                                            (aref subkeys ,(1+ (* 2 i)) 2) (aref wt 2)
519
                                            (aref subkeys ,(1+ (* 2 i)) 3) (aref wt 3)))
520
                        into forms
521
                        finally (return `(progn ,@forms)))))
522
 
523
       (make-subkeys)
524
       (expand-key4 ws 128)
525
       (setf t0 (aref ws 0)
526
             t1 (aref ws 1)
527
             t2 (aref ws 2)
528
             t3 (aref ws 3))
529
       (serpent-sbox3 t0 t1 t2 t3 (aref ws 0) (aref ws 1) (aref ws 2) (aref ws 3) t4)
530
       (setf (aref subkeys 32 0) (aref ws 0)
531
             (aref subkeys 32 1) (aref ws 1)
532
             (aref subkeys 32 2) (aref ws 2)
533
             (aref subkeys 32 3) (aref ws 3))
534
 
535
       subkeys)))
536
 
537
 (defmethod schedule-key ((cipher serpent) key)
538
   (setf (serpent-subkeys cipher) (serpent-generate-subkeys (serpent-pad-key key)))
539
   cipher)
540
 
541
 ;;; Rounds
542
 (define-block-encryptor serpent 16
543
   (let ((subkeys (serpent-subkeys context))
544
         (t0 0)
545
         (t1 0)
546
         (t2 0)
547
         (t3 0)
548
         (t4 0))
549
     (declare (type (simple-array (unsigned-byte 32) (33 4)) subkeys)
550
              (type (unsigned-byte 32) t0 t1 t2 t3 t4))
551
     (with-words ((b0 b1 b2 b3) plaintext plaintext-start :big-endian nil :size 4)
552
       (macrolet ((serpent-rounds ()
553
                    (loop for i from 0 to 30
554
                       for sbox = (read-from-string (format nil "serpent-sbox~d" (mod i 8)))
555
                       append (list `(setf t0 (logxor b0 (aref subkeys ,i 0))
556
                                           t1 (logxor b1 (aref subkeys ,i 1))
557
                                           t2 (logxor b2 (aref subkeys ,i 2))
558
                                           t3 (logxor b3 (aref subkeys ,i 3)))
559
                                    `(,sbox t0 t1 t2 t3 b0 b1 b2 b3 t4)
560
                                    `(serpent-linear-transformation b0 b1 b2 b3))
561
                       into forms
562
                       finally (return `(progn ,@forms)))))
563
 
564
         ;; Regular rounds
565
         (serpent-rounds)
566
 
567
         ;; Last round
568
         (setf b0 (logxor b0 (aref subkeys 31 0))
569
               b1 (logxor b1 (aref subkeys 31 1))
570
               b2 (logxor b2 (aref subkeys 31 2))
571
               b3 (logxor b3 (aref subkeys 31 3)))
572
         (serpent-sbox7 b0 b1 b2 b3 t0 t1 t2 t3 t4)
573
         (setf b0 (logxor t0 (aref subkeys 32 0))
574
               b1 (logxor t1 (aref subkeys 32 1))
575
               b2 (logxor t2 (aref subkeys 32 2))
576
               b3 (logxor t3 (aref subkeys 32 3)))
577
 
578
         (store-words ciphertext ciphertext-start b0 b1 b2 b3)
579
         (values)))))
580
 
581
 (define-block-decryptor serpent 16
582
   (let ((subkeys (serpent-subkeys context))
583
         (t0 0)
584
         (t1 0)
585
         (t2 0)
586
         (t3 0)
587
         (t4 0))
588
     (declare (type (simple-array (unsigned-byte 32) (33 4)) subkeys)
589
              (type (unsigned-byte 32) t0 t1 t2 t3 t4))
590
     (with-words ((b0 b1 b2 b3) ciphertext ciphertext-start :big-endian nil :size 4)
591
       (macrolet ((serpent-rounds-inverse ()
592
                    (loop for i from 30 downto 0
593
                       for sbox-inverse = (read-from-string (format nil "serpent-sbox~d-inverse" (mod i 8)))
594
                       append (list `(serpent-linear-transformation-inverse b0 b1 b2 b3)
595
                                    `(,sbox-inverse b0 b1 b2 b3 t0 t1 t2 t3 t4)
596
                                    `(setf b0 (logxor t0 (aref subkeys ,i 0))
597
                                           b1 (logxor t1 (aref subkeys ,i 1))
598
                                           b2 (logxor t2 (aref subkeys ,i 2))
599
                                           b3 (logxor t3 (aref subkeys ,i 3))))
600
                       into forms
601
                       finally (return `(progn ,@forms)))))
602
 
603
         ;; First inverse round
604
         (setf b0 (logxor b0 (aref subkeys 32 0))
605
               b1 (logxor b1 (aref subkeys 32 1))
606
               b2 (logxor b2 (aref subkeys 32 2))
607
               b3 (logxor b3 (aref subkeys 32 3)))
608
         (serpent-sbox7-inverse b0 b1 b2 b3 t0 t1 t2 t3 t4)
609
         (setf b0 (logxor t0 (aref subkeys 31 0))
610
               b1 (logxor t1 (aref subkeys 31 1))
611
               b2 (logxor t2 (aref subkeys 31 2))
612
               b3 (logxor t3 (aref subkeys 31 3)))
613
 
614
         ;; Regular inverse rounds
615
         (serpent-rounds-inverse)
616
 
617
         (store-words plaintext plaintext-start b0 b1 b2 b3)
618
         (values)))))
619
 
620
 (defcipher serpent
621
   (:encrypt-function serpent-encrypt-block)
622
   (:decrypt-function serpent-decrypt-block)
623
   (:block-length 16)
624
   (:key-length (:fixed 16 24 32)))