250 lines
5.3 KiB
Raku
250 lines
5.3 KiB
Raku
#! /usr/bin/env perl
|
|
# Copyright 2007-2020 The OpenSSL Project Authors. All Rights Reserved.
|
|
#
|
|
# Licensed under the OpenSSL license (the "License"). You may not use
|
|
# this file except in compliance with the License. You can obtain a copy
|
|
# in the file LICENSE in the source distribution or at
|
|
# https://www.openssl.org/source/license.html
|
|
|
|
|
|
# ====================================================================
|
|
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
|
|
# project. The module is, however, dual licensed under OpenSSL and
|
|
# CRYPTOGAMS licenses depending on where you obtain it. For further
|
|
# details see http://www.openssl.org/~appro/cryptogams/.
|
|
# ====================================================================
|
|
|
|
# SHA1 block procedure for s390x.
|
|
|
|
# April 2007.
|
|
#
|
|
# Performance is >30% better than gcc 3.3 generated code. But the real
|
|
# twist is that SHA1 hardware support is detected and utilized. In
|
|
# which case performance can reach further >4.5x for larger chunks.
|
|
|
|
# January 2009.
|
|
#
|
|
# Optimize Xupdate for amount of memory references and reschedule
|
|
# instructions to favour dual-issue z10 pipeline. On z10 hardware is
|
|
# "only" ~2.3x faster than software.
|
|
|
|
# November 2010.
|
|
#
|
|
# Adapt for -m31 build. If kernel supports what's called "highgprs"
|
|
# feature on Linux [see /proc/cpuinfo], it's possible to use 64-bit
|
|
# instructions and achieve "64-bit" performance even in 31-bit legacy
|
|
# application context. The feature is not specific to any particular
|
|
# processor, as long as it's "z-CPU". Latter implies that the code
|
|
# remains z/Architecture specific. On z990 it was measured to perform
|
|
# 23% better than code generated by gcc 4.3.
|
|
|
|
$kimdfunc=1; # magic function code for kimd instruction
|
|
|
|
$flavour = shift;
|
|
|
|
if ($flavour =~ /3[12]/) {
|
|
$SIZE_T=4;
|
|
$g="";
|
|
} else {
|
|
$SIZE_T=8;
|
|
$g="g";
|
|
}
|
|
|
|
while (($output=shift) && ($output!~/\w[\w\-]*\.\w+$/)) {}
|
|
open STDOUT,">$output";
|
|
|
|
$K_00_39="%r0"; $K=$K_00_39;
|
|
$K_40_79="%r1";
|
|
$ctx="%r2"; $prefetch="%r2";
|
|
$inp="%r3";
|
|
$len="%r4";
|
|
|
|
$A="%r5";
|
|
$B="%r6";
|
|
$C="%r7";
|
|
$D="%r8";
|
|
$E="%r9"; @V=($A,$B,$C,$D,$E);
|
|
$t0="%r10";
|
|
$t1="%r11";
|
|
@X=("%r12","%r13","%r14");
|
|
$sp="%r15";
|
|
|
|
$stdframe=16*$SIZE_T+4*8;
|
|
$frame=$stdframe+16*4;
|
|
|
|
sub Xupdate {
|
|
my $i=shift;
|
|
|
|
$code.=<<___ if ($i==15);
|
|
lg $prefetch,$stdframe($sp) ### Xupdate(16) warm-up
|
|
lr $X[0],$X[2]
|
|
___
|
|
return if ($i&1); # Xupdate is vectorized and executed every 2nd cycle
|
|
$code.=<<___ if ($i<16);
|
|
lg $X[0],`$i*4`($inp) ### Xload($i)
|
|
rllg $X[1],$X[0],32
|
|
___
|
|
$code.=<<___ if ($i>=16);
|
|
xgr $X[0],$prefetch ### Xupdate($i)
|
|
lg $prefetch,`$stdframe+4*(($i+2)%16)`($sp)
|
|
xg $X[0],`$stdframe+4*(($i+8)%16)`($sp)
|
|
xgr $X[0],$prefetch
|
|
rll $X[0],$X[0],1
|
|
rllg $X[1],$X[0],32
|
|
rll $X[1],$X[1],1
|
|
rllg $X[0],$X[1],32
|
|
lr $X[2],$X[1] # feedback
|
|
___
|
|
$code.=<<___ if ($i<=70);
|
|
stg $X[0],`$stdframe+4*($i%16)`($sp)
|
|
___
|
|
unshift(@X,pop(@X));
|
|
}
|
|
|
|
sub BODY_00_19 {
|
|
my ($i,$a,$b,$c,$d,$e)=@_;
|
|
my $xi=$X[1];
|
|
|
|
&Xupdate($i);
|
|
$code.=<<___;
|
|
alr $e,$K ### $i
|
|
rll $t1,$a,5
|
|
lr $t0,$d
|
|
xr $t0,$c
|
|
alr $e,$t1
|
|
nr $t0,$b
|
|
alr $e,$xi
|
|
xr $t0,$d
|
|
rll $b,$b,30
|
|
alr $e,$t0
|
|
___
|
|
}
|
|
|
|
sub BODY_20_39 {
|
|
my ($i,$a,$b,$c,$d,$e)=@_;
|
|
my $xi=$X[1];
|
|
|
|
&Xupdate($i);
|
|
$code.=<<___;
|
|
alr $e,$K ### $i
|
|
rll $t1,$a,5
|
|
lr $t0,$b
|
|
alr $e,$t1
|
|
xr $t0,$c
|
|
alr $e,$xi
|
|
xr $t0,$d
|
|
rll $b,$b,30
|
|
alr $e,$t0
|
|
___
|
|
}
|
|
|
|
sub BODY_40_59 {
|
|
my ($i,$a,$b,$c,$d,$e)=@_;
|
|
my $xi=$X[1];
|
|
|
|
&Xupdate($i);
|
|
$code.=<<___;
|
|
alr $e,$K ### $i
|
|
rll $t1,$a,5
|
|
lr $t0,$b
|
|
alr $e,$t1
|
|
or $t0,$c
|
|
lr $t1,$b
|
|
nr $t0,$d
|
|
nr $t1,$c
|
|
alr $e,$xi
|
|
or $t0,$t1
|
|
rll $b,$b,30
|
|
alr $e,$t0
|
|
___
|
|
}
|
|
|
|
$code.=<<___;
|
|
#include "s390x_arch.h"
|
|
|
|
.text
|
|
.align 64
|
|
.type Ktable,\@object
|
|
Ktable: .long 0x5a827999,0x6ed9eba1,0x8f1bbcdc,0xca62c1d6
|
|
.skip 48 #.long 0,0,0,0,0,0,0,0,0,0,0,0
|
|
.size Ktable,.-Ktable
|
|
.globl sha1_block_data_order
|
|
.type sha1_block_data_order,\@function
|
|
sha1_block_data_order:
|
|
___
|
|
$code.=<<___ if ($kimdfunc);
|
|
larl %r1,OPENSSL_s390xcap_P
|
|
lg %r0,S390X_KIMD(%r1) # check kimd capabilities
|
|
tmhh %r0,`0x8000>>$kimdfunc`
|
|
jz .Lsoftware
|
|
lghi %r0,$kimdfunc
|
|
lgr %r1,$ctx
|
|
lgr %r2,$inp
|
|
sllg %r3,$len,6
|
|
.long 0xb93e0002 # kimd %r0,%r2
|
|
brc 1,.-4 # pay attention to "partial completion"
|
|
br %r14
|
|
.align 16
|
|
.Lsoftware:
|
|
___
|
|
$code.=<<___;
|
|
lghi %r1,-$frame
|
|
st${g} $ctx,`2*$SIZE_T`($sp)
|
|
stm${g} %r6,%r15,`6*$SIZE_T`($sp)
|
|
lgr %r0,$sp
|
|
la $sp,0(%r1,$sp)
|
|
st${g} %r0,0($sp)
|
|
|
|
larl $t0,Ktable
|
|
llgf $A,0($ctx)
|
|
llgf $B,4($ctx)
|
|
llgf $C,8($ctx)
|
|
llgf $D,12($ctx)
|
|
llgf $E,16($ctx)
|
|
|
|
lg $K_00_39,0($t0)
|
|
lg $K_40_79,8($t0)
|
|
|
|
.Lloop:
|
|
rllg $K_00_39,$K_00_39,32
|
|
___
|
|
for ($i=0;$i<20;$i++) { &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
|
|
$code.=<<___;
|
|
rllg $K_00_39,$K_00_39,32
|
|
___
|
|
for (;$i<40;$i++) { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
|
|
$code.=<<___; $K=$K_40_79;
|
|
rllg $K_40_79,$K_40_79,32
|
|
___
|
|
for (;$i<60;$i++) { &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
|
|
$code.=<<___;
|
|
rllg $K_40_79,$K_40_79,32
|
|
___
|
|
for (;$i<80;$i++) { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
|
|
$code.=<<___;
|
|
|
|
l${g} $ctx,`$frame+2*$SIZE_T`($sp)
|
|
la $inp,64($inp)
|
|
al $A,0($ctx)
|
|
al $B,4($ctx)
|
|
al $C,8($ctx)
|
|
al $D,12($ctx)
|
|
al $E,16($ctx)
|
|
st $A,0($ctx)
|
|
st $B,4($ctx)
|
|
st $C,8($ctx)
|
|
st $D,12($ctx)
|
|
st $E,16($ctx)
|
|
brct${g} $len,.Lloop
|
|
|
|
lm${g} %r6,%r15,`$frame+6*$SIZE_T`($sp)
|
|
br %r14
|
|
.size sha1_block_data_order,.-sha1_block_data_order
|
|
.string "SHA1 block transform for s390x, CRYPTOGAMS by <appro\@openssl.org>"
|
|
___
|
|
|
|
$code =~ s/\`([^\`]*)\`/eval $1/gem;
|
|
|
|
print $code;
|
|
close STDOUT or die "error closing STDOUT: $!";
|