5c36436d4542449ad07802d8cc9a5daffccc332a
[openssl.git] / crypto / sha / asm / sha1-s390x.pl
1 #!/usr/bin/env perl
2
3 # ====================================================================
4 # Written by Andy Polyakov <appro@fy.chalmers.se> for the OpenSSL
5 # project. The module is, however, dual licensed under OpenSSL and
6 # CRYPTOGAMS licenses depending on where you obtain it. For further
7 # details see http://www.openssl.org/~appro/cryptogams/.
8 # ====================================================================
9
10 # SHA1 block procedure for s390x.
11
12 # April 2007.
13 #
14 # Performance is >30% better than gcc 3.3 generated code. But the real
15 # twist is that SHA1 hardware support is detected and utilized. In
16 # which case performance can reach further >4.5x for larger chunks.
17
18 $kimdfunc=1;    # magic function code for kimd instruction
19
20 $output=shift;
21 open STDOUT,">$output";
22
23 $t0="%r0";
24 $t1="%r1";
25 $ctx="%r2";
26 $inp="%r3";
27 $len="%r4";
28
29 $A="%r5";
30 $B="%r6";
31 $C="%r7";
32 $D="%r8";
33 $E="%r9";       @V=($A,$B,$C,$D,$E);
34 $K_00_19="%r10";
35 $K_20_39="%r11";
36 $K_40_59="%r12";
37 $K_60_79="%r13";
38 $Xi="%r14";
39 $sp="%r15";
40
41 $frame=160+16*4;
42
43 sub BODY_00_15 {
44 my ($i,$a,$b,$c,$d,$e)=@_;
45 my $xi=($i&1)?$Xi:$t1;
46
47 $code.=<<___ if ($i<16 && !($i&1));
48         lg      $Xi,`$i*4`($inp)
49 ___
50 $code.=<<___;
51         alr     $e,$K_00_19     ### $i
52         rll     $t0,$a,5
53         alr     $e,$t0
54         lr      $t0,$d
55         xr      $t0,$c
56         nr      $t0,$b
57         xr      $t0,$d
58         alr     $e,$t0
59         rll     $b,$b,30
60 ___
61 $code.=<<___ if ($i<16 && !($i&1));
62         srlg    $xi,$Xi,32
63         stg     $Xi,`160+$i*4`($sp)
64 ___
65 $code.=<<___;
66         alr     $e,$xi
67 ___
68 }
69
70 sub Xupdate {
71 my $i=shift;
72
73 return if ($i&1);       # Xupdate is vectorized and executed every 2nd cycle
74 $code.=<<___;
75         lg      $Xi,`160+4*($i%16)`($sp)        ### Xupdate($i)
76         xg      $Xi,`160+4*(($i+2)%16)`($sp)
77         xg      $Xi,`160+4*(($i+8)%16)`($sp)
78 ___
79 if ((($i+13)%16)==15) {
80 $code.=<<___;
81         llgf    $t0,`160+4*15`($sp)
82         x       $Xi,`160+0`($sp)
83         sllg    $t0,$t0,32
84         xgr     $Xi,$t0
85 ___
86 } else {
87 $code.=<<___;
88         xg      $Xi,`160+4*(($i+13)%16)`($sp)
89 ___
90 }
91 $code.=<<___;
92         rll     $Xi,$Xi,1
93         rllg    $t1,$Xi,32
94         rll     $t1,$t1,1
95         rllg    $Xi,$t1,32
96         stg     $Xi,`160+4*($i%16)`($sp)
97 ___
98 }
99
100 sub BODY_16_19 {
101         &Xupdate(@_[0]);
102         &BODY_00_15(@_);
103 }
104
105 sub BODY_20_39 {
106 my ($i,$a,$b,$c,$d,$e)=@_;
107 my $xi=($i&1)?$Xi:$t1;
108 my $K_XX_XX=($i<40)?$K_20_39:$K_60_79;
109
110         &Xupdate($i);
111 $code.=<<___;
112         alr     $e,$K_XX_XX     ### $i
113         rll     $t0,$a,5
114         alr     $e,$t0
115         lr      $t0,$b
116         xr      $t0,$c
117         xr      $t0,$d
118         alr     $e,$t0
119         rll     $b,$b,30
120         alr     $e,$xi
121 ___
122 }
123
124 sub BODY_40_59 {
125 my ($i,$a,$b,$c,$d,$e)=@_;
126 my $xi=($i&1)?$Xi:$t1;
127
128         &Xupdate($i);
129 $code.=<<___;
130         alr     $e,$K_40_59     ### $i
131         rll     $t0,$a,5
132         alr     $e,$t0
133         lr      $t0,$b
134         or      $t0,$c
135         nr      $t0,$d
136         alr     $e,$xi
137         lr      $t1,$b
138         nr      $t1,$c
139         or      $t0,$t1
140         alr     $e,$t0
141         rll     $b,$b,30
142 ___
143 }
144
145 $code.=<<___;
146 .text
147 .globl  sha1_block_data_order
148 .type   sha1_block_data_order,\@function
149 sha1_block_data_order:
150 ___
151 $code.=<<___ if ($kimdfunc);
152         lghi    %r0,0
153         la      %r1,16($sp)
154         .long   0xb93e0002      # kimd %r0,%r2
155         lg      %r0,16($sp)
156         tmhh    %r0,`0x8000>>$kimdfunc`
157         jz      .Lsoftware
158         lghi    %r0,$kimdfunc
159         lgr     %r1,$ctx
160         lgr     %r2,$inp
161         sllg    %r3,$len,6
162         .long   0xb93e0002      # kimd %r0,%r2
163         brc     1,.-4           # pay attention to "partial completion"
164         br      %r14
165 .Lsoftware:
166 ___
167 $code.=<<___;
168         stmg    %r6,%r15,48($sp)
169         lgr     %r0,$sp
170         aghi    $sp,-$frame
171         stg     %r0,0($sp)
172
173         sllg    $len,$len,6
174         la      $len,0($inp,$len)
175
176         llgf    $A,0($ctx)
177         llgf    $B,4($ctx)
178         llgf    $C,8($ctx)
179         llgf    $D,12($ctx)
180         llgf    $E,16($ctx)
181
182         llilh   $K_00_19,0x5a82
183         oill    $K_00_19,0x7999
184         llilh   $K_20_39,0x6ed9
185         oill    $K_20_39,0xeba1
186         llilh   $K_40_59,0x8f1b
187         oill    $K_40_59,0xbcdc
188         llilh   $K_60_79,0xca62
189         oill    $K_60_79,0xc1d6
190 .Lloop:
191 ___
192 for ($i=0;$i<16;$i++)   { &BODY_00_15($i,@V); unshift(@V,pop(@V)); }
193 for (;$i<20;$i++)       { &BODY_16_19($i,@V); unshift(@V,pop(@V)); }
194 for (;$i<40;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
195 for (;$i<60;$i++)       { &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
196 for (;$i<80;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
197 $code.=<<___;
198
199         al      $A,0($ctx)
200         al      $B,4($ctx)
201         al      $C,8($ctx)
202         al      $D,12($ctx)
203         al      $E,16($ctx)
204         st      $A,0($ctx)
205         st      $B,4($ctx)
206         st      $C,8($ctx)
207         st      $D,12($ctx)
208         st      $E,16($ctx)
209         la      $inp,64($inp)
210         clgr    $inp,$len
211         jne     .Lloop
212
213         lmg     %r6,%r15,`$frame+48`($sp)
214         br      %r14
215 .size   sha1_block_data_order,.-sha1_block_data_order
216 .string "SHA1 block transform for s390x, CRYPTOGAMS by <appro\@openssl.org>"
217 ___
218
219 $code =~ s/\`([^\`]*)\`/eval $1/gem;
220
221 print $code;
222 close STDOUT;