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;