1#! /usr/bin/env perl
2# Copyright 2009-2020 The OpenSSL Project Authors. All Rights Reserved.
3#
4# Licensed under the Apache License 2.0 (the "License").  You may not use
5# this file except in compliance with the License.  You can obtain a copy
6# in the file LICENSE in the source distribution or at
7# https://www.openssl.org/source/license.html
8
9# $output is the last argument if it looks like a file (it has an extension)
10# $flavour is the first argument if it doesn't look like a file
11$output = $#ARGV >= 0 && $ARGV[$#ARGV] =~ m|\.\w+$| ? pop : undef;
12$flavour = $#ARGV >= 0 && $ARGV[0] !~ m|\.| ? shift : undef;
13
14if ($flavour =~ /3[12]/) {
15	$SIZE_T=4;
16	$g="";
17} else {
18	$SIZE_T=8;
19	$g="g";
20}
21
22$output and open STDOUT,">$output";
23
24$ra="%r14";
25$sp="%r15";
26$stdframe=16*$SIZE_T+4*8;
27
28$code=<<___;
29#include "s390x_arch.h"
30
31.text
32
33.globl	OPENSSL_s390x_facilities
34.type	OPENSSL_s390x_facilities,\@function
35.align	16
36OPENSSL_s390x_facilities:
37	lghi	%r0,0
38	larl	%r4,OPENSSL_s390xcap_P
39
40	stg	%r0,S390X_STFLE+8(%r4)	# wipe capability vectors
41	stg	%r0,S390X_STFLE+16(%r4)
42	stg	%r0,S390X_STFLE+24(%r4)
43
44	.long	0xb2b04000		# stfle	0(%r4)
45	brc	8,.Ldone
46	lghi	%r0,1
47	.long	0xb2b04000		# stfle 0(%r4)
48	brc	8,.Ldone
49	lghi	%r0,2
50	.long	0xb2b04000		# stfle 0(%r4)
51.Ldone:
52	br	$ra
53.size	OPENSSL_s390x_facilities,.-OPENSSL_s390x_facilities
54
55.globl	OPENSSL_s390x_functions
56.type	OPENSSL_s390x_functions,\@function
57.align	16
58OPENSSL_s390x_functions:
59	lghi	%r0,0
60	larl	%r4,OPENSSL_s390xcap_P
61
62	stg	%r0,S390X_KIMD(%r4)	# wipe capability vectors
63	stg	%r0,S390X_KIMD+8(%r4)
64	stg	%r0,S390X_KLMD(%r4)
65	stg	%r0,S390X_KLMD+8(%r4)
66	stg	%r0,S390X_KM(%r4)
67	stg	%r0,S390X_KM+8(%r4)
68	stg	%r0,S390X_KMC(%r4)
69	stg	%r0,S390X_KMC+8(%r4)
70	stg	%r0,S390X_KMAC(%r4)
71	stg	%r0,S390X_KMAC+8(%r4)
72	stg	%r0,S390X_KMCTR(%r4)
73	stg	%r0,S390X_KMCTR+8(%r4)
74	stg	%r0,S390X_KMO(%r4)
75	stg	%r0,S390X_KMO+8(%r4)
76	stg	%r0,S390X_KMF(%r4)
77	stg	%r0,S390X_KMF+8(%r4)
78	stg	%r0,S390X_PRNO(%r4)
79	stg	%r0,S390X_PRNO+8(%r4)
80	stg	%r0,S390X_KMA(%r4)
81	stg	%r0,S390X_KMA+8(%r4)
82	stg	%r0,S390X_PCC(%r4)
83	stg	%r0,S390X_PCC+8(%r4)
84	stg	%r0,S390X_KDSA(%r4)
85	stg	%r0,S390X_KDSA+8(%r4)
86
87	lmg	%r2,%r3,S390X_STFLE(%r4)
88
89	tmhl	%r2,0x4000		# check for message-security-assist
90	jz	.Lret
91
92	lghi	%r0,S390X_QUERY		# query kimd capabilities
93	la	%r1,S390X_KIMD(%r4)
94	.long	0xb93e0002		# kimd %r0,%r2
95
96	lghi	%r0,S390X_QUERY		# query klmd capabilities
97	la	%r1,S390X_KLMD(%r4)
98	.long	0xb93f0002		# klmd %r0,%r2
99
100	lghi	%r0,S390X_QUERY		# query km capability vector
101	la	%r1,S390X_KM(%r4)
102	.long	0xb92e0042		# km %r4,%r2
103
104	lghi	%r0,S390X_QUERY		# query kmc capability vector
105	la	%r1,S390X_KMC(%r4)
106	.long	0xb92f0042		# kmc %r4,%r2
107
108	lghi	%r0,S390X_QUERY		# query kmac capability vector
109	la	%r1,S390X_KMAC(%r4)
110	.long	0xb91e0042		# kmac %r4,%r2
111
112	tmhh	%r3,0x0008		# check for message-security-assist-3
113	jz	.Lret
114
115	lghi	%r0,S390X_QUERY		# query pcc capability vector
116	la	%r1,S390X_PCC(%r4)
117	.long	0xb92c0000		# pcc
118
119	tmhh	%r3,0x0004		# check for message-security-assist-4
120	jz	.Lret
121
122	lghi	%r0,S390X_QUERY		# query kmctr capability vector
123	la	%r1,S390X_KMCTR(%r4)
124	.long	0xb92d2042		# kmctr %r4,%r2,%r2
125
126	lghi	%r0,S390X_QUERY		# query kmo capability vector
127	la	%r1,S390X_KMO(%r4)
128	.long	0xb92b0042		# kmo %r4,%r2
129
130	lghi	%r0,S390X_QUERY		# query kmf capability vector
131	la	%r1,S390X_KMF(%r4)
132	.long	0xb92a0042		# kmf %r4,%r2
133
134	tml	%r2,0x40		# check for message-security-assist-5
135	jz	.Lret
136
137	lghi	%r0,S390X_QUERY		# query prno capability vector
138	la	%r1,S390X_PRNO(%r4)
139	.long	0xb93c0042		# prno %r4,%r2
140
141	lg	%r2,S390X_STFLE+16(%r4)
142
143	tmhl	%r2,0x2000		# check for message-security-assist-8
144	jz	.Lret
145
146	lghi	%r0,S390X_QUERY		# query kma capability vector
147	la	%r1,S390X_KMA(%r4)
148	.long	0xb9294022		# kma %r2,%r4,%r2
149
150	tmhl	%r2,0x0010		# check for message-security-assist-9
151	jz	.Lret
152
153	lghi	%r0,S390X_QUERY		# query kdsa capability vector
154	la	%r1,S390X_KDSA(%r4)
155	.long	0xb93a0002		# kdsa %r0,%r2
156
157.Lret:
158	br	$ra
159.size	OPENSSL_s390x_functions,.-OPENSSL_s390x_functions
160
161.globl	OPENSSL_rdtsc
162.type	OPENSSL_rdtsc,\@function
163.align	16
164OPENSSL_rdtsc:
165	larl	%r4,OPENSSL_s390xcap_P
166	tm	S390X_STFLE+3(%r4),0x40	# check for store-clock-fast facility
167	jz	.Lstck
168
169	.long	0xb27cf010	# stckf 16($sp)
170	lg	%r2,16($sp)
171	br	$ra
172.Lstck:
173	stck	16($sp)
174	lg	%r2,16($sp)
175	br	$ra
176.size	OPENSSL_rdtsc,.-OPENSSL_rdtsc
177
178.globl	OPENSSL_atomic_add
179.type	OPENSSL_atomic_add,\@function
180.align	16
181OPENSSL_atomic_add:
182	l	%r1,0(%r2)
183.Lspin:	lr	%r0,%r1
184	ar	%r0,%r3
185	cs	%r1,%r0,0(%r2)
186	brc	4,.Lspin
187	lgfr	%r2,%r0		# OpenSSL expects the new value
188	br	$ra
189.size	OPENSSL_atomic_add,.-OPENSSL_atomic_add
190
191.globl	OPENSSL_wipe_cpu
192.type	OPENSSL_wipe_cpu,\@function
193.align	16
194OPENSSL_wipe_cpu:
195	xgr	%r0,%r0
196	xgr	%r1,%r1
197	lgr	%r2,$sp
198	xgr	%r3,%r3
199	xgr	%r4,%r4
200	lzdr	%f0
201	lzdr	%f1
202	lzdr	%f2
203	lzdr	%f3
204	lzdr	%f4
205	lzdr	%f5
206	lzdr	%f6
207	lzdr	%f7
208	br	$ra
209.size	OPENSSL_wipe_cpu,.-OPENSSL_wipe_cpu
210
211.globl	OPENSSL_cleanse
212.type	OPENSSL_cleanse,\@function
213.align	16
214OPENSSL_cleanse:
215#if !defined(__s390x__) && !defined(__s390x)
216	llgfr	%r3,%r3
217#endif
218	lghi	%r4,15
219	lghi	%r0,0
220	clgr	%r3,%r4
221	jh	.Lot
222	clgr	%r3,%r0
223	bcr	8,%r14
224.Little:
225	stc	%r0,0(%r2)
226	la	%r2,1(%r2)
227	brctg	%r3,.Little
228	br	%r14
229.align	4
230.Lot:	tmll	%r2,7
231	jz	.Laligned
232	stc	%r0,0(%r2)
233	la	%r2,1(%r2)
234	brctg	%r3,.Lot
235.Laligned:
236	srlg	%r4,%r3,3
237.Loop:	stg	%r0,0(%r2)
238	la	%r2,8(%r2)
239	brctg	%r4,.Loop
240	lghi	%r4,7
241	ngr	%r3,%r4
242	jnz	.Little
243	br	$ra
244.size	OPENSSL_cleanse,.-OPENSSL_cleanse
245
246.globl	CRYPTO_memcmp
247.type	CRYPTO_memcmp,\@function
248.align	16
249CRYPTO_memcmp:
250#if !defined(__s390x__) && !defined(__s390x)
251	llgfr	%r4,%r4
252#endif
253	lghi	%r5,0
254	clgr	%r4,%r5
255	je	.Lno_data
256
257.Loop_cmp:
258	llgc	%r0,0(%r2)
259	la	%r2,1(%r2)
260	llgc	%r1,0(%r3)
261	la	%r3,1(%r3)
262	xr	%r1,%r0
263	or	%r5,%r1
264	brctg	%r4,.Loop_cmp
265
266	lnr	%r5,%r5
267	srl	%r5,31
268.Lno_data:
269	lgr	%r2,%r5
270	br	$ra
271.size	CRYPTO_memcmp,.-CRYPTO_memcmp
272
273.globl	OPENSSL_instrument_bus
274.type	OPENSSL_instrument_bus,\@function
275.align	16
276OPENSSL_instrument_bus:
277	lghi	%r2,0
278	br	%r14
279.size	OPENSSL_instrument_bus,.-OPENSSL_instrument_bus
280
281.globl	OPENSSL_instrument_bus2
282.type	OPENSSL_instrument_bus2,\@function
283.align	16
284OPENSSL_instrument_bus2:
285	lghi	%r2,0
286	br	$ra
287.size	OPENSSL_instrument_bus2,.-OPENSSL_instrument_bus2
288
289.globl	OPENSSL_vx_probe
290.type	OPENSSL_vx_probe,\@function
291.align	16
292OPENSSL_vx_probe:
293	.word	0xe700,0x0000,0x0044	# vzero %v0
294	br	$ra
295.size	OPENSSL_vx_probe,.-OPENSSL_vx_probe
296___
297
298{
299################
300# void s390x_kimd(const unsigned char *in, size_t len, unsigned int fc,
301#                 void *param)
302my ($in,$len,$fc,$param) = map("%r$_",(2..5));
303$code.=<<___;
304.globl	s390x_kimd
305.type	s390x_kimd,\@function
306.align	16
307s390x_kimd:
308	llgfr	%r0,$fc
309	lgr	%r1,$param
310
311	.long	0xb93e0002	# kimd %r0,%r2
312	brc	1,.-4		# pay attention to "partial completion"
313
314	br	$ra
315.size	s390x_kimd,.-s390x_kimd
316___
317}
318
319{
320################
321# void s390x_klmd(const unsigned char *in, size_t inlen, unsigned char *out,
322#                 size_t outlen, unsigned int fc, void *param)
323my ($in,$inlen,$out,$outlen,$fc) = map("%r$_",(2..6));
324$code.=<<___;
325.globl	s390x_klmd
326.type	s390x_klmd,\@function
327.align	32
328s390x_klmd:
329	llgfr	%r0,$fc
330	l${g}	%r1,$stdframe($sp)
331
332	.long	0xb93f0042	# klmd %r4,%r2
333	brc	1,.-4		# pay attention to "partial completion"
334
335	br	$ra
336.size	s390x_klmd,.-s390x_klmd
337___
338}
339
340################
341# void s390x_km(const unsigned char *in, size_t len, unsigned char *out,
342#               unsigned int fc, void *param)
343{
344my ($in,$len,$out,$fc,$param) = map("%r$_",(2..6));
345$code.=<<___;
346.globl	s390x_km
347.type	s390x_km,\@function
348.align	16
349s390x_km:
350	lr	%r0,$fc
351	l${g}r	%r1,$param
352
353	.long	0xb92e0042	# km $out,$in
354	brc	1,.-4		# pay attention to "partial completion"
355
356	br	$ra
357.size	s390x_km,.-s390x_km
358___
359}
360
361################
362# void s390x_kmac(const unsigned char *in, size_t len, unsigned int fc,
363#                 void *param)
364{
365my ($in,$len,$fc,$param) = map("%r$_",(2..5));
366$code.=<<___;
367.globl	s390x_kmac
368.type	s390x_kmac,\@function
369.align	16
370s390x_kmac:
371	lr	%r0,$fc
372	l${g}r	%r1,$param
373
374	.long	0xb91e0002	# kmac %r0,$in
375	brc	1,.-4		# pay attention to "partial completion"
376
377	br	$ra
378.size	s390x_kmac,.-s390x_kmac
379___
380}
381
382################
383# void s390x_kmo(const unsigned char *in, size_t len, unsigned char *out,
384#                unsigned int fc, void *param)
385{
386my ($in,$len,$out,$fc,$param) = map("%r$_",(2..6));
387$code.=<<___;
388.globl	s390x_kmo
389.type	s390x_kmo,\@function
390.align	16
391s390x_kmo:
392	lr	%r0,$fc
393	l${g}r	%r1,$param
394
395	.long	0xb92b0042	# kmo $out,$in
396	brc	1,.-4		# pay attention to "partial completion"
397
398	br	$ra
399.size	s390x_kmo,.-s390x_kmo
400___
401}
402
403################
404# void s390x_kmf(const unsigned char *in, size_t len, unsigned char *out,
405#                unsigned int fc, void *param)
406{
407my ($in,$len,$out,$fc,$param) = map("%r$_",(2..6));
408$code.=<<___;
409.globl	s390x_kmf
410.type	s390x_kmf,\@function
411.align	16
412s390x_kmf:
413	lr	%r0,$fc
414	l${g}r	%r1,$param
415
416	.long	0xb92a0042	# kmf $out,$in
417	brc	1,.-4		# pay attention to "partial completion"
418
419	br	$ra
420.size	s390x_kmf,.-s390x_kmf
421___
422}
423
424################
425# void s390x_kma(const unsigned char *aad, size_t alen,
426#                const unsigned char *in, size_t len,
427#                unsigned char *out, unsigned int fc, void *param)
428{
429my ($aad,$alen,$in,$len,$out) = map("%r$_",(2..6));
430$code.=<<___;
431.globl	s390x_kma
432.type	s390x_kma,\@function
433.align	16
434s390x_kma:
435	st${g}	$out,6*$SIZE_T($sp)
436	lm${g}	%r0,%r1,$stdframe($sp)
437
438	.long	0xb9292064	# kma $out,$aad,$in
439	brc	1,.-4		# pay attention to "partial completion"
440
441	l${g}	$out,6*$SIZE_T($sp)
442	br	$ra
443.size	s390x_kma,.-s390x_kma
444___
445}
446
447################
448# int s390x_pcc(unsigned int fc, void *param)
449{
450my ($fc,$param) = map("%r$_",(2..3));
451$code.=<<___;
452.globl	s390x_pcc
453.type	s390x_pcc,\@function
454.align	16
455s390x_pcc:
456	lr	%r0,$fc
457	l${g}r	%r1,$param
458	lhi	%r2,0
459
460	.long	0xb92c0000	# pcc
461	brc	1,.-4		# pay attention to "partial completion"
462	brc	7,.Lpcc_err	# if CC==0 return 0, else return 1
463.Lpcc_out:
464	br	$ra
465.Lpcc_err:
466	lhi	%r2,1
467	j	.Lpcc_out
468.size	s390x_pcc,.-s390x_pcc
469___
470}
471
472################
473# int s390x_kdsa(unsigned int fc, void *param,
474#                const unsigned char *in, size_t len)
475{
476my ($fc,$param,$in,$len) = map("%r$_",(2..5));
477$code.=<<___;
478.globl	s390x_kdsa
479.type	s390x_kdsa,\@function
480.align	16
481s390x_kdsa:
482	lr	%r0,$fc
483	l${g}r	%r1,$param
484	lhi	%r2,0
485
486	.long	0xb93a0004	# kdsa %r0,$in
487	brc	1,.-4		# pay attention to "partial completion"
488	brc	7,.Lkdsa_err	# if CC==0 return 0, else return 1
489.Lkdsa_out:
490	br	$ra
491.Lkdsa_err:
492	lhi	%r2,1
493	j	.Lkdsa_out
494.size	s390x_kdsa,.-s390x_kdsa
495___
496}
497
498################
499# void s390x_flip_endian32(unsigned char dst[32], const unsigned char src[32])
500{
501my ($dst,$src) = map("%r$_",(2..3));
502$code.=<<___;
503.globl	s390x_flip_endian32
504.type	s390x_flip_endian32,\@function
505.align	16
506s390x_flip_endian32:
507	lrvg	%r0,0($src)
508	lrvg	%r1,8($src)
509	lrvg	%r4,16($src)
510	lrvg	%r5,24($src)
511	stg	%r0,24($dst)
512	stg	%r1,16($dst)
513	stg	%r4,8($dst)
514	stg	%r5,0($dst)
515	br	$ra
516.size	s390x_flip_endian32,.-s390x_flip_endian32
517___
518}
519
520################
521# void s390x_flip_endian64(unsigned char dst[64], const unsigned char src[64])
522{
523my ($dst,$src) = map("%r$_",(2..3));
524$code.=<<___;
525.globl	s390x_flip_endian64
526.type	s390x_flip_endian64,\@function
527.align	16
528s390x_flip_endian64:
529	stmg	%r6,%r9,6*$SIZE_T($sp)
530
531	lrvg	%r0,0($src)
532	lrvg	%r1,8($src)
533	lrvg	%r4,16($src)
534	lrvg	%r5,24($src)
535	lrvg	%r6,32($src)
536	lrvg	%r7,40($src)
537	lrvg	%r8,48($src)
538	lrvg	%r9,56($src)
539	stg	%r0,56($dst)
540	stg	%r1,48($dst)
541	stg	%r4,40($dst)
542	stg	%r5,32($dst)
543	stg	%r6,24($dst)
544	stg	%r7,16($dst)
545	stg	%r8,8($dst)
546	stg	%r9,0($dst)
547
548	lmg	%r6,%r9,6*$SIZE_T($sp)
549	br	$ra
550.size	s390x_flip_endian64,.-s390x_flip_endian64
551___
552}
553
554$code.=<<___;
555.section	.init
556	brasl	$ra,OPENSSL_cpuid_setup
557___
558
559$code =~ s/\`([^\`]*)\`/eval $1/gem;
560print $code;
561close STDOUT or die "error closing STDOUT: $!";	# force flush
562