#! /usr/bin/env perl

# Copyright 2009-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/.

# ====================================================================

#

# 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.

$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";

$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