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