source: vbox/trunk/src/libs/openssl-3.0.1/crypto/rc4/asm/rc4-s390x.pl@ 94082

#! /usr/bin/env perl
# Copyright 2009-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (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 <[email protected]> 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/.
# ====================================================================
#
# February 2009
#
# Performance is 2x of gcc 3.4.6 on z10. Coding "secret" is to
# "cluster" Address Generation Interlocks, so that one pipeline stall
# resolves several dependencies.

# 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
# 50% better than code generated by gcc 4.3.

# $output is the last argument if it looks like a file (it has an extension)
# $flavour is the first argument if it doesn't look like a file
$output = $#ARGV >= 0 && $ARGV[$#ARGV] =~ m|\.\w+$| ? pop : undef;
$flavour = $#ARGV >= 0 && $ARGV[0] !~ m|\.| ? shift : undef;

if ($flavour =~ /3[12]/) {
        $SIZE_T=4;
        $g="";
} else {
        $SIZE_T=8;
        $g="g";
}

$output and open STDOUT,">$output";

$rp="%r14";
$sp="%r15";
$code=<<___;
.text

___

# void RC4(RC4_KEY *key,size_t len,const void *inp,void *out)
{
$acc="%r0";
$cnt="%r1";
$key="%r2";
$len="%r3";
$inp="%r4";
$out="%r5";

@XX=("%r6","%r7");
@TX=("%r8","%r9");
$YY="%r10";
$TY="%r11";

$code.=<<___;
.globl  RC4
.type   RC4,\@function
.align  64
RC4:
        stm${g} %r6,%r11,6*$SIZE_T($sp)
___
$code.=<<___ if ($flavour =~ /3[12]/);
        llgfr   $len,$len
___
$code.=<<___;
        llgc    $XX[0],0($key)
        llgc    $YY,1($key)
        la      $XX[0],1($XX[0])
        nill    $XX[0],0xff
        srlg    $cnt,$len,3
        ltgr    $cnt,$cnt
        llgc    $TX[0],2($XX[0],$key)
        jz      .Lshort
        j       .Loop8

.align  64
.Loop8:
___
for ($i=0;$i<8;$i++) {
$code.=<<___;
        la      $YY,0($YY,$TX[0])       # $i
        nill    $YY,255
        la      $XX[1],1($XX[0])
        nill    $XX[1],255
___
$code.=<<___ if ($i==1);
        llgc    $acc,2($TY,$key)
___
$code.=<<___ if ($i>1);
        sllg    $acc,$acc,8
        ic      $acc,2($TY,$key)
___
$code.=<<___;
        llgc    $TY,2($YY,$key)
        stc     $TX[0],2($YY,$key)
        llgc    $TX[1],2($XX[1],$key)
        stc     $TY,2($XX[0],$key)
        cr      $XX[1],$YY
        jne     .Lcmov$i
        la      $TX[1],0($TX[0])
.Lcmov$i:
        la      $TY,0($TY,$TX[0])
        nill    $TY,255
___
push(@TX,shift(@TX)); push(@XX,shift(@XX));     # "rotate" registers
}

$code.=<<___;
        lg      $TX[1],0($inp)
        sllg    $acc,$acc,8
        la      $inp,8($inp)
        ic      $acc,2($TY,$key)
        xgr     $acc,$TX[1]
        stg     $acc,0($out)
        la      $out,8($out)
        brctg   $cnt,.Loop8

.Lshort:
        lghi    $acc,7
        ngr     $len,$acc
        jz      .Lexit
        j       .Loop1

.align  16
.Loop1:
        la      $YY,0($YY,$TX[0])
        nill    $YY,255
        llgc    $TY,2($YY,$key)
        stc     $TX[0],2($YY,$key)
        stc     $TY,2($XX[0],$key)
        ar      $TY,$TX[0]
        ahi     $XX[0],1
        nill    $TY,255
        nill    $XX[0],255
        llgc    $acc,0($inp)
        la      $inp,1($inp)
        llgc    $TY,2($TY,$key)
        llgc    $TX[0],2($XX[0],$key)
        xr      $acc,$TY
        stc     $acc,0($out)
        la      $out,1($out)
        brct    $len,.Loop1

.Lexit:
        ahi     $XX[0],-1
        stc     $XX[0],0($key)
        stc     $YY,1($key)
        lm${g}  %r6,%r11,6*$SIZE_T($sp)
        br      $rp
.size   RC4,.-RC4
.string "RC4 for s390x, CRYPTOGAMS by <appro\@openssl.org>"

___
}

# void RC4_set_key(RC4_KEY *key,unsigned int len,const void *inp)
{
$cnt="%r0";
$idx="%r1";
$key="%r2";
$len="%r3";
$inp="%r4";
$acc="%r5";
$dat="%r6";
$ikey="%r7";
$iinp="%r8";

$code.=<<___;
.globl  RC4_set_key
.type   RC4_set_key,\@function
.align  64
RC4_set_key:
        stm${g} %r6,%r8,6*$SIZE_T($sp)
        lhi     $cnt,256
        la      $idx,0
        sth     $idx,0($key)
.align  4
.L1stloop:
        stc     $idx,2($idx,$key)
        la      $idx,1($idx)
        brct    $cnt,.L1stloop

        lghi    $ikey,-256
        lr      $cnt,$len
        la      $iinp,0
        la      $idx,0
.align  16
.L2ndloop:
        llgc    $acc,2+256($ikey,$key)
        llgc    $dat,0($iinp,$inp)
        la      $idx,0($idx,$acc)
        la      $ikey,1($ikey)
        la      $idx,0($idx,$dat)
        nill    $idx,255
        la      $iinp,1($iinp)
        tml     $ikey,255
        llgc    $dat,2($idx,$key)
        stc     $dat,2+256-1($ikey,$key)
        stc     $acc,2($idx,$key)
        jz      .Ldone
        brct    $cnt,.L2ndloop
        lr      $cnt,$len
        la      $iinp,0
        j       .L2ndloop
.Ldone:
        lm${g}  %r6,%r8,6*$SIZE_T($sp)
        br      $rp
.size   RC4_set_key,.-RC4_set_key

___
}

# const char *RC4_options()
$code.=<<___;
.globl  RC4_options
.type   RC4_options,\@function
.align  16
RC4_options:
        larl    %r2,.Loptions
        br      %r14
.size   RC4_options,.-RC4_options
.section        .rodata
.Loptions:
.align  8
.string "rc4(8x,char)"
___

print $code;
close STDOUT or die "error closing STDOUT: $!"; # force flush