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