sha1-s390x.pl: lingering comment update.
[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 # January 2009.
19 #
20 # Optimize Xupdate for amount of memory references and reschedule
21 # instructions to favour dual-issue z10 pipeline. On z10 hardware is
22 # "only" ~2.3x faster than software.
23
24 # November 2010.
25 #
26 # Adapt for -m31 build. If kernel supports what's called "highgprs"
27 # feature on Linux [see /proc/cpuinfo], it's possible to use 64-bit
28 # instructions and achieve "64-bit" performance even in 31-bit legacy
29 # application context. The feature is not specific to any particular
30 # processor, as long as it's "z-CPU". Latter implies that the code
31 # remains z/Architecture specific. On z990 it was measured to peform
32 # 23% better than code generated by gcc 4.3.
33
34 $kimdfunc=1;    # magic function code for kimd instruction
35
36 $flavour = shift;
37
38 if ($flavour =~ /3[12]/) {
39         $SIZE_T=4;
40         $g="";
41 } else {
42         $SIZE_T=8;
43         $g="g";
44 }
45
46 while (($output=shift) && ($output!~/^\w[\w\-]*\.\w+$/)) {}
47 open STDOUT,">$output";
48
49 $K_00_39="%r0"; $K=$K_00_39;
50 $K_40_79="%r1";
51 $ctx="%r2";     $prefetch="%r2";
52 $inp="%r3";
53 $len="%r4";
54
55 $A="%r5";
56 $B="%r6";
57 $C="%r7";
58 $D="%r8";
59 $E="%r9";       @V=($A,$B,$C,$D,$E);
60 $t0="%r10";
61 $t1="%r11";
62 @X=("%r12","%r13","%r14");
63 $sp="%r15";
64
65 $stdframe=16*$SIZE_T+4*8;
66 $frame=$stdframe+16*4;
67
68 sub Xupdate {
69 my $i=shift;
70
71 $code.=<<___ if ($i==15);
72         lg      $prefetch,$stdframe($sp)        ### Xupdate(16) warm-up
73         lr      $X[0],$X[2]
74 ___
75 return if ($i&1);       # Xupdate is vectorized and executed every 2nd cycle
76 $code.=<<___ if ($i<16);
77         lg      $X[0],`$i*4`($inp)      ### Xload($i)
78         rllg    $X[1],$X[0],32
79 ___
80 $code.=<<___ if ($i>=16);
81         xgr     $X[0],$prefetch         ### Xupdate($i)
82         lg      $prefetch,`$stdframe+4*(($i+2)%16)`($sp)
83         xg      $X[0],`$stdframe+4*(($i+8)%16)`($sp)
84         xgr     $X[0],$prefetch
85         rll     $X[0],$X[0],1
86         rllg    $X[1],$X[0],32
87         rll     $X[1],$X[1],1
88         rllg    $X[0],$X[1],32
89         lr      $X[2],$X[1]             # feedback
90 ___
91 $code.=<<___ if ($i<=70);
92         stg     $X[0],`$stdframe+4*($i%16)`($sp)
93 ___
94 unshift(@X,pop(@X));
95 }
96
97 sub BODY_00_19 {
98 my ($i,$a,$b,$c,$d,$e)=@_;
99 my $xi=$X[1];
100
101         &Xupdate($i);
102 $code.=<<___;
103         alr     $e,$K           ### $i
104         rll     $t1,$a,5
105         lr      $t0,$d
106         xr      $t0,$c
107         alr     $e,$t1
108         nr      $t0,$b
109         alr     $e,$xi
110         xr      $t0,$d
111         rll     $b,$b,30
112         alr     $e,$t0
113 ___
114 }
115
116 sub BODY_20_39 {
117 my ($i,$a,$b,$c,$d,$e)=@_;
118 my $xi=$X[1];
119
120         &Xupdate($i);
121 $code.=<<___;
122         alr     $e,$K           ### $i
123         rll     $t1,$a,5
124         lr      $t0,$b
125         alr     $e,$t1
126         xr      $t0,$c
127         alr     $e,$xi
128         xr      $t0,$d
129         rll     $b,$b,30
130         alr     $e,$t0
131 ___
132 }
133
134 sub BODY_40_59 {
135 my ($i,$a,$b,$c,$d,$e)=@_;
136 my $xi=$X[1];
137
138         &Xupdate($i);
139 $code.=<<___;
140         alr     $e,$K           ### $i
141         rll     $t1,$a,5
142         lr      $t0,$b
143         alr     $e,$t1
144         or      $t0,$c
145         lr      $t1,$b
146         nr      $t0,$d
147         nr      $t1,$c
148         alr     $e,$xi
149         or      $t0,$t1
150         rll     $b,$b,30
151         alr     $e,$t0
152 ___
153 }
154
155 $code.=<<___;
156 .text
157 .align  64
158 .type   Ktable,\@object
159 Ktable: .long   0x5a827999,0x6ed9eba1,0x8f1bbcdc,0xca62c1d6
160         .skip   48      #.long  0,0,0,0,0,0,0,0,0,0,0,0
161 .size   Ktable,.-Ktable
162 .globl  sha1_block_data_order
163 .type   sha1_block_data_order,\@function
164 sha1_block_data_order:
165 ___
166 $code.=<<___ if ($kimdfunc);
167         larl    %r1,OPENSSL_s390xcap_P
168         lg      %r0,0(%r1)
169         tmhl    %r0,0x4000      # check for message-security assist
170         jz      .Lsoftware
171         lghi    %r0,0
172         la      %r1,`2*$SIZE_T`($sp)
173         .long   0xb93e0002      # kimd %r0,%r2
174         lg      %r0,`2*$SIZE_T`($sp)
175         tmhh    %r0,`0x8000>>$kimdfunc`
176         jz      .Lsoftware
177         lghi    %r0,$kimdfunc
178         lgr     %r1,$ctx
179         lgr     %r2,$inp
180         sllg    %r3,$len,6
181         .long   0xb93e0002      # kimd %r0,%r2
182         brc     1,.-4           # pay attention to "partial completion"
183         br      %r14
184 .align  16
185 .Lsoftware:
186 ___
187 $code.=<<___;
188         lghi    %r1,-$frame
189         st${g}  $ctx,`2*$SIZE_T`($sp)
190         stm${g} %r6,%r15,`6*$SIZE_T`($sp)
191         lgr     %r0,$sp
192         la      $sp,0(%r1,$sp)
193         st${g}  %r0,0($sp)
194
195         larl    $t0,Ktable
196         llgf    $A,0($ctx)
197         llgf    $B,4($ctx)
198         llgf    $C,8($ctx)
199         llgf    $D,12($ctx)
200         llgf    $E,16($ctx)
201
202         lg      $K_00_39,0($t0)
203         lg      $K_40_79,8($t0)
204
205 .Lloop:
206         rllg    $K_00_39,$K_00_39,32
207 ___
208 for ($i=0;$i<20;$i++)   { &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
209 $code.=<<___;
210         rllg    $K_00_39,$K_00_39,32
211 ___
212 for (;$i<40;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
213 $code.=<<___;   $K=$K_40_79;
214         rllg    $K_40_79,$K_40_79,32
215 ___
216 for (;$i<60;$i++)       { &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
217 $code.=<<___;
218         rllg    $K_40_79,$K_40_79,32
219 ___
220 for (;$i<80;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
221 $code.=<<___;
222
223         l${g}   $ctx,`$frame+2*$SIZE_T`($sp)
224         la      $inp,64($inp)
225         al      $A,0($ctx)
226         al      $B,4($ctx)
227         al      $C,8($ctx)
228         al      $D,12($ctx)
229         al      $E,16($ctx)
230         st      $A,0($ctx)
231         st      $B,4($ctx)
232         st      $C,8($ctx)
233         st      $D,12($ctx)
234         st      $E,16($ctx)
235         brct${g} $len,.Lloop
236
237         lm${g}  %r6,%r15,`$frame+6*$SIZE_T`($sp)
238         br      %r14
239 .size   sha1_block_data_order,.-sha1_block_data_order
240 .string "SHA1 block transform for s390x, CRYPTOGAMS by <appro\@openssl.org>"
241 .comm   OPENSSL_s390xcap_P,16,8
242 ___
243
244 $code =~ s/\`([^\`]*)\`/eval $1/gem;
245
246 print $code;
247 close STDOUT;