#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# Keccak-1600 for AVX-512F.
#
# July 2017.
#
# Below code is KECCAK_1X_ALT implementation (see sha/keccak1600.c).
# Pretty straightforward, the only "magic" is data layout in registers.
# It's impossible to have one that is optimal for every step, hence
# it's changing as algorithm progresses. Data is saved in linear order,
# but in-register order morphs between rounds. Even rounds take in
# linear layout, and odd rounds - transposed, or "verticaly-shaped"...
#
########################################################################
# Numbers are cycles per processed byte out of large message.
#
#			r=1088(*)
#
# Knights Landing	7.6
# Skylake-X		5.7
#
# (*)	Corresponds to SHA3-256.

########################################################################
# Below code is combination of two ideas. One is taken from Keccak Code
# Package, hereafter KCP, and another one from initial version of this
# module. What is common is observation that Pi's input and output are
# "mostly transposed", i.e. if input is aligned by x coordinate, then
# output is [mostly] aligned by y. Both versions, KCP and predecessor,
# were trying to use one of them from round to round, which resulted in
# some kind of transposition in each round. This version still does
# transpose data, but only every second round. Another essential factor
# is that KCP transposition has to be performed with instructions that
# turned to be rather expensive on Knights Landing, both latency- and
# throughput-wise. Not to mention that some of them have to depend on
# each other. On the other hand initial version of this module was
# relying heavily on blend instructions. There were lots of them,
# resulting in higher instruction count, yet it performed better on
# Knights Landing, because processor can execute pair of them each
# cycle and they have minimal latency. This module is an attempt to
# bring best parts together:-)
#
# Coordinates below correspond to those in sha/keccak1600.c. Input
# layout is straight linear:
#
# [0][4] [0][3] [0][2] [0][1] [0][0]
# [1][4] [1][3] [1][2] [1][1] [1][0]
# [2][4] [2][3] [2][2] [2][1] [2][0]
# [3][4] [3][3] [3][2] [3][1] [3][0]
# [4][4] [4][3] [4][2] [4][1] [4][0]
#
# It's perfect for Theta, while Pi is reduced to intra-register
# permutations which yield layout perfect for Chi:
#
# [4][0] [3][0] [2][0] [1][0] [0][0]
# [4][1] [3][1] [2][1] [1][1] [0][1]
# [4][2] [3][2] [2][2] [1][2] [0][2]
# [4][3] [3][3] [2][3] [1][3] [0][3]
# [4][4] [3][4] [2][4] [1][4] [0][4]
#
# Now instead of performing full transposition and feeding it to next
# identical round, we perform kind of diagonal transposition to layout
# from initial version of this module, and make it suitable for Theta:
#
# [4][4] [3][3] [2][2] [1][1] [0][0]>4.3.2.1.0>[4][4] [3][3] [2][2] [1][1] [0][0]
# [4][0] [3][4] [2][3] [1][2] [0][1]>3.2.1.0.4>[3][4] [2][3] [1][2] [0][1] [4][0]
# [4][1] [3][0] [2][4] [1][3] [0][2]>2.1.0.4.3>[2][4] [1][3] [0][2] [4][1] [3][0]
# [4][2] [3][1] [2][0] [1][4] [0][3]>1.0.4.3.2>[1][4] [0][3] [4][2] [3][1] [2][0]
# [4][3] [3][2] [2][1] [1][0] [0][4]>0.4.3.2.1>[0][4] [4][3] [3][2] [2][1] [1][0]
#
# Now intra-register permutations yield initial [almost] straight
# linear layout:
#
# [4][4] [3][3] [2][2] [1][1] [0][0]
##[0][4] [0][3] [0][2] [0][1] [0][0]
# [3][4] [2][3] [1][2] [0][1] [4][0]
##[2][3] [2][2] [2][1] [2][0] [2][4]
# [2][4] [1][3] [0][2] [4][1] [3][0]
##[4][2] [4][1] [4][0] [4][4] [4][3]
# [1][4] [0][3] [4][2] [3][1] [2][0]
##[1][1] [1][0] [1][4] [1][3] [1][2]
# [0][4] [4][3] [3][2] [2][1] [1][0]
##[3][0] [3][4] [3][3] [3][2] [3][1]
#
# This means that odd round Chi is performed in less suitable layout,
# with a number of additional permutations. But overall it turned to be
# a win. Permutations are fastest possible on Knights Landing and they
# are laid down to be independent of each other. In the essence I traded
# 20 blend instructions for 3 permutations. The result is 13% faster
# than KCP on Skylake-X, and >40% on Knights Landing.
#
# As implied, data is loaded in straight linear order. Digits in
# variables' names represent coordinates of right-most element of
# loaded data chunk:

my ($A00,	# [0][4] [0][3] [0][2] [0][1] [0][0]
    $A10,	# [1][4] [1][3] [1][2] [1][1] [1][0]
    $A20,	# [2][4] [2][3] [2][2] [2][1] [2][0]
    $A30,	# [3][4] [3][3] [3][2] [3][1] [3][0]
    $A40) =	# [4][4] [4][3] [4][2] [4][1] [4][0]
    map("%zmm$_",(0..4));

# We also need to map the magic order into offsets within structure:

my @A_jagged = ([0,0], [0,1], [0,2], [0,3], [0,4],
		[1,0], [1,1], [1,2], [1,3], [1,4],
		[2,0], [2,1], [2,2], [2,3], [2,4],
		[3,0], [3,1], [3,2], [3,3], [3,4],
		[4,0], [4,1], [4,2], [4,3], [4,4]);
   @A_jagged = map(8*($$_[0]*8+$$_[1]), @A_jagged);	# ... and now linear

my @T        = map("%zmm$_",(5..12));
my @Theta    = map("%zmm$_",(33,13..16));	# invalid @Theta[0] is not typo
my @Pi0      = map("%zmm$_",(17..21));
my @Rhotate0 = map("%zmm$_",(22..26));
my @Rhotate1 = map("%zmm$_",(27..31));

my ($C00,$D00) = @T[0..1];
my ($k00001,$k00010,$k00100,$k01000,$k10000,$k11111) = map("%k$_",(1..6));

$code.=<<___;
.text

.type	__KeccakF1600,\@function
.align	32
__KeccakF1600:
	lea		iotas(%rip),%r10
	mov		\$12,%eax
	jmp		.Loop_avx512

.align	32
.Loop_avx512:
	######################################### Theta, even round
	vmovdqa64	$A00,@T[0]		# put aside original A00
	vpternlogq	\$0x96,$A20,$A10,$A00	# and use it as "C00"
	vpternlogq	\$0x96,$A40,$A30,$A00

	vprolq		\$1,$A00,$D00
	vpermq		$A00,@Theta[1],$A00
	vpermq		$D00,@Theta[4],$D00

	vpternlogq	\$0x96,$A00,$D00,@T[0]	# T[0] is original A00
	vpternlogq	\$0x96,$A00,$D00,$A10
	vpternlogq	\$0x96,$A00,$D00,$A20
	vpternlogq	\$0x96,$A00,$D00,$A30
	vpternlogq	\$0x96,$A00,$D00,$A40

	######################################### Rho
	vprolvq		@Rhotate0[0],@T[0],$A00	# T[0] is original A00
	vprolvq		@Rhotate0[1],$A10,$A10
	vprolvq		@Rhotate0[2],$A20,$A20
	vprolvq		@Rhotate0[3],$A30,$A30
	vprolvq		@Rhotate0[4],$A40,$A40

	######################################### Pi
	vpermq		$A00,@Pi0[0],$A00
	vpermq		$A10,@Pi0[1],$A10
	vpermq		$A20,@Pi0[2],$A20
	vpermq		$A30,@Pi0[3],$A30
	vpermq		$A40,@Pi0[4],$A40

	######################################### Chi
	vmovdqa64	$A00,@T[0]
	vmovdqa64	$A10,@T[1]
	vpternlogq	\$0xD2,$A20,$A10,$A00
	vpternlogq	\$0xD2,$A30,$A20,$A10
	vpternlogq	\$0xD2,$A40,$A30,$A20
	vpternlogq	\$0xD2,@T[0],$A40,$A30
	vpternlogq	\$0xD2,@T[1],@T[0],$A40

	######################################### Iota
	vpxorq		(%r10),$A00,${A00}{$k00001}
	lea		16(%r10),%r10

	######################################### Harmonize rounds
	vpblendmq	$A20,$A10,@{T[1]}{$k00010}
	vpblendmq	$A30,$A20,@{T[2]}{$k00010}
	vpblendmq	$A40,$A30,@{T[3]}{$k00010}
	 vpblendmq	$A10,$A00,@{T[0]}{$k00010}
	vpblendmq	$A00,$A40,@{T[4]}{$k00010}

	vpblendmq	$A30,@T[1],@{T[1]}{$k00100}
	vpblendmq	$A40,@T[2],@{T[2]}{$k00100}
	 vpblendmq	$A20,@T[0],@{T[0]}{$k00100}
	vpblendmq	$A00,@T[3],@{T[3]}{$k00100}
	vpblendmq	$A10,@T[4],@{T[4]}{$k00100}

	vpblendmq	$A40,@T[1],@{T[1]}{$k01000}
	 vpblendmq	$A30,@T[0],@{T[0]}{$k01000}
	vpblendmq	$A00,@T[2],@{T[2]}{$k01000}
	vpblendmq	$A10,@T[3],@{T[3]}{$k01000}
	vpblendmq	$A20,@T[4],@{T[4]}{$k01000}

	vpblendmq	$A40,@T[0],@{T[0]}{$k10000}
	vpblendmq	$A00,@T[1],@{T[1]}{$k10000}
	vpblendmq	$A10,@T[2],@{T[2]}{$k10000}
	vpblendmq	$A20,@T[3],@{T[3]}{$k10000}
	vpblendmq	$A30,@T[4],@{T[4]}{$k10000}

	#vpermq		@T[0],@Theta[0],$A00	# doesn't actually change order
	vpermq		@T[1],@Theta[1],$A10
	vpermq		@T[2],@Theta[2],$A20
	vpermq		@T[3],@Theta[3],$A30
	vpermq		@T[4],@Theta[4],$A40

	######################################### Theta, odd round
	vmovdqa64	$T[0],$A00		# real A00
	vpternlogq	\$0x96,$A20,$A10,$C00	# C00 is @T[0]'s alias
	vpternlogq	\$0x96,$A40,$A30,$C00

	vprolq		\$1,$C00,$D00
	vpermq		$C00,@Theta[1],$C00
	vpermq		$D00,@Theta[4],$D00

	vpternlogq	\$0x96,$C00,$D00,$A00
	vpternlogq	\$0x96,$C00,$D00,$A30
	vpternlogq	\$0x96,$C00,$D00,$A10
	vpternlogq	\$0x96,$C00,$D00,$A40
	vpternlogq	\$0x96,$C00,$D00,$A20

	######################################### Rho
	vprolvq		@Rhotate1[0],$A00,$A00
	vprolvq		@Rhotate1[3],$A30,@T[1]
	vprolvq		@Rhotate1[1],$A10,@T[2]
	vprolvq		@Rhotate1[4],$A40,@T[3]
	vprolvq		@Rhotate1[2],$A20,@T[4]

	 vpermq		$A00,@Theta[4],@T[5]
	 vpermq		$A00,@Theta[3],@T[6]

	######################################### Iota
	vpxorq		-8(%r10),$A00,${A00}{$k00001}

	######################################### Pi
	vpermq		@T[1],@Theta[2],$A10
	vpermq		@T[2],@Theta[4],$A20
	vpermq		@T[3],@Theta[1],$A30
	vpermq		@T[4],@Theta[3],$A40

	######################################### Chi
	vpternlogq	\$0xD2,@T[6],@T[5],$A00

	vpermq		@T[1],@Theta[1],@T[7]
	#vpermq		@T[1],@Theta[0],@T[1]
	vpternlogq	\$0xD2,@T[1],@T[7],$A10

	vpermq		@T[2],@Theta[3],@T[0]
	vpermq		@T[2],@Theta[2],@T[2]
	vpternlogq	\$0xD2,@T[2],@T[0],$A20

	#vpermq		@T[3],@Theta[0],@T[3]
	vpermq		@T[3],@Theta[4],@T[1]
	vpternlogq	\$0xD2,@T[1],@T[3],$A30

	vpermq		@T[4],@Theta[2],@T[0]
	vpermq		@T[4],@Theta[1],@T[4]
	vpternlogq	\$0xD2,@T[4],@T[0],$A40

	dec		%eax
	jnz		.Loop_avx512

	ret
.size	__KeccakF1600,.-__KeccakF1600
___

my ($A_flat,$inp,$len,$bsz) = ("%rdi","%rsi","%rdx","%rcx");
my  $out = $inp;	# in squeeze

$code.=<<___;
.globl	SHA3_absorb
.type	SHA3_absorb,\@function
.align	32
SHA3_absorb:
	mov	%rsp,%r11

	lea	-320(%rsp),%rsp
	and	\$-64,%rsp

	lea	96($A_flat),$A_flat
	lea	96($inp),$inp
	lea	128(%rsp),%r9

	lea		theta_perm(%rip),%r8

	kxnorw		$k11111,$k11111,$k11111
	kshiftrw	\$15,$k11111,$k00001
	kshiftrw	\$11,$k11111,$k11111
	kshiftlw	\$1,$k00001,$k00010
	kshiftlw	\$2,$k00001,$k00100
	kshiftlw	\$3,$k00001,$k01000
	kshiftlw	\$4,$k00001,$k10000

	#vmovdqa64	64*0(%r8),@Theta[0]
	vmovdqa64	64*1(%r8),@Theta[1]
	vmovdqa64	64*2(%r8),@Theta[2]
	vmovdqa64	64*3(%r8),@Theta[3]
	vmovdqa64	64*4(%r8),@Theta[4]

	vmovdqa64	64*5(%r8),@Rhotate1[0]
	vmovdqa64	64*6(%r8),@Rhotate1[1]
	vmovdqa64	64*7(%r8),@Rhotate1[2]
	vmovdqa64	64*8(%r8),@Rhotate1[3]
	vmovdqa64	64*9(%r8),@Rhotate1[4]

	vmovdqa64	64*10(%r8),@Rhotate0[0]
	vmovdqa64	64*11(%r8),@Rhotate0[1]
	vmovdqa64	64*12(%r8),@Rhotate0[2]
	vmovdqa64	64*13(%r8),@Rhotate0[3]
	vmovdqa64	64*14(%r8),@Rhotate0[4]

	vmovdqa64	64*15(%r8),@Pi0[0]
	vmovdqa64	64*16(%r8),@Pi0[1]
	vmovdqa64	64*17(%r8),@Pi0[2]
	vmovdqa64	64*18(%r8),@Pi0[3]
	vmovdqa64	64*19(%r8),@Pi0[4]

	vmovdqu64	40*0-96($A_flat),${A00}{$k11111}{z}
	vpxorq		@T[0],@T[0],@T[0]
	vmovdqu64	40*1-96($A_flat),${A10}{$k11111}{z}
	vmovdqu64	40*2-96($A_flat),${A20}{$k11111}{z}
	vmovdqu64	40*3-96($A_flat),${A30}{$k11111}{z}
	vmovdqu64	40*4-96($A_flat),${A40}{$k11111}{z}

	vmovdqa64	@T[0],0*64-128(%r9)	# zero transfer area on stack
	vmovdqa64	@T[0],1*64-128(%r9)
	vmovdqa64	@T[0],2*64-128(%r9)
	vmovdqa64	@T[0],3*64-128(%r9)
	vmovdqa64	@T[0],4*64-128(%r9)
	jmp		.Loop_absorb_avx512

.align	32
.Loop_absorb_avx512:
	mov		$bsz,%rax
	sub		$bsz,$len
	jc		.Ldone_absorb_avx512

	shr		\$3,%eax
___
for(my $i=0; $i<25; $i++) {
$code.=<<___
	mov	8*$i-96($inp),%r8
	mov	%r8,$A_jagged[$i]-128(%r9)
	dec	%eax
	jz	.Labsorved_avx512
___
}
$code.=<<___;
.Labsorved_avx512:
	lea	($inp,$bsz),$inp

	vpxorq	64*0-128(%r9),$A00,$A00
	vpxorq	64*1-128(%r9),$A10,$A10
	vpxorq	64*2-128(%r9),$A20,$A20
	vpxorq	64*3-128(%r9),$A30,$A30
	vpxorq	64*4-128(%r9),$A40,$A40

	call	__KeccakF1600

	jmp	.Loop_absorb_avx512

.align	32
.Ldone_absorb_avx512:
	vmovdqu64	$A00,40*0-96($A_flat){$k11111}
	vmovdqu64	$A10,40*1-96($A_flat){$k11111}
	vmovdqu64	$A20,40*2-96($A_flat){$k11111}
	vmovdqu64	$A30,40*3-96($A_flat){$k11111}
	vmovdqu64	$A40,40*4-96($A_flat){$k11111}

	vzeroupper

	lea	(%r11),%rsp
	lea	($len,$bsz),%rax		# return value
	ret
.size	SHA3_absorb,.-SHA3_absorb

.globl	SHA3_squeeze
.type	SHA3_squeeze,\@function
.align	32
SHA3_squeeze:
	mov	%rsp,%r11

	lea	96($A_flat),$A_flat
	cmp	$bsz,$len
	jbe	.Lno_output_extension_avx512

	lea		theta_perm(%rip),%r8

	kxnorw		$k11111,$k11111,$k11111
	kshiftrw	\$15,$k11111,$k00001
	kshiftrw	\$11,$k11111,$k11111
	kshiftlw	\$1,$k00001,$k00010
	kshiftlw	\$2,$k00001,$k00100
	kshiftlw	\$3,$k00001,$k01000
	kshiftlw	\$4,$k00001,$k10000

	#vmovdqa64	64*0(%r8),@Theta[0]
	vmovdqa64	64*1(%r8),@Theta[1]
	vmovdqa64	64*2(%r8),@Theta[2]
	vmovdqa64	64*3(%r8),@Theta[3]
	vmovdqa64	64*4(%r8),@Theta[4]

	vmovdqa64	64*5(%r8),@Rhotate1[0]
	vmovdqa64	64*6(%r8),@Rhotate1[1]
	vmovdqa64	64*7(%r8),@Rhotate1[2]
	vmovdqa64	64*8(%r8),@Rhotate1[3]
	vmovdqa64	64*9(%r8),@Rhotate1[4]

	vmovdqa64	64*10(%r8),@Rhotate0[0]
	vmovdqa64	64*11(%r8),@Rhotate0[1]
	vmovdqa64	64*12(%r8),@Rhotate0[2]
	vmovdqa64	64*13(%r8),@Rhotate0[3]
	vmovdqa64	64*14(%r8),@Rhotate0[4]

	vmovdqa64	64*15(%r8),@Pi0[0]
	vmovdqa64	64*16(%r8),@Pi0[1]
	vmovdqa64	64*17(%r8),@Pi0[2]
	vmovdqa64	64*18(%r8),@Pi0[3]
	vmovdqa64	64*19(%r8),@Pi0[4]

	vmovdqu64	40*0-96($A_flat),${A00}{$k11111}{z}
	vmovdqu64	40*1-96($A_flat),${A10}{$k11111}{z}
	vmovdqu64	40*2-96($A_flat),${A20}{$k11111}{z}
	vmovdqu64	40*3-96($A_flat),${A30}{$k11111}{z}
	vmovdqu64	40*4-96($A_flat),${A40}{$k11111}{z}

.Lno_output_extension_avx512:
	shr	\$3,$bsz
	lea	-96($A_flat),%r9
	mov	$bsz,%rax
	jmp	.Loop_squeeze_avx512

.align	32
.Loop_squeeze_avx512:
	cmp	\$8,$len
	jb	.Ltail_squeeze_avx512

	mov	(%r9),%r8
	lea	8(%r9),%r9
	mov	%r8,($out)
	lea	8($out),$out
	sub	\$8,$len		# len -= 8
	jz	.Ldone_squeeze_avx512

	sub	\$1,%rax		# bsz--
	jnz	.Loop_squeeze_avx512

	#vpermq		@Theta[4],@Theta[4],@Theta[3]
	#vpermq		@Theta[3],@Theta[4],@Theta[2]
	#vpermq		@Theta[3],@Theta[3],@Theta[1]

	call		__KeccakF1600

	vmovdqu64	$A00,40*0-96($A_flat){$k11111}
	vmovdqu64	$A10,40*1-96($A_flat){$k11111}
	vmovdqu64	$A20,40*2-96($A_flat){$k11111}
	vmovdqu64	$A30,40*3-96($A_flat){$k11111}
	vmovdqu64	$A40,40*4-96($A_flat){$k11111}

	lea	-96($A_flat),%r9
	mov	$bsz,%rax
	jmp	.Loop_squeeze_avx512

.Ltail_squeeze_avx512:
	mov	$out,%rdi
	mov	%r9,%rsi
	mov	$len,%rcx
	.byte	0xf3,0xa4		# rep movsb

.Ldone_squeeze_avx512:
	vzeroupper

	lea	(%r11),%rsp
	ret
.size	SHA3_squeeze,.-SHA3_squeeze

.align	64
theta_perm:
	.quad	0, 1, 2, 3, 4, 5, 6, 7		# [not used]
	.quad	4, 0, 1, 2, 3, 5, 6, 7
	.quad	3, 4, 0, 1, 2, 5, 6, 7
	.quad	2, 3, 4, 0, 1, 5, 6, 7
	.quad	1, 2, 3, 4, 0, 5, 6, 7

rhotates1:
	.quad	0,  44, 43, 21, 14, 0, 0, 0	# [0][0] [1][1] [2][2] [3][3] [4][4]
	.quad	18, 1,  6,  25, 8,  0, 0, 0	# [4][0] [0][1] [1][2] [2][3] [3][4]
	.quad	41, 2,	62, 55, 39, 0, 0, 0	# [3][0] [4][1] [0][2] [1][3] [2][4]
	.quad	3,  45, 61, 28, 20, 0, 0, 0	# [2][0] [3][1] [4][2] [0][3] [1][4]
	.quad	36, 10, 15, 56, 27, 0, 0, 0	# [1][0] [2][1] [3][2] [4][3] [0][4]

rhotates0:
	.quad	 0,  1, 62, 28, 27, 0, 0, 0
	.quad	36, 44,  6, 55, 20, 0, 0, 0
	.quad	 3, 10, 43, 25, 39, 0, 0, 0
	.quad	41, 45, 15, 21,  8, 0, 0, 0
	.quad	18,  2, 61, 56, 14, 0, 0, 0

pi0_perm:
	.quad	0, 3, 1, 4, 2, 5, 6, 7
	.quad	1, 4, 2, 0, 3, 5, 6, 7
	.quad	2, 0, 3, 1, 4, 5, 6, 7
	.quad	3, 1, 4, 2, 0, 5, 6, 7
	.quad	4, 2, 0, 3, 1, 5, 6, 7

iotas:
	.quad	0x0000000000000001
	.quad	0x0000000000008082
	.quad	0x800000000000808a
	.quad	0x8000000080008000
	.quad	0x000000000000808b
	.quad	0x0000000080000001
	.quad	0x8000000080008081
	.quad	0x8000000000008009
	.quad	0x000000000000008a
	.quad	0x0000000000000088
	.quad	0x0000000080008009
	.quad	0x000000008000000a
	.quad	0x000000008000808b
	.quad	0x800000000000008b
	.quad	0x8000000000008089
	.quad	0x8000000000008003
	.quad	0x8000000000008002
	.quad	0x8000000000000080
	.quad	0x000000000000800a
	.quad	0x800000008000000a
	.quad	0x8000000080008081
	.quad	0x8000000000008080
	.quad	0x0000000080000001
	.quad	0x8000000080008008

.asciz	"Keccak-1600 absorb and squeeze for AVX-512F, CRYPTOGAMS by <appro\@openssl.org>"
___

$output=pop;
open STDOUT,">$output";
print $code;
close STDOUT or die "error closing STDOUT: $!";


#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# Keccak-1600 for AVX512VL.
#
# December 2017.
#
# This is an adaptation of AVX2 module that reuses register data
# layout, but utilizes new 256-bit AVX512VL instructions. See AVX2
# module for further information on layout.
#
########################################################################
# Numbers are cycles per processed byte out of large message.
#
#			r=1088(*)
#
# Skylake-X		6.4/+47%
#
# (*)	Corresponds to SHA3-256. Percentage after slash is improvement
#	coefficient in comparison to scalar keccak1600-x86_64.pl.

# Digits in variables' names denote right-most coordinates:

my ($A00,	# [0][0] [0][0] [0][0] [0][0]		# %ymm0
    $A01,	# [0][4] [0][3] [0][2] [0][1]		# %ymm1
    $A20,	# [3][0] [1][0] [4][0] [2][0]		# %ymm2
    $A31,	# [2][4] [4][3] [1][2] [3][1]		# %ymm3
    $A21,	# [3][4] [1][3] [4][2] [2][1]		# %ymm4
    $A41,	# [1][4] [2][3] [3][2] [4][1]		# %ymm5
    $A11) =	# [4][4] [3][3] [2][2] [1][1]		# %ymm6
    map("%ymm$_",(0..6));

# We also need to map the magic order into offsets within structure:

my @A_jagged = ([0,0], [1,0], [1,1], [1,2], [1,3],	# [0][0..4]
		[2,2], [6,0], [3,1], [4,2], [5,3],	# [1][0..4]
		[2,0], [4,0], [6,1], [5,2], [3,3],	# [2][0..4]
		[2,3], [3,0], [5,1], [6,2], [4,3],	# [3][0..4]
		[2,1], [5,0], [4,1], [3,2], [6,3]);	# [4][0..4]
   @A_jagged = map(8*($$_[0]*4+$$_[1]), @A_jagged);	# ... and now linear

my @T = map("%ymm$_",(7..15));
my ($C14,$C00,$D00,$D14) = @T[5..8];
my ($R20,$R01,$R31,$R21,$R41,$R11) = map("%ymm$_",(16..21));

$code.=<<___;
.text

.type	__KeccakF1600,\@function
.align	32
__KeccakF1600:
	lea		iotas(%rip),%r10
	mov		\$24,%eax
	jmp		.Loop_avx512vl

.align	32
.Loop_avx512vl:
	######################################### Theta
	vpshufd		\$0b01001110,$A20,$C00
	vpxor		$A31,$A41,$C14
	vpxor		$A11,$A21,@T[2]
	vpternlogq	\$0x96,$A01,$T[2],$C14	# C[1..4]

	vpxor		$A20,$C00,$C00
	vpermq		\$0b01001110,$C00,@T[0]

	vpermq		\$0b10010011,$C14,@T[4]
	vprolq		\$1,$C14,@T[1]		# ROL64(C[1..4],1)

	vpermq		\$0b00111001,@T[1],$D14
	vpxor		@T[4],@T[1],$D00
	vpermq		\$0b00000000,$D00,$D00	# D[0..0] = ROL64(C[1],1) ^ C[4]

	vpternlogq	\$0x96,@T[0],$A00,$C00	# C[0..0]
	vprolq		\$1,$C00,@T[1]		# ROL64(C[0..0],1)

	vpxor		$D00,$A00,$A00		# ^= D[0..0]

	vpblendd	\$0b11000000,@T[1],$D14,$D14
	vpblendd	\$0b00000011,$C00,@T[4],@T[0]

	######################################### Rho + Pi + pre-Chi shuffle
	 vpxor		$D00,$A20,$A20		# ^= D[0..0] from Theta
	vprolvq		$R20,$A20,$A20

	 vpternlogq	\$0x96,@T[0],$D14,$A31	# ^= D[1..4] from Theta
	vprolvq		$R31,$A31,$A31

	 vpternlogq	\$0x96,@T[0],$D14,$A21	# ^= D[1..4] from Theta
	vprolvq		$R21,$A21,$A21

	 vpternlogq	\$0x96,@T[0],$D14,$A41	# ^= D[1..4] from Theta
	vprolvq		$R41,$A41,$A41

	 vpermq		\$0b10001101,$A20,@T[3]	# $A20 -> future $A31
	 vpermq		\$0b10001101,$A31,@T[4]	# $A31 -> future $A21
	 vpternlogq	\$0x96,@T[0],$D14,$A11	# ^= D[1..4] from Theta
	vprolvq		$R11,$A11,@T[1]		# $A11 -> future $A01

	 vpermq		\$0b00011011,$A21,@T[5]	# $A21 -> future $A41
	 vpermq		\$0b01110010,$A41,@T[6]	# $A41 -> future $A11
	 vpternlogq	\$0x96,@T[0],$D14,$A01	# ^= D[1..4] from Theta
	vprolvq		$R01,$A01,@T[2]		# $A01 -> future $A20

	######################################### Chi
	vpblendd	\$0b00001100,@T[6],@T[2],$A31	#               [4][4] [2][0]
	vpblendd	\$0b00001100,@T[2],@T[4],@T[8]	#               [4][0] [2][1]
	 vpblendd	\$0b00001100,@T[4],@T[3],$A41	#               [4][2] [2][4]
	 vpblendd	\$0b00001100,@T[3],@T[2],@T[7]	#               [4][3] [2][0]
	vpblendd	\$0b00110000,@T[4],$A31,$A31	#        [1][3] [4][4] [2][0]
	vpblendd	\$0b00110000,@T[5],@T[8],@T[8]	#        [1][4] [4][0] [2][1]
	 vpblendd	\$0b00110000,@T[2],$A41,$A41	#        [1][0] [4][2] [2][4]
	 vpblendd	\$0b00110000,@T[6],@T[7],@T[7]	#        [1][1] [4][3] [2][0]
	vpblendd	\$0b11000000,@T[5],$A31,$A31	# [3][2] [1][3] [4][4] [2][0]
	vpblendd	\$0b11000000,@T[6],@T[8],@T[8]	# [3][3] [1][4] [4][0] [2][1]
	 vpblendd	\$0b11000000,@T[6],$A41,$A41	# [3][3] [1][0] [4][2] [2][4]
	 vpblendd	\$0b11000000,@T[4],@T[7],@T[7]	# [3][4] [1][1] [4][3] [2][0]
	vpternlogq	\$0xC6,@T[8],@T[3],$A31		# [3][1] [1][2] [4][3] [2][4]
	 vpternlogq	\$0xC6,@T[7],@T[5],$A41		# [3][2] [1][4] [4][1] [2][3]

	vpsrldq		\$8,@T[1],@T[0]
	vpandn		@T[0],@T[1],@T[0]	# tgting  [0][0] [0][0] [0][0] [0][0]

	vpblendd	\$0b00001100,@T[2],@T[5],$A11	#               [4][0] [2][3]
	vpblendd	\$0b00001100,@T[5],@T[3],@T[8]	#               [4][1] [2][4]
	vpblendd	\$0b00110000,@T[3],$A11,$A11	#        [1][2] [4][0] [2][3]
	vpblendd	\$0b00110000,@T[4],@T[8],@T[8]	#        [1][3] [4][1] [2][4]
	vpblendd	\$0b11000000,@T[4],$A11,$A11	# [3][4] [1][2] [4][0] [2][3]
	vpblendd	\$0b11000000,@T[2],@T[8],@T[8]	# [3][0] [1][3] [4][1] [2][4]
	vpternlogq	\$0xC6,@T[8],@T[6],$A11		# [3][3] [1][1] [4][4] [2][2]

	  vpermq	\$0b00011110,@T[1],$A21		# [0][1] [0][2] [0][4] [0][3]
	  vpblendd	\$0b00110000,$A00,$A21,@T[8]	# [0][1] [0][0] [0][4] [0][3]
	  vpermq	\$0b00111001,@T[1],$A01		# [0][1] [0][4] [0][3] [0][2]
	  vpblendd	\$0b11000000,$A00,$A01,$A01	# [0][0] [0][4] [0][3] [0][2]

	vpblendd	\$0b00001100,@T[5],@T[4],$A20	#               [4][1] [2][1]
	vpblendd	\$0b00001100,@T[4],@T[6],@T[7]	#               [4][2] [2][2]
	vpblendd	\$0b00110000,@T[6],$A20,$A20	#        [1][1] [4][1] [2][1]
	vpblendd	\$0b00110000,@T[3],@T[7],@T[7]	#        [1][2] [4][2] [2][2]
	vpblendd	\$0b11000000,@T[3],$A20,$A20	# [3][1] [1][1] [4][1] [2][1]
	vpblendd	\$0b11000000,@T[5],@T[7],@T[7]	# [3][2] [1][2] [4][2] [2][2]
	vpternlogq	\$0xC6,@T[7],@T[2],$A20		# [3][0] [1][0] [4][0] [2][0]

	 vpermq		\$0b00000000,@T[0],@T[0]	# [0][0] [0][0] [0][0] [0][0]
	 vpermq		\$0b00011011,$A31,$A31		# post-Chi shuffle
	 vpermq		\$0b10001101,$A41,$A41
	 vpermq		\$0b01110010,$A11,$A11

	vpblendd	\$0b00001100,@T[3],@T[6],$A21	#               [4][3] [2][2]
	vpblendd	\$0b00001100,@T[6],@T[5],@T[7]	#               [4][4] [2][3]
	vpblendd	\$0b00110000,@T[5],$A21,$A21	#        [1][4] [4][3] [2][2]
	vpblendd	\$0b00110000,@T[2],@T[7],@T[7]	#        [1][0] [4][4] [2][3]
	vpblendd	\$0b11000000,@T[2],$A21,$A21	# [3][0] [1][4] [4][3] [2][2]
	vpblendd	\$0b11000000,@T[3],@T[7],@T[7]	# [3][1] [1][0] [4][4] [2][3]

	vpternlogq	\$0xC6,@T[8],@T[1],$A01		# [0][4] [0][3] [0][2] [0][1]
	vpternlogq	\$0xC6,@T[7],@T[4],$A21		# [3][4] [1][3] [4][2] [2][1]

	######################################### Iota
	vpternlogq	\$0x96,(%r10),@T[0],$A00
	lea		32(%r10),%r10

	dec		%eax
	jnz		.Loop_avx512vl

	ret
.size	__KeccakF1600,.-__KeccakF1600
___
my ($A_flat,$inp,$len,$bsz) = ("%rdi","%rsi","%rdx","%rcx");
my  $out = $inp;	# in squeeze

$code.=<<___;
.globl	SHA3_absorb
.type	SHA3_absorb,\@function
.align	32
SHA3_absorb:
	mov	%rsp,%r11

	lea	-240(%rsp),%rsp
	and	\$-32,%rsp

	lea	96($A_flat),$A_flat
	lea	96($inp),$inp
	lea	96(%rsp),%r10
	lea	rhotates_left(%rip),%r8

	vzeroupper

	vpbroadcastq	-96($A_flat),$A00	# load A[5][5]
	vmovdqu		8+32*0-96($A_flat),$A01
	vmovdqu		8+32*1-96($A_flat),$A20
	vmovdqu		8+32*2-96($A_flat),$A31
	vmovdqu		8+32*3-96($A_flat),$A21
	vmovdqu		8+32*4-96($A_flat),$A41
	vmovdqu		8+32*5-96($A_flat),$A11

	vmovdqa64	0*32(%r8),$R20		# load "rhotate" indices
	vmovdqa64	1*32(%r8),$R01
	vmovdqa64	2*32(%r8),$R31
	vmovdqa64	3*32(%r8),$R21
	vmovdqa64	4*32(%r8),$R41
	vmovdqa64	5*32(%r8),$R11

	vpxor		@T[0],@T[0],@T[0]
	vmovdqa		@T[0],32*2-96(%r10)	# zero transfer area on stack
	vmovdqa		@T[0],32*3-96(%r10)
	vmovdqa		@T[0],32*4-96(%r10)
	vmovdqa		@T[0],32*5-96(%r10)
	vmovdqa		@T[0],32*6-96(%r10)

.Loop_absorb_avx512vl:
	mov		$bsz,%rax
	sub		$bsz,$len
	jc		.Ldone_absorb_avx512vl

	shr		\$3,%eax
	vpbroadcastq	0-96($inp),@T[0]
	vmovdqu		8-96($inp),@T[1]
	sub		\$4,%eax
___
for(my $i=5; $i<25; $i++) {
$code.=<<___
	dec	%eax
	jz	.Labsorved_avx512vl
	mov	8*$i-96($inp),%r8
	mov	%r8,$A_jagged[$i]-96(%r10)
___
}
$code.=<<___;
.Labsorved_avx512vl:
	lea	($inp,$bsz),$inp

	vpxor	@T[0],$A00,$A00
	vpxor	@T[1],$A01,$A01
	vpxor	32*2-96(%r10),$A20,$A20
	vpxor	32*3-96(%r10),$A31,$A31
	vpxor	32*4-96(%r10),$A21,$A21
	vpxor	32*5-96(%r10),$A41,$A41
	vpxor	32*6-96(%r10),$A11,$A11

	call	__KeccakF1600

	lea	96(%rsp),%r10
	jmp	.Loop_absorb_avx512vl

.Ldone_absorb_avx512vl:
	vmovq	%xmm0,-96($A_flat)
	vmovdqu	$A01,8+32*0-96($A_flat)
	vmovdqu	$A20,8+32*1-96($A_flat)
	vmovdqu	$A31,8+32*2-96($A_flat)
	vmovdqu	$A21,8+32*3-96($A_flat)
	vmovdqu	$A41,8+32*4-96($A_flat)
	vmovdqu	$A11,8+32*5-96($A_flat)

	vzeroupper

	lea	(%r11),%rsp
	lea	($len,$bsz),%rax		# return value
	ret
.size	SHA3_absorb,.-SHA3_absorb

.globl	SHA3_squeeze
.type	SHA3_squeeze,\@function
.align	32
SHA3_squeeze:
	mov	%rsp,%r11

	lea	96($A_flat),$A_flat
	lea	rhotates_left(%rip),%r8
	shr	\$3,$bsz

	vzeroupper

	vpbroadcastq	-96($A_flat),$A00
	vpxor		@T[0],@T[0],@T[0]
	vmovdqu		8+32*0-96($A_flat),$A01
	vmovdqu		8+32*1-96($A_flat),$A20
	vmovdqu		8+32*2-96($A_flat),$A31
	vmovdqu		8+32*3-96($A_flat),$A21
	vmovdqu		8+32*4-96($A_flat),$A41
	vmovdqu		8+32*5-96($A_flat),$A11

	vmovdqa64	0*32(%r8),$R20		# load "rhotate" indices
	vmovdqa64	1*32(%r8),$R01
	vmovdqa64	2*32(%r8),$R31
	vmovdqa64	3*32(%r8),$R21
	vmovdqa64	4*32(%r8),$R41
	vmovdqa64	5*32(%r8),$R11

	mov	$bsz,%rax

.Loop_squeeze_avx512vl:
	mov	@A_jagged[$i]-96($A_flat),%r8
___
for (my $i=0; $i<25; $i++) {
$code.=<<___;
	sub	\$8,$len
	jc	.Ltail_squeeze_avx512vl
	mov	%r8,($out)
	lea	8($out),$out
	je	.Ldone_squeeze_avx512vl
	dec	%eax
	je	.Lextend_output_avx512vl
	mov	@A_jagged[$i+1]-120($A_flat),%r8
___
}
$code.=<<___;
.Lextend_output_avx512vl:
	call	__KeccakF1600

	vmovq	%xmm0,-96($A_flat)
	vmovdqu	$A01,8+32*0-96($A_flat)
	vmovdqu	$A20,8+32*1-96($A_flat)
	vmovdqu	$A31,8+32*2-96($A_flat)
	vmovdqu	$A21,8+32*3-96($A_flat)
	vmovdqu	$A41,8+32*4-96($A_flat)
	vmovdqu	$A11,8+32*5-96($A_flat)

	mov	$bsz,%rax
	jmp	.Loop_squeeze_avx512vl

.Ltail_squeeze_avx512vl:
	add	\$8,$len
.Loop_tail_avx512vl:
	mov	%r8b,($out)
	lea	1($out),$out
	shr	\$8,%r8
	dec	$len
	jnz	.Loop_tail_avx512vl

.Ldone_squeeze_avx512vl:
	vzeroupper

	lea	(%r11),%rsp
	ret
.size	SHA3_squeeze,.-SHA3_squeeze

.align	64
rhotates_left:
	.quad	3,	18,	36,	41	# [2][0] [4][0] [1][0] [3][0]
	.quad	1,	62,	28,	27	# [0][1] [0][2] [0][3] [0][4]
	.quad	45,	6,	56,	39	# [3][1] [1][2] [4][3] [2][4]
	.quad	10,	61,	55,	8	# [2][1] [4][2] [1][3] [3][4]
	.quad	2,	15,	25,	20	# [4][1] [3][2] [2][3] [1][4]
	.quad	44,	43,	21,	14	# [1][1] [2][2] [3][3] [4][4]
iotas:
	.quad	0x0000000000000001, 0x0000000000000001, 0x0000000000000001, 0x0000000000000001
	.quad	0x0000000000008082, 0x0000000000008082, 0x0000000000008082, 0x0000000000008082
	.quad	0x800000000000808a, 0x800000000000808a, 0x800000000000808a, 0x800000000000808a
	.quad	0x8000000080008000, 0x8000000080008000, 0x8000000080008000, 0x8000000080008000
	.quad	0x000000000000808b, 0x000000000000808b, 0x000000000000808b, 0x000000000000808b
	.quad	0x0000000080000001, 0x0000000080000001, 0x0000000080000001, 0x0000000080000001
	.quad	0x8000000080008081, 0x8000000080008081, 0x8000000080008081, 0x8000000080008081
	.quad	0x8000000000008009, 0x8000000000008009, 0x8000000000008009, 0x8000000000008009
	.quad	0x000000000000008a, 0x000000000000008a, 0x000000000000008a, 0x000000000000008a
	.quad	0x0000000000000088, 0x0000000000000088, 0x0000000000000088, 0x0000000000000088
	.quad	0x0000000080008009, 0x0000000080008009, 0x0000000080008009, 0x0000000080008009
	.quad	0x000000008000000a, 0x000000008000000a, 0x000000008000000a, 0x000000008000000a
	.quad	0x000000008000808b, 0x000000008000808b, 0x000000008000808b, 0x000000008000808b
	.quad	0x800000000000008b, 0x800000000000008b, 0x800000000000008b, 0x800000000000008b
	.quad	0x8000000000008089, 0x8000000000008089, 0x8000000000008089, 0x8000000000008089
	.quad	0x8000000000008003, 0x8000000000008003, 0x8000000000008003, 0x8000000000008003
	.quad	0x8000000000008002, 0x8000000000008002, 0x8000000000008002, 0x8000000000008002
	.quad	0x8000000000000080, 0x8000000000000080, 0x8000000000000080, 0x8000000000000080
	.quad	0x000000000000800a, 0x000000000000800a, 0x000000000000800a, 0x000000000000800a
	.quad	0x800000008000000a, 0x800000008000000a, 0x800000008000000a, 0x800000008000000a
	.quad	0x8000000080008081, 0x8000000080008081, 0x8000000080008081, 0x8000000080008081
	.quad	0x8000000000008080, 0x8000000000008080, 0x8000000000008080, 0x8000000000008080
	.quad	0x0000000080000001, 0x0000000080000001, 0x0000000080000001, 0x0000000080000001
	.quad	0x8000000080008008, 0x8000000080008008, 0x8000000080008008, 0x8000000080008008

.asciz	"Keccak-1600 absorb and squeeze for AVX512VL, CRYPTOGAMS by <appro\@openssl.org>"
___

$output=pop;
open STDOUT,">$output";
print $code;
close STDOUT or die "error closing STDOUT: $!";


#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# [ABI- and endian-neutral] Keccak-1600 for C64x.
#
# June 2017.
#
# This is straightforward KECCAK_1X_ALT variant (see sha/keccak1600.c)
# with bit interleaving. 64-bit values are simply split between A- and
# B-files, with A-file holding least significant halves. This works
# out perfectly, because all operations including cross-communications
# [in rotate operations] are always complementary. Performance is
# [incredible for a 32-bit processor] 10.9 cycles per processed byte
# for r=1088, which corresponds to SHA3-256. This is >15x faster than
# compiler-generated KECCAK_1X_ALT code, and >10x than other variants.
# On average processor ends up issuing ~4.5 instructions per cycle...

my @A = map([ $_, ($_+1), ($_+2), ($_+3), ($_+4) ], (5,10,16,21,26));
   $A[1][4] = 31;	# B14 is reserved, A14 is used as iota[]
   ($A[3][0],$A[4][1]) = ($A[4][1],$A[3][0]);
my @C = (0..4,$A[3][0],$A[4][0]);
my $iotas = "A14";

my @rhotates = ([  0,  1, 62, 28, 27 ],
                [ 36, 44,  6, 55, 20 ],
                [  3, 10, 43, 25, 39 ],
                [ 41, 45, 15, 21,  8 ],
                [ 18,  2, 61, 56, 14 ]);

sub ROL64 {
    my ($src,$rot,$dst,$p) = @_;

    if ($rot&1) {
$code.=<<___;
$p	ROTL	B$src,$rot/2+1,A$dst
||	ROTL	A$src,$rot/2,  B$dst
___
    } else {
$code.=<<___;
$p	ROTL	A$src,$rot/2,A$dst
||	ROTL	B$src,$rot/2,B$dst
___
    }
}

########################################################################
# Stack frame layout
#
# SP--->+------+------+
#       |      |      |
# +1--->+------+------+<- -9	below 4 slots are used by KeccakF1600_int
#       |      |      |
# +2--->+------+------+<- -8
#       |      |      |
# +3--->+------+------+<- -7
#       | A2   | A3   |		A3:A2 are preserved by KeccakF1600_int
# +4--->+------+------+<- -6
#       | B2   | B3   |		B3:B2 are preserved by KeccakF1600_int
# +5--->+------+------+<- -5	below is ABI-compliant layout
#       | A10  | A11  |
# +6--->+------+------+<- -4
#       | A12  | A13  |
# +7--->+------+------+<- -3
#       | A14  | B3   |
# +8--->+------+------+<- -2
#       | B10  | B11  |
# +9--->+------+------+<- -1
#       | B12  | B13  |
#       +------+------+<---FP
#       | A15  |
#       +------+--

$code.=<<___;
	.text

	.if	.ASSEMBLER_VERSION<7000000
	.asg	0,__TI_EABI__
	.endif
	.if	__TI_EABI__
	.nocmp
	.asg	KeccakF1600,_KeccakF1600
	.asg	SHA3_absorb,_SHA3_absorb
	.asg	SHA3_squeeze,_SHA3_squeeze
	.endif

	.asg	B3,RA
	.asg	A15,FP
	.asg	B15,SP

	.align	32
_KeccakF1600_int:
	.asmfunc
	STDW	A3:A2,*FP[-7]
||	STDW	B3:B2,*SP[4]
_KeccakF1600_cheat:
	.if	__TI_EABI__
	ADDKPC	_KeccakF1600_int,B0
||	MVKL	\$PCR_OFFSET(iotas,_KeccakF1600_int),$iotas
	MVKH	\$PCR_OFFSET(iotas,_KeccakF1600_int),$iotas
	.else
	ADDKPC	_KeccakF1600_int,B0
||	MVKL	(iotas-_KeccakF1600_int),$iotas
	MVKH	(iotas-_KeccakF1600_int),$iotas
	.endif
	ADD	B0,$iotas,$iotas
loop?:
	XOR	A$A[0][2],A$A[1][2],A$C[2]	; Theta
||	XOR	B$A[0][2],B$A[1][2],B$C[2]
||	XOR	A$A[0][3],A$A[1][3],A$C[3]
||	XOR	B$A[0][3],B$A[1][3],B$C[3]
||	XOR	A$A[0][0],A$A[1][0],A$C[0]
||	XOR	B$A[0][0],B$A[1][0],B$C[0]
	XOR	A$A[2][2],A$C[2],A$C[2]
||	XOR	B$A[2][2],B$C[2],B$C[2]
||	XOR	A$A[2][3],A$C[3],A$C[3]
||	XOR	B$A[2][3],B$C[3],B$C[3]
||	XOR	A$A[2][0],A$C[0],A$C[0]
||	XOR	B$A[2][0],B$C[0],B$C[0]
	XOR	A$A[3][2],A$C[2],A$C[2]
||	XOR	B$A[3][2],B$C[2],B$C[2]
||	XOR	A$A[3][3],A$C[3],A$C[3]
||	XOR	B$A[3][3],B$C[3],B$C[3]
||	XOR	A$A[3][0],A$C[0],A$C[0]
||	XOR	B$A[3][0],B$C[0],B$C[0]
	XOR	A$A[4][2],A$C[2],A$C[2]
||	XOR	B$A[4][2],B$C[2],B$C[2]
||	XOR	A$A[4][3],A$C[3],A$C[3]
||	XOR	B$A[4][3],B$C[3],B$C[3]
||	XOR	A$A[4][0],A$C[0],A$C[0]
||	XOR	B$A[4][0],B$C[0],B$C[0]
	XOR	A$A[0][4],A$A[1][4],A$C[4]
||	XOR	B$A[0][4],B$A[1][4],B$C[4]
||	XOR	A$A[0][1],A$A[1][1],A$C[1]
||	XOR	B$A[0][1],B$A[1][1],B$C[1]
||	STDW	A$A[3][0]:A$A[4][0],*SP[1]	; offload some data
	STDW	B$A[3][0]:B$A[4][0],*SP[2]
||	XOR	A$A[2][4],A$C[4],A$C[4]
||	XOR	B$A[2][4],B$C[4],B$C[4]
||	XOR	A$A[2][1],A$C[1],A$C[1]
||	XOR	B$A[2][1],B$C[1],B$C[1]
||	ROTL	B$C[2],1,A$C[5]			; ROL64(C[2],1)
||	ROTL	A$C[2],0,B$C[5]
	XOR	A$A[3][4],A$C[4],A$C[4]
||	XOR	B$A[3][4],B$C[4],B$C[4]
||	XOR	A$A[3][1],A$C[1],A$C[1]
||	XOR	B$A[3][1],B$C[1],B$C[1]
||	ROTL	B$C[3],1,A$C[6]			; ROL64(C[3],1)
||	ROTL	A$C[3],0,B$C[6]
	XOR	A$A[4][4],A$C[4],A$C[4]
||	XOR	B$A[4][4],B$C[4],B$C[4]
||	XOR	A$A[4][1],A$C[1],A$C[1]
||	XOR	B$A[4][1],B$C[1],B$C[1]
||	XOR	A$C[0],A$C[5],A$C[5]		; C[0] ^ ROL64(C[2],1)
||	XOR	B$C[0],B$C[5],B$C[5]
	XOR	A$C[5],A$A[0][1],A$A[0][1]
||	XOR	B$C[5],B$A[0][1],B$A[0][1]
||	XOR	A$C[5],A$A[1][1],A$A[1][1]
||	XOR	B$C[5],B$A[1][1],B$A[1][1]
||	XOR	A$C[5],A$A[2][1],A$A[2][1]
||	XOR	B$C[5],B$A[2][1],B$A[2][1]
	XOR	A$C[5],A$A[3][1],A$A[3][1]
||	XOR	B$C[5],B$A[3][1],B$A[3][1]
||	XOR	A$C[5],A$A[4][1],A$A[4][1]
||	XOR	B$C[5],B$A[4][1],B$A[4][1]
||	ROTL	B$C[4],1,A$C[5]			; ROL64(C[4],1)
||	ROTL	A$C[4],0,B$C[5]
||	XOR	A$C[1],A$C[6],A$C[6]		; C[1] ^ ROL64(C[3],1)
||	XOR	B$C[1],B$C[6],B$C[6]
	XOR	A$C[6],A$A[0][2],A$A[0][2]
||	XOR	B$C[6],B$A[0][2],B$A[0][2]
||	XOR	A$C[6],A$A[1][2],A$A[1][2]
||	XOR	B$C[6],B$A[1][2],B$A[1][2]
||	XOR	A$C[6],A$A[2][2],A$A[2][2]
||	XOR	B$C[6],B$A[2][2],B$A[2][2]
||	ROTL	B$C[1],1,A$C[1]			; ROL64(C[1],1)
||	ROTL	A$C[1],0,B$C[1]
	XOR	A$C[6],A$A[3][2],A$A[3][2]
||	XOR	B$C[6],B$A[3][2],B$A[3][2]
||	XOR	A$C[6],A$A[4][2],A$A[4][2]
||	XOR	B$C[6],B$A[4][2],B$A[4][2]
||	ROTL	B$C[0],1,A$C[6]			; ROL64(C[0],1)
||	ROTL	A$C[0],0,B$C[6]
||	XOR	A$C[5],A$C[2],A$C[2]		; C[2] ^= ROL64(C[4],1)
||	XOR	B$C[5],B$C[2],B$C[2]
	XOR	A$C[2],A$A[0][3],A$A[0][3]
||	XOR	B$C[2],B$A[0][3],B$A[0][3]
||	XOR	A$C[2],A$A[1][3],A$A[1][3]
||	XOR	B$C[2],B$A[1][3],B$A[1][3]
||	XOR	A$C[2],A$A[2][3],A$A[2][3]
||	XOR	B$C[2],B$A[2][3],B$A[2][3]
	XOR	A$C[6],A$C[3],A$C[3]		; C[3] ^= ROL64(C[0],1)
||	XOR	B$C[6],B$C[3],B$C[3]
||	LDDW	*FP[-9],A$A[3][0]:A$A[4][0]	; restore offloaded data
||	LDDW	*SP[2],B$A[3][0]:B$A[4][0]
||	XOR	A$C[2],A$A[3][3],A$A[3][3]
||	XOR	B$C[2],B$A[3][3],B$A[3][3]
	XOR	A$C[2],A$A[4][3],A$A[4][3]
||	XOR	B$C[2],B$A[4][3],B$A[4][3]
||	XOR	A$C[3],A$A[0][4],A$A[0][4]
||	XOR	B$C[3],B$A[0][4],B$A[0][4]
||	XOR	A$C[3],A$A[1][4],A$A[1][4]
||	XOR	B$C[3],B$A[1][4],B$A[1][4]
	XOR	A$C[3],A$A[2][4],A$A[2][4]
||	XOR	B$C[3],B$A[2][4],B$A[2][4]
||	XOR	A$C[3],A$A[3][4],A$A[3][4]
||	XOR	B$C[3],B$A[3][4],B$A[3][4]
||	XOR	A$C[3],A$A[4][4],A$A[4][4]
||	XOR	B$C[3],B$A[4][4],B$A[4][4]
	XOR	A$C[1],A$C[4],A$C[4]		; C[4] ^= ROL64(C[1],1)
||	XOR	B$C[1],B$C[4],B$C[4]
||	MV	A$A[0][1],A$C[1]		; Rho+Pi, "early start"
||	MV	B$A[0][1],B$C[1]
___
	&ROL64	($A[1][1],$rhotates[1][1],$A[0][1],"||");
$code.=<<___;
	XOR	A$C[4],A$A[0][0],A$A[0][0]
||	XOR	B$C[4],B$A[0][0],B$A[0][0]
||	XOR	A$C[4],A$A[1][0],A$A[1][0]
||	XOR	B$C[4],B$A[1][0],B$A[1][0]
||	MV	A$A[0][3],A$C[3]
||	MV	B$A[0][3],B$C[3]
___
	&ROL64	($A[3][3],$rhotates[3][3],$A[0][3],"||");
$code.=<<___;
	XOR	A$C[4],A$A[2][0],A$A[2][0]
||	XOR	B$C[4],B$A[2][0],B$A[2][0]
||	XOR	A$C[4],A$A[3][0],A$A[3][0]
||	XOR	B$C[4],B$A[3][0],B$A[3][0]
||	MV	A$A[0][2],A$C[2]
||	MV	B$A[0][2],B$C[2]
___
	&ROL64	($A[2][2],$rhotates[2][2],$A[0][2],"||");
$code.=<<___;
	XOR	A$C[4],A$A[4][0],A$A[4][0]
||	XOR	B$C[4],B$A[4][0],B$A[4][0]
||	MV	A$A[0][4],A$C[4]
||	MV	B$A[0][4],B$C[4]
___
	&ROL64	($A[4][4],$rhotates[4][4],$A[0][4],"||");

	&ROL64	($A[1][4],$rhotates[1][4],$A[1][1]);
$code.=<<___;
||	LDW	*${iotas}++[2],A$C[0]
___
	&ROL64	($A[2][3],$rhotates[2][3],$A[2][2]);
$code.=<<___;
||	LDW	*${iotas}[-1],B$C[0]
___
	&ROL64	($A[3][2],$rhotates[3][2],$A[3][3]);
	&ROL64	($A[4][1],$rhotates[4][1],$A[4][4]);

	&ROL64	($A[4][2],$rhotates[4][2],$A[1][4]);
	&ROL64	($A[3][4],$rhotates[3][4],$A[2][3]);
	&ROL64	($A[2][1],$rhotates[2][1],$A[3][2]);
	&ROL64	($A[1][3],$rhotates[1][3],$A[4][1]);

	&ROL64	($A[2][4],$rhotates[2][4],$A[4][2]);
	&ROL64	($A[4][3],$rhotates[4][3],$A[3][4]);
	&ROL64	($A[1][2],$rhotates[1][2],$A[2][1]);
	&ROL64	($A[3][1],$rhotates[3][1],$A[1][3]);

	&ROL64	($A[4][0],$rhotates[4][0],$A[2][4]);
	&ROL64	($A[3][0],$rhotates[3][0],$A[4][3]);
	&ROL64	($A[2][0],$rhotates[2][0],$A[1][2]);
	&ROL64	($A[1][0],$rhotates[1][0],$A[3][1]);

	#&ROL64	($C[3],   $rhotates[0][3],$A[1][0]);	# moved below
	&ROL64	($C[1],   $rhotates[0][1],$A[2][0]);
	&ROL64	($C[4],   $rhotates[0][4],$A[3][0]);
	&ROL64	($C[2],   $rhotates[0][2],$A[4][0]);
$code.=<<___;
||	ANDN	A$A[0][2],A$A[0][1],A$C[4]	; Chi+Iota
||	ANDN	B$A[0][2],B$A[0][1],B$C[4]
||	ANDN	A$A[0][3],A$A[0][2],A$C[1]
||	ANDN	B$A[0][3],B$A[0][2],B$C[1]
||	ANDN	A$A[0][4],A$A[0][3],A$C[2]
||	ANDN	B$A[0][4],B$A[0][3],B$C[2]
___
	&ROL64	($C[3],   $rhotates[0][3],$A[1][0]);
$code.=<<___;
||	ANDN	A$A[0][0],A$A[0][4],A$C[3]
||	ANDN	B$A[0][0],B$A[0][4],B$C[3]
||	XOR	A$C[4],A$A[0][0],A$A[0][0]
||	XOR	B$C[4],B$A[0][0],B$A[0][0]
||	ANDN	A$A[0][1],A$A[0][0],A$C[4]
||	ANDN	B$A[0][1],B$A[0][0],B$C[4]
	XOR	A$C[1],A$A[0][1],A$A[0][1]
||	XOR	B$C[1],B$A[0][1],B$A[0][1]
||	XOR	A$C[2],A$A[0][2],A$A[0][2]
||	XOR	B$C[2],B$A[0][2],B$A[0][2]
||	XOR	A$C[3],A$A[0][3],A$A[0][3]
||	XOR	B$C[3],B$A[0][3],B$A[0][3]
	XOR	A$C[4],A$A[0][4],A$A[0][4]
||	XOR	B$C[4],B$A[0][4],B$A[0][4]
||	XOR	A$C[0],A$A[0][0],A$A[0][0]	; A[0][0] ^= iotas[i++];
||	XOR	B$C[0],B$A[0][0],B$A[0][0]
||	EXTU	$iotas,24,24,A0			; A0 is A$C[0], as we done?

	ANDN	A$A[1][2],A$A[1][1],A$C[4]
||	ANDN	B$A[1][2],B$A[1][1],B$C[4]
||	ANDN	A$A[1][3],A$A[1][2],A$C[1]
||	ANDN	B$A[1][3],B$A[1][2],B$C[1]
||	ANDN	A$A[1][4],A$A[1][3],A$C[2]
||	ANDN	B$A[1][4],B$A[1][3],B$C[2]
	ANDN	A$A[1][0],A$A[1][4],A$C[3]
||	ANDN	B$A[1][0],B$A[1][4],B$C[3]
||	XOR	A$C[4],A$A[1][0],A$A[1][0]
||	XOR	B$C[4],B$A[1][0],B$A[1][0]
||	ANDN	A$A[1][1],A$A[1][0],A$C[4]
||	ANDN	B$A[1][1],B$A[1][0],B$C[4]
	XOR	A$C[1],A$A[1][1],A$A[1][1]
||	XOR	B$C[1],B$A[1][1],B$A[1][1]
||	XOR	A$C[2],A$A[1][2],A$A[1][2]
||	XOR	B$C[2],B$A[1][2],B$A[1][2]
||	XOR	A$C[3],A$A[1][3],A$A[1][3]
||	XOR	B$C[3],B$A[1][3],B$A[1][3]
	XOR	A$C[4],A$A[1][4],A$A[1][4]
||	XOR	B$C[4],B$A[1][4],B$A[1][4]

||	ANDN	A$A[2][2],A$A[2][1],A$C[4]
||	ANDN	B$A[2][2],B$A[2][1],B$C[4]
||	ANDN	A$A[2][3],A$A[2][2],A$C[1]
||	ANDN	B$A[2][3],B$A[2][2],B$C[1]
	ANDN	A$A[2][4],A$A[2][3],A$C[2]
||	ANDN	B$A[2][4],B$A[2][3],B$C[2]
||	ANDN	A$A[2][0],A$A[2][4],A$C[3]
||	ANDN	B$A[2][0],B$A[2][4],B$C[3]
||	XOR	A$C[4],A$A[2][0],A$A[2][0]
||	XOR	B$C[4],B$A[2][0],B$A[2][0]
	ANDN	A$A[2][1],A$A[2][0],A$C[4]
||	ANDN	B$A[2][1],B$A[2][0],B$C[4]
||	XOR	A$C[1],A$A[2][1],A$A[2][1]
||	XOR	B$C[1],B$A[2][1],B$A[2][1]
||	XOR	A$C[2],A$A[2][2],A$A[2][2]
||	XOR	B$C[2],B$A[2][2],B$A[2][2]
	XOR	A$C[3],A$A[2][3],A$A[2][3]
||	XOR	B$C[3],B$A[2][3],B$A[2][3]
||	XOR	A$C[4],A$A[2][4],A$A[2][4]
||	XOR	B$C[4],B$A[2][4],B$A[2][4]

	ANDN	A$A[3][2],A$A[3][1],A$C[4]
||	ANDN	B$A[3][2],B$A[3][1],B$C[4]
||	ANDN	A$A[3][3],A$A[3][2],A$C[1]
||	ANDN	B$A[3][3],B$A[3][2],B$C[1]
||	ANDN	A$A[3][4],A$A[3][3],A$C[2]
||	ANDN	B$A[3][4],B$A[3][3],B$C[2]
	ANDN	A$A[3][0],A$A[3][4],A$C[3]
||	ANDN	B$A[3][0],B$A[3][4],B$C[3]
||	XOR	A$C[4],A$A[3][0],A$A[3][0]
||	XOR	B$C[4],B$A[3][0],B$A[3][0]
||	ANDN	A$A[3][1],A$A[3][0],A$C[4]
||	ANDN	B$A[3][1],B$A[3][0],B$C[4]
	XOR	A$C[1],A$A[3][1],A$A[3][1]
||	XOR	B$C[1],B$A[3][1],B$A[3][1]
||	XOR	A$C[2],A$A[3][2],A$A[3][2]
||	XOR	B$C[2],B$A[3][2],B$A[3][2]
||	XOR	A$C[3],A$A[3][3],A$A[3][3]
||[A0]	BNOP	loop?
	XOR	B$C[3],B$A[3][3],B$A[3][3]
||	XOR	A$C[4],A$A[3][4],A$A[3][4]
||	XOR	B$C[4],B$A[3][4],B$A[3][4]
||[!A0]	LDDW	*FP[-7],A3:A2
||[!A0]	LDDW	*SP[4], RA:B2

	ANDN	A$A[4][2],A$A[4][1],A$C[4]
||	ANDN	B$A[4][2],B$A[4][1],B$C[4]
||	ANDN	A$A[4][3],A$A[4][2],A$C[1]
||	ANDN	B$A[4][3],B$A[4][2],B$C[1]
||	ANDN	A$A[4][4],A$A[4][3],A$C[2]
||	ANDN	B$A[4][4],B$A[4][3],B$C[2]
	ANDN	A$A[4][0],A$A[4][4],A$C[3]
||	ANDN	B$A[4][0],B$A[4][4],B$C[3]
||	XOR	A$C[4],A$A[4][0],A$A[4][0]
||	XOR	B$C[4],B$A[4][0],B$A[4][0]
||	ANDN	A$A[4][1],A$A[4][0],A$C[4]
||	ANDN	B$A[4][1],B$A[4][0],B$C[4]
	XOR	A$C[1],A$A[4][1],A$A[4][1]
||	XOR	B$C[1],B$A[4][1],B$A[4][1]
||	XOR	A$C[2],A$A[4][2],A$A[4][2]
||	XOR	B$C[2],B$A[4][2],B$A[4][2]
||	XOR	A$C[3],A$A[4][3],A$A[4][3]
||	XOR	B$C[3],B$A[4][3],B$A[4][3]
	XOR	A$C[4],A$A[4][4],A$A[4][4]
||	XOR	B$C[4],B$A[4][4],B$A[4][4]
;;===== branch to loop? is taken here

	BNOP	RA,5
	.endasmfunc

	.newblock
	.global	_KeccakF1600
	.align	32
_KeccakF1600:
	.asmfunc stack_usage(80)
	STW	FP,*SP--(80)			; save frame pointer
||	MV	SP,FP
	STDW	B13:B12,*SP[9]
||	STDW	A13:A12,*FP[-4]
	STDW	B11:B10,*SP[8]
||	STDW	A11:A10,*FP[-5]
	STW	RA, *SP[15]
||	STW	A14,*FP[-6]
||	MV	A4,A2
||	ADD	4,A4,B2

	LDW	*A2++[2],A$A[0][0]		; load A[5][5]
||	LDW	*B2++[2],B$A[0][0]
	LDW	*A2++[2],A$A[0][1]
||	LDW	*B2++[2],B$A[0][1]
	LDW	*A2++[2],A$A[0][2]
||	LDW	*B2++[2],B$A[0][2]
	LDW	*A2++[2],A$A[0][3]
||	LDW	*B2++[2],B$A[0][3]
	LDW	*A2++[2],A$A[0][4]
||	LDW	*B2++[2],B$A[0][4]

	LDW	*A2++[2],A$A[1][0]
||	LDW	*B2++[2],B$A[1][0]
	LDW	*A2++[2],A$A[1][1]
||	LDW	*B2++[2],B$A[1][1]
	LDW	*A2++[2],A$A[1][2]
||	LDW	*B2++[2],B$A[1][2]
	LDW	*A2++[2],A$A[1][3]
||	LDW	*B2++[2],B$A[1][3]
	LDW	*A2++[2],A$A[1][4]
||	LDW	*B2++[2],B$A[1][4]

	LDW	*A2++[2],A$A[2][0]
||	LDW	*B2++[2],B$A[2][0]
	LDW	*A2++[2],A$A[2][1]
||	LDW	*B2++[2],B$A[2][1]
	LDW	*A2++[2],A$A[2][2]
||	LDW	*B2++[2],B$A[2][2]
	LDW	*A2++[2],A$A[2][3]
||	LDW	*B2++[2],B$A[2][3]
	LDW	*A2++[2],A$A[2][4]
||	LDW	*B2++[2],B$A[2][4]

	LDW	*A2++[2],A$A[3][0]
||	LDW	*B2++[2],B$A[3][0]
	LDW	*A2++[2],A$A[3][1]
||	LDW	*B2++[2],B$A[3][1]
	LDW	*A2++[2],A$A[3][2]
||	LDW	*B2++[2],B$A[3][2]
	LDW	*A2++[2],A$A[3][3]
||	LDW	*B2++[2],B$A[3][3]
	LDW	*A2++[2],A$A[3][4]
||	LDW	*B2++[2],B$A[3][4]
||	BNOP	_KeccakF1600_int

	ADDKPC	ret?,RA
||	LDW	*A2++[2],A$A[4][0]
||	LDW	*B2++[2],B$A[4][0]
	LDW	*A2++[2],A$A[4][1]
||	LDW	*B2++[2],B$A[4][1]
	LDW	*A2++[2],A$A[4][2]
||	LDW	*B2++[2],B$A[4][2]
	LDW	*A2++[2],A$A[4][3]
||	LDW	*B2++[2],B$A[4][3]
	LDW	*A2,A$A[4][4]
||	LDW	*B2,B$A[4][4]
||	ADDK	-192,A2				; rewind
||	ADDK	-192,B2

	.align	16
ret?:
	STW	A$A[0][0],*A2++[2]		; store A[5][5]
||	STW	B$A[0][0],*B2++[2]
	STW	A$A[0][1],*A2++[2]
||	STW	B$A[0][1],*B2++[2]
	STW	A$A[0][2],*A2++[2]
||	STW	B$A[0][2],*B2++[2]
	STW	A$A[0][3],*A2++[2]
||	STW	B$A[0][3],*B2++[2]
	STW	A$A[0][4],*A2++[2]
||	STW	B$A[0][4],*B2++[2]

	STW	A$A[1][0],*A2++[2]
||	STW	B$A[1][0],*B2++[2]
	STW	A$A[1][1],*A2++[2]
||	STW	B$A[1][1],*B2++[2]
	STW	A$A[1][2],*A2++[2]
||	STW	B$A[1][2],*B2++[2]
	STW	A$A[1][3],*A2++[2]
||	STW	B$A[1][3],*B2++[2]
	STW	A$A[1][4],*A2++[2]
||	STW	B$A[1][4],*B2++[2]

	STW	A$A[2][0],*A2++[2]
||	STW	B$A[2][0],*B2++[2]
	STW	A$A[2][1],*A2++[2]
||	STW	B$A[2][1],*B2++[2]
	STW	A$A[2][2],*A2++[2]
||	STW	B$A[2][2],*B2++[2]
	STW	A$A[2][3],*A2++[2]
||	STW	B$A[2][3],*B2++[2]
	STW	A$A[2][4],*A2++[2]
||	STW	B$A[2][4],*B2++[2]

	STW	A$A[3][0],*A2++[2]
||	STW	B$A[3][0],*B2++[2]
	STW	A$A[3][1],*A2++[2]
||	STW	B$A[3][1],*B2++[2]
	STW	A$A[3][2],*A2++[2]
||	STW	B$A[3][2],*B2++[2]
	STW	A$A[3][3],*A2++[2]
||	STW	B$A[3][3],*B2++[2]
	STW	A$A[3][4],*A2++[2]
||	STW	B$A[3][4],*B2++[2]

	LDW	*SP[15],RA
||	LDW	*FP[-6],A14

	STW	A$A[4][0],*A2++[2]
||	STW	B$A[4][0],*B2++[2]
	STW	A$A[4][1],*A2++[2]
||	STW	B$A[4][1],*B2++[2]
	STW	A$A[4][2],*A2++[2]
||	STW	B$A[4][2],*B2++[2]
	STW	A$A[4][3],*A2++[2]
||	STW	B$A[4][3],*B2++[2]
	STW	A$A[4][4],*A2
||	STW	B$A[4][4],*B2
||	ADDK	-192,A2				; rewind

	MV	A2,A4				; return original A4
||	LDDW	*SP[8], B11:B10
||	LDDW	*FP[-5],A11:A10
	LDDW	*SP[9], B13:B12
||	LDDW	*FP[-4],A13:A12
||	BNOP	RA
	LDW	*++SP(80),FP			; restore frame pointer
	NOP	4				; wait till FP is committed
	.endasmfunc

	.newblock
	.asg	B2,BSZ
	.asg	A2,INP
	.asg	A3,LEN
	.global	_SHA3_absorb
	.align	32
_SHA3_absorb:
	.asmfunc stack_usage(80)
	STW	FP,*SP--(80)			; save frame pointer
||	MV	SP,FP
	STDW	B13:B12,*SP[9]
||	STDW	A13:A12,*FP[-4]
	STDW	B11:B10,*SP[8]
||	STDW	A11:A10,*FP[-5]
	STW	RA, *SP[15]
||	STW	A14,*FP[-6]

	STW	A4,*SP[1]			; save A[][]
||	MV	B4,INP				; reassign arguments
||	MV	A6,LEN
||	MV	B6,BSZ
||	ADD	4,A4,B4

	LDW	*A4++[2],A$A[0][0]		; load A[5][5]
||	LDW	*B4++[2],B$A[0][0]
	LDW	*A4++[2],A$A[0][1]
||	LDW	*B4++[2],B$A[0][1]
	LDW	*A4++[2],A$A[0][2]
||	LDW	*B4++[2],B$A[0][2]
	LDW	*A4++[2],A$A[0][3]
||	LDW	*B4++[2],B$A[0][3]
	LDW	*A4++[2],A$A[0][4]
||	LDW	*B4++[2],B$A[0][4]

	LDW	*A4++[2],A$A[1][0]
||	LDW	*B4++[2],B$A[1][0]
	LDW	*A4++[2],A$A[1][1]
||	LDW	*B4++[2],B$A[1][1]
	LDW	*A4++[2],A$A[1][2]
||	LDW	*B4++[2],B$A[1][2]
	LDW	*A4++[2],A$A[1][3]
||	LDW	*B4++[2],B$A[1][3]
	LDW	*A4++[2],A$A[1][4]
||	LDW	*B4++[2],B$A[1][4]

	LDW	*A4++[2],A$A[2][0]
||	LDW	*B4++[2],B$A[2][0]
	LDW	*A4++[2],A$A[2][1]
||	LDW	*B4++[2],B$A[2][1]
	LDW	*A4++[2],A$A[2][2]
||	LDW	*B4++[2],B$A[2][2]
	LDW	*A4++[2],A$A[2][3]
||	LDW	*B4++[2],B$A[2][3]
	LDW	*A4++[2],A$A[2][4]
||	LDW	*B4++[2],B$A[2][4]

	LDW	*A4++[2],A$A[3][0]
||	LDW	*B4++[2],B$A[3][0]
	LDW	*A4++[2],A$A[3][1]
||	LDW	*B4++[2],B$A[3][1]
	LDW	*A4++[2],A$A[3][2]
||	LDW	*B4++[2],B$A[3][2]
	LDW	*A4++[2],A$A[3][3]
||	LDW	*B4++[2],B$A[3][3]
	LDW	*A4++[2],A$A[3][4]
||	LDW	*B4++[2],B$A[3][4]

	LDW	*A4++[2],A$A[4][0]
||	LDW	*B4++[2],B$A[4][0]
	LDW	*A4++[2],A$A[4][1]
||	LDW	*B4++[2],B$A[4][1]
	LDW	*A4++[2],A$A[4][2]
||	LDW	*B4++[2],B$A[4][2]
	LDW	*A4++[2],A$A[4][3]
||	LDW	*B4++[2],B$A[4][3]
	LDW	*A4,A$A[4][4]
||	LDW	*B4,B$A[4][4]
||	ADDKPC	loop?,RA
	STDW	RA:BSZ,*SP[4]

loop?:
	CMPLTU	LEN,BSZ,A0			; len < bsz?
||	SHRU	BSZ,3,BSZ
  [A0]	BNOP	ret?
||[A0]	ZERO	BSZ
||[A0]	LDW	*SP[1],A2			; pull A[][]
  [BSZ]	LDNDW	*INP++,A1:A0
||[BSZ]	SUB	LEN,8,LEN
||[BSZ]	SUB	BSZ,1,BSZ
	NOP	4
___
for ($y = 0; $y < 5; $y++) {
    for ($x = 0; $x < ($y<4 ? 5 : 4); $x++) {
$code.=<<___;
	.if	.BIG_ENDIAN
	SWAP2	A0,A1
||	SWAP2	A1,A0
	SWAP4	A0,A0
	SWAP4	A1,A1
||[!BSZ]BNOP	_KeccakF1600_cheat
||[!BSZ]STDW	LEN:INP,*SP[3]
||	DEAL	A0,A0
	.else
  [!BSZ]BNOP	_KeccakF1600_cheat
||[!BSZ]STDW	LEN:INP,*SP[3]
||	DEAL	A0,A0
	.endif
  [BSZ]	LDNDW	*INP++,A1:A0
||	DEAL	A1,A1
  [BSZ]	SUB	LEN,8,LEN
||[BSZ]	SUB	BSZ,1,BSZ
	PACK2	A1,A0,A0
||	PACKH2	A1,A0,A1
	XOR	A0,A$A[$y][$x],A$A[$y][$x]
	XOR	A1,B$A[$y][$x],B$A[$y][$x]
___
    }
}
$code.=<<___;
	.if	.BIG_ENDIAN
	SWAP2	A0,A1
||	SWAP2	A1,A0
	SWAP4	A0,A0
	SWAP4	A1,A1
	.endif
	BNOP	_KeccakF1600_cheat
||	STDW	LEN:INP,*SP[3]
||	DEAL	A0,A0
	DEAL	A1,A1
	NOP
	PACK2	A1,A0,A0
||	PACKH2	A1,A0,A1
	XOR	A0,A$A[4][4],A$A[4][4]
	XOR	A1,B$A[4][4],B$A[4][4]

	.align	16
ret?:
	MV	LEN,A4				; return value
||	ADD	4,A2,B2

	STW	A$A[0][0],*A2++[2]		; store A[5][5]
||	STW	B$A[0][0],*B2++[2]
	STW	A$A[0][1],*A2++[2]
||	STW	B$A[0][1],*B2++[2]
	STW	A$A[0][2],*A2++[2]
||	STW	B$A[0][2],*B2++[2]
	STW	A$A[0][3],*A2++[2]
||	STW	B$A[0][3],*B2++[2]
	STW	A$A[0][4],*A2++[2]
||	STW	B$A[0][4],*B2++[2]

	STW	A$A[1][0],*A2++[2]
||	STW	B$A[1][0],*B2++[2]
	STW	A$A[1][1],*A2++[2]
||	STW	B$A[1][1],*B2++[2]
	STW	A$A[1][2],*A2++[2]
||	STW	B$A[1][2],*B2++[2]
	STW	A$A[1][3],*A2++[2]
||	STW	B$A[1][3],*B2++[2]
	STW	A$A[1][4],*A2++[2]
||	STW	B$A[1][4],*B2++[2]

	STW	A$A[2][0],*A2++[2]
||	STW	B$A[2][0],*B2++[2]
	STW	A$A[2][1],*A2++[2]
||	STW	B$A[2][1],*B2++[2]
	STW	A$A[2][2],*A2++[2]
||	STW	B$A[2][2],*B2++[2]
	STW	A$A[2][3],*A2++[2]
||	STW	B$A[2][3],*B2++[2]
	STW	A$A[2][4],*A2++[2]
||	STW	B$A[2][4],*B2++[2]

	LDW	*SP[15],RA
||	LDW	*FP[-6],A14

	STW	A$A[3][0],*A2++[2]
||	STW	B$A[3][0],*B2++[2]
	STW	A$A[3][1],*A2++[2]
||	STW	B$A[3][1],*B2++[2]
	STW	A$A[3][2],*A2++[2]
||	STW	B$A[3][2],*B2++[2]
	STW	A$A[3][3],*A2++[2]
||	STW	B$A[3][3],*B2++[2]
	STW	A$A[3][4],*A2++[2]
||	STW	B$A[3][4],*B2++[2]

	LDDW	*SP[8], B11:B10
||	LDDW	*FP[-5],A11:A10
	LDDW	*SP[9], B13:B12
||	LDDW	*FP[-4],A13:A12
	BNOP	RA
||	LDW	*++SP(80),FP			; restore frame pointer

	STW	A$A[4][0],*A2++[2]
||	STW	B$A[4][0],*B2++[2]
	STW	A$A[4][1],*A2++[2]
||	STW	B$A[4][1],*B2++[2]
	STW	A$A[4][2],*A2++[2]
||	STW	B$A[4][2],*B2++[2]
	STW	A$A[4][3],*A2++[2]
||	STW	B$A[4][3],*B2++[2]
	STW	A$A[4][4],*A2++[2]
||	STW	B$A[4][4],*B2++[2]
	.endasmfunc

	.newblock
	.global	_SHA3_squeeze
	.asg	A12,OUT
	.asg	A13,LEN
	.asg	A14,BSZ
	.align	32
_SHA3_squeeze:
	.asmfunc stack_usage(24)
	STW	FP,*SP--(24)			; save frame pointer
||	MV	SP,FP
	STW	RA, *SP[5]
||	STW	A14,*FP[-2]
	STDW	A13:A12,*FP[-2]
||	MV	B4,OUT				; reassign arguments
	MV	A6,LEN
||	MV	B6,BSZ

loop?:
	LDW	*SP[5],RA			; reload RA
||	SHRU	BSZ,3,A1
||	MV	A4,A8
||	ADD	4,A4,B8
block?:
	CMPLTU	LEN,8,A0			; len < 8?
  [A0]	BNOP	tail?
	LDW	*A8++[2],A9
||	LDW	*B8++[2],B9
||	SUB	LEN,8,LEN			; len -= 8
	MV	LEN,A0
||	SUB	A1,1,A1				; bsz--
||	NOP	4
	.if	.BIG_ENDIAN
	SWAP4	A9,A9
||	SWAP4	B9,B9
	SWAP2	A9,A9
||	SWAP2	B9,B9
	.endif
  [!A0]	BNOP	ret?
||[!A0]	ZERO	A1
	PACK2	B9,A9,B7
||[A1]	BNOP	block?
	PACKH2	B9,A9,B9
||	SHFL	B7,B7
	SHFL	B9,B9
	STNW	B7,*OUT++
	STNW	B9,*OUT++
	NOP

	BNOP	_KeccakF1600,4
	ADDKPC	loop?,RA

	.align	16
tail?:
	.if	.BIG_ENDIAN
	SWAP4	A9,A9
||	SWAP4	B9,B9
	SWAP2	A9,A9
||	SWAP2	B9,B9
	.endif
	PACK2	B9,A9,B7
	PACKH2	B9,A9,B9
||	SHFL	B7,B7
	SHFL	B9,B9

	STB	B7,*OUT++
||	SHRU	B7,8,B7
||	ADD	LEN,7,A0
  [A0]	STB	B7,*OUT++
||[A0]	SHRU	B7,8,B7
||[A0]	SUB	A0,1,A0
  [A0]	STB	B7,*OUT++
||[A0]	SHRU	B7,8,B7
||[A0]	SUB	A0,1,A0
  [A0]	STB	B7,*OUT++
||[A0]	SUB	A0,1,A0
  [A0]	STB	B9,*OUT++
||[A0]	SHRU	B9,8,B9
||[A0]	SUB	A0,1,A0
  [A0]	STB	B9,*OUT++
||[A0]	SHRU	B9,8,B9
||[A0]	SUB	A0,1,A0
  [A0]	STB	B9,*OUT++

ret?:
	LDDW	*FP[-2],A13:A12
	BNOP	RA
||	LDW	*FP[-2],A14
	LDW	*++SP(24),FP			; restore frame pointer
	NOP	4				; wait till FP is committed
	.endasmfunc

	.if	__TI_EABI__
	.sect	".text:sha_asm.const"
	.else
	.sect	".const:sha_asm"
	.endif
	.align	256
	.uword	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
iotas:
	.uword	0x00000001, 0x00000000
	.uword	0x00000000, 0x00000089
	.uword	0x00000000, 0x8000008b
	.uword	0x00000000, 0x80008080
	.uword	0x00000001, 0x0000008b
	.uword	0x00000001, 0x00008000
	.uword	0x00000001, 0x80008088
	.uword	0x00000001, 0x80000082
	.uword	0x00000000, 0x0000000b
	.uword	0x00000000, 0x0000000a
	.uword	0x00000001, 0x00008082
	.uword	0x00000000, 0x00008003
	.uword	0x00000001, 0x0000808b
	.uword	0x00000001, 0x8000000b
	.uword	0x00000001, 0x8000008a
	.uword	0x00000001, 0x80000081
	.uword	0x00000000, 0x80000081
	.uword	0x00000000, 0x80000008
	.uword	0x00000000, 0x00000083
	.uword	0x00000000, 0x80008003
	.uword	0x00000001, 0x80008088
	.uword	0x00000000, 0x80000088
	.uword	0x00000001, 0x00008000
	.uword	0x00000000, 0x80008082

	.cstring "Keccak-1600 absorb and squeeze for C64x, CRYPTOGAMS by <appro\@openssl.org>"
	.align	4
___

$output=pop;
open STDOUT,">$output";
print $code;
close STDOUT or die "error closing STDOUT: $!";


#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# Keccak-1600 for x86 MMX.
#
# June 2017.
#
# Below code is KECCAK_2X implementation (see sha/keccak1600.c) with
# C[5] held in register bank and D[5] offloaded to memory. Though
# instead of actually unrolling the loop pair-wise I simply flip
# pointers to T[][] and A[][] and the end of round. Since number of
# rounds is even, last round writes to A[][] and everything works out.
# It's argued that MMX is the only code path meaningful to implement
# for x86. This is because non-MMX-capable processors is an extinct
# breed, and they as well can lurk executing compiler-generated code.
# For reference gcc-5.x-generated KECCAK_2X code takes 89 cycles per
# processed byte on Pentium. Which is fair result. But older compilers
# produce worse code. On the other hand one can wonder why not 128-bit
# SSE2? Well, SSE2 won't provide double improvement, rather far from
# that, if any at all on some processors, because it will take extra
# permutations and inter-bank data transfers. Besides, contemporary
# CPUs are better off executing 64-bit code, and it makes lesser sense
# to invest into fancy 32-bit code. And the decision doesn't seem to
# be inadequate, if one compares below results to "64-bit platforms in
# 32-bit mode" SIMD data points available at
# http://keccak.noekeon.org/sw_performance.html.
#
########################################################################
# Numbers are cycles per processed byte out of large message.
#
#			r=1088(i)
#
# PIII			30/+150%
# Pentium M		27/+150%
# P4			40/+85%
# Core 2		19/+170%
# Sandy Bridge(ii)	18/+140%
# Atom			33/+180%
# Silvermont(ii)	30/+180%
# VIA Nano(ii)		43/+60%
# Sledgehammer(ii)(iii)	24/+130%
#
# (i)	Corresponds to SHA3-256. Numbers after slash are improvement
#	coefficients over KECCAK_2X [with bit interleave and lane
#	complementing] position-independent *scalar* code generated
#	by gcc-5.x. It's not exactly fair comparison, but it's a
#	datapoint...
# (ii)	64-bit processor executing 32-bit code.
# (iii)	Result is considered to be representative even for older AMD
#	processors.

$0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1;
push(@INC,"${dir}","${dir}../../perlasm");
require "x86asm.pl";

$output=pop;
open STDOUT,">$output";

&asm_init($ARGV[0],$ARGV[$#ARGV] eq "386");

my @C = map("mm$_",(0..4));
my @T = map("mm$_",(5..7));
my @A = map([ 8*$_-100, 8*($_+1)-100, 8*($_+2)-100,
              8*($_+3)-100, 8*($_+4)-100 ], (0,5,10,15,20));
my @D = map(8*$_+4, (0..4));
my @rhotates = ([  0,  1, 62, 28, 27 ],
                [ 36, 44,  6, 55, 20 ],
                [  3, 10, 43, 25, 39 ],
                [ 41, 45, 15, 21,  8 ],
                [ 18,  2, 61, 56, 14 ]);

&static_label("iotas");

&function_begin_B("_KeccakF1600");
	&movq	(@C[0],&QWP($A[4][0],"esi"));
	&movq	(@C[1],&QWP($A[4][1],"esi"));
	&movq	(@C[2],&QWP($A[4][2],"esi"));
	&movq	(@C[3],&QWP($A[4][3],"esi"));
	&movq	(@C[4],&QWP($A[4][4],"esi"));

	&mov	("ecx",24);			# loop counter
	&jmp	(&label("loop"));

    &set_label("loop",16);
	######################################### Theta
	&pxor	(@C[0],&QWP($A[0][0],"esi"));
	&pxor	(@C[1],&QWP($A[0][1],"esi"));
	&pxor	(@C[2],&QWP($A[0][2],"esi"));
	&pxor	(@C[3],&QWP($A[0][3],"esi"));
	&pxor	(@C[4],&QWP($A[0][4],"esi"));

	&pxor	(@C[0],&QWP($A[1][0],"esi"));
	&pxor	(@C[1],&QWP($A[1][1],"esi"));
	&pxor	(@C[2],&QWP($A[1][2],"esi"));
	&pxor	(@C[3],&QWP($A[1][3],"esi"));
	&pxor	(@C[4],&QWP($A[1][4],"esi"));

	&pxor	(@C[0],&QWP($A[2][0],"esi"));
	&pxor	(@C[1],&QWP($A[2][1],"esi"));
	&pxor	(@C[2],&QWP($A[2][2],"esi"));
	&pxor	(@C[3],&QWP($A[2][3],"esi"));
	&pxor	(@C[4],&QWP($A[2][4],"esi"));

	&pxor	(@C[2],&QWP($A[3][2],"esi"));
	&pxor	(@C[0],&QWP($A[3][0],"esi"));
	&pxor	(@C[1],&QWP($A[3][1],"esi"));
	&pxor	(@C[3],&QWP($A[3][3],"esi"));
	 &movq	(@T[0],@C[2]);
	&pxor	(@C[4],&QWP($A[3][4],"esi"));

	 &movq	(@T[2],@C[2]);
	 &psrlq	(@T[0],63);
	&movq	(@T[1],@C[0]);
	 &psllq	(@T[2],1);
	 &pxor	(@T[0],@C[0]);
	&psrlq	(@C[0],63);
	 &pxor	(@T[0],@T[2]);
	&psllq	(@T[1],1);
	 &movq	(@T[2],@C[1]);
	 &movq	(&QWP(@D[1],"esp"),@T[0]);	# D[1] = E[0] = ROL64(C[2], 1) ^ C[0];

	&pxor	(@T[1],@C[0]);
	 &psrlq	(@T[2],63);
	&pxor	(@T[1],@C[3]);
	 &movq	(@C[0],@C[1]);
	&movq	(&QWP(@D[4],"esp"),@T[1]);	# D[4] = E[1] = ROL64(C[0], 1) ^ C[3];

	 &psllq	(@C[0],1);
	 &pxor	(@T[2],@C[4]);
	 &pxor	(@C[0],@T[2]);

	&movq	(@T[2],@C[3]);
	&psrlq	(@C[3],63);
	 &movq	(&QWP(@D[0],"esp"),@C[0]);	# D[0] = C[0] = ROL64(C[1], 1) ^ C[4];
	&psllq	(@T[2],1);
	 &movq	(@T[0],@C[4]);
	 &psrlq	(@C[4],63);
	&pxor	(@C[1],@C[3]);
	 &psllq	(@T[0],1);
	&pxor	(@C[1],@T[2]);
	 &pxor	(@C[2],@C[4]);
	&movq	(&QWP(@D[2],"esp"),@C[1]);	# D[2] = C[1] = ROL64(C[3], 1) ^ C[1];
	 &pxor	(@C[2],@T[0]);

	######################################### first Rho(0) is special
	&movq	(@C[3],&QWP($A[3][3],"esi"));
	 &movq	(&QWP(@D[3],"esp"),@C[2]);	# D[3] = C[2] = ROL64(C[4], 1) ^ C[2];
	&pxor	(@C[3],@C[2]);
	 &movq	(@C[4],&QWP($A[4][4],"esi"));
	&movq	(@T[2],@C[3]);
	&psrlq	(@C[3],64-$rhotates[3][3]);
	 &pxor	(@C[4],@T[1]);
	&psllq	(@T[2],$rhotates[3][3]);
	 &movq	(@T[1],@C[4]);
	 &psrlq	(@C[4],64-$rhotates[4][4]);
	&por	(@C[3],@T[2]);		# C[3] = ROL64(A[3][3] ^ C[2], rhotates[3][3]);   /* D[3] */
	 &psllq	(@T[1],$rhotates[4][4]);

	&movq	(@C[2],&QWP($A[2][2],"esi"));
	 &por	(@C[4],@T[1]);		# C[4] = ROL64(A[4][4] ^ E[1], rhotates[4][4]);   /* D[4] */
	&pxor	(@C[2],@C[1]);
	 &movq	(@C[1],&QWP($A[1][1],"esi"));
	&movq	(@T[1],@C[2]);
	&psrlq	(@C[2],64-$rhotates[2][2]);
	 &pxor	(@C[1],&QWP(@D[1],"esp"));
	&psllq	(@T[1],$rhotates[2][2]);

	 &movq	(@T[2],@C[1]);
	 &psrlq	(@C[1],64-$rhotates[1][1]);
	&por	(@C[2],@T[1]);		# C[2] = ROL64(A[2][2] ^ C[1], rhotates[2][2]);   /* D[2] */
	 &psllq	(@T[2],$rhotates[1][1]);
	&pxor	(@C[0],&QWP($A[0][0],"esi")); # /* rotate by 0 */  /* D[0] */
	 &por	(@C[1],@T[2]);		# C[1] = ROL64(A[1][1] ^ D[1], rhotates[1][1]);

sub Chi() {				######### regular Chi step
    my ($y,$xrho) = @_;

	&movq	(@T[0],@C[1]);
	 &movq	(@T[1],@C[2]);
	&pandn	(@T[0],@C[2]);
	 &pandn	(@C[2],@C[3]);
	&pxor	(@T[0],@C[0]);
	 &pxor	(@C[2],@C[1]);
	&pxor	(@T[0],&QWP(0,"ebx"))		if ($y == 0);
	&lea	("ebx",&DWP(8,"ebx"))		if ($y == 0);

	&movq	(@T[2],@C[3]);
	&movq	(&QWP($A[$y][0],"edi"),@T[0]);	# R[0][0] = C[0] ^ (~C[1] & C[2]) ^ iotas[i];
	 &movq	(@T[0],@C[4]);
	&pandn	(@C[3],@C[4]);
	 &pandn	(@C[4],@C[0]);
	&pxor	(@C[3],@T[1]);
	 &movq	(&QWP($A[$y][1],"edi"),@C[2]);	# R[0][1] = C[1] ^ (~C[2] & C[3]);
	 &pxor	(@C[4],@T[2]);
	  &movq	(@T[2],&QWP($A[0][$xrho],"esi"))	if (defined($xrho));

	 &movq	(&QWP($A[$y][2],"edi"),@C[3]);	# R[0][2] = C[2] ^ (~C[3] & C[4]);
	&pandn	(@C[0],@C[1]);
	 &movq	(&QWP($A[$y][3],"edi"),@C[4]);	# R[0][3] = C[3] ^ (~C[4] & C[0]);
	&pxor	(@C[0],@T[0]);
	  &pxor	(@T[2],&QWP(@D[$xrho],"esp"))		if (defined($xrho));
	&movq	(&QWP($A[$y][4],"edi"),@C[0]);	# R[0][4] = C[4] ^ (~C[0] & C[1]);
}
	&Chi	(0, 3);

sub Rho() {				######### regular Rho step
    my $x = shift;

	#&movq	(@T[2],&QWP($A[0][$x],"esi"));	# moved to Chi
	#&pxor	(@T[2],&QWP(@D[$x],"esp"));	# moved to Chi
	&movq	(@C[0],@T[2]);
	&psrlq	(@T[2],64-$rhotates[0][$x]);
	 &movq	(@C[1],&QWP($A[1][($x+1)%5],"esi"));
	&psllq	(@C[0],$rhotates[0][$x]);
	 &pxor	(@C[1],&QWP(@D[($x+1)%5],"esp"));
	&por	(@C[0],@T[2]);		# C[0] = ROL64(A[0][3] ^ D[3], rhotates[0][3]);

	 &movq	(@T[1],@C[1]);
	 &psrlq	(@C[1],64-$rhotates[1][($x+1)%5]);
	&movq	(@C[2],&QWP($A[2][($x+2)%5],"esi"));
	 &psllq	(@T[1],$rhotates[1][($x+1)%5]);
	&pxor	(@C[2],&QWP(@D[($x+2)%5],"esp"));
	 &por	(@C[1],@T[1]);		# C[1] = ROL64(A[1][4] ^ D[4], rhotates[1][4]);

	&movq	(@T[2],@C[2]);
	&psrlq	(@C[2],64-$rhotates[2][($x+2)%5]);
	 &movq	(@C[3],&QWP($A[3][($x+3)%5],"esi"));
	&psllq	(@T[2],$rhotates[2][($x+2)%5]);
	 &pxor	(@C[3],&QWP(@D[($x+3)%5],"esp"));
	&por	(@C[2],@T[2]);		# C[2] = ROL64(A[2][0] ^ D[0], rhotates[2][0]);

	 &movq	(@T[0],@C[3]);
	 &psrlq	(@C[3],64-$rhotates[3][($x+3)%5]);
	&movq	(@C[4],&QWP($A[4][($x+4)%5],"esi"));
	 &psllq	(@T[0],$rhotates[3][($x+3)%5]);
	&pxor	(@C[4],&QWP(@D[($x+4)%5],"esp"));
	 &por	(@C[3],@T[0]);		# C[3] = ROL64(A[3][1] ^ D[1], rhotates[3][1]);

	&movq	(@T[1],@C[4]);
	&psrlq	(@C[4],64-$rhotates[4][($x+4)%5]);
	&psllq	(@T[1],$rhotates[4][($x+4)%5]);
	&por	(@C[4],@T[1]);		# C[4] = ROL64(A[4][2] ^ D[2], rhotates[4][2]);
}
	&Rho	(3);	&Chi	(1, 1);
	&Rho	(1);	&Chi	(2, 4);
	&Rho	(4);	&Chi	(3, 2);
	&Rho	(2);	###&Chi	(4);

	&movq	(@T[0],@C[0]);		######### last Chi(4) is special
	 &xor	("edi","esi");		# &xchg	("esi","edi");
	&movq	(&QWP(@D[1],"esp"),@C[1]);
	 &xor	("esi","edi");
	 &xor	("edi","esi");

	&movq	(@T[1],@C[1]);
	 &movq	(@T[2],@C[2]);
	&pandn	(@T[1],@C[2]);
	 &pandn	(@T[2],@C[3]);
	&pxor	(@C[0],@T[1]);
	 &pxor	(@C[1],@T[2]);

	&movq	(@T[1],@C[3]);
	 &movq	(&QWP($A[4][0],"esi"),@C[0]);	# R[4][0] = C[0] ^= (~C[1] & C[2]);
	&pandn	(@T[1],@C[4]);
	 &movq	(&QWP($A[4][1],"esi"),@C[1]);	# R[4][1] = C[1] ^= (~C[2] & C[3]);
	&pxor	(@C[2],@T[1]);
	 &movq	(@T[2],@C[4]);
	&movq	(&QWP($A[4][2],"esi"),@C[2]);	# R[4][2] = C[2] ^= (~C[3] & C[4]);

	&pandn	(@T[2],@T[0]);
	 &pandn	(@T[0],&QWP(@D[1],"esp"));
	&pxor	(@C[3],@T[2]);
	 &pxor	(@C[4],@T[0]);
	&movq	(&QWP($A[4][3],"esi"),@C[3]);	# R[4][3] = C[3] ^= (~C[4] & D[0]);
	&sub	("ecx",1);
	 &movq	(&QWP($A[4][4],"esi"),@C[4]);	# R[4][4] = C[4] ^= (~D[0] & D[1]);
	&jnz	(&label("loop"));

	&lea	("ebx",&DWP(-192,"ebx"));	# rewind iotas
	&ret	();
&function_end_B("_KeccakF1600");

&function_begin("KeccakF1600");
	&mov	("esi",&wparam(0));
	&mov	("ebp","esp");
	&sub	("esp",240);
	&call	(&label("pic_point"));
    &set_label("pic_point");
	&blindpop("ebx");
	&lea	("ebx",&DWP(&label("iotas")."-".&label("pic_point"),"ebx"));
	&and	("esp",-8);
	&lea	("esi",&DWP(100,"esi"));	# size optimization
	&lea	("edi",&DWP(8*5+100,"esp"));	# size optimization

	&call	("_KeccakF1600");

	&mov	("esp","ebp");
	&emms	();
&function_end("KeccakF1600");

&function_begin("SHA3_absorb");
	&mov	("esi",&wparam(0));		# A[][]
	&mov	("eax",&wparam(1));		# inp
	&mov	("ecx",&wparam(2));		# len
	&mov	("edx",&wparam(3));		# bsz
	&mov	("ebp","esp");
	&sub	("esp",240+8);
	&call	(&label("pic_point"));
    &set_label("pic_point");
	&blindpop("ebx");
	&lea	("ebx",&DWP(&label("iotas")."-".&label("pic_point"),"ebx"));
	&and	("esp",-8);

	&mov	("edi","esi");
	&lea	("esi",&DWP(100,"esi"));	# size optimization
	&mov	(&DWP(-4,"ebp"),"edx");		# save bsz
	&jmp	(&label("loop"));

&set_label("loop",16);
	&cmp	("ecx","edx");			# len < bsz?
	&jc	(&label("absorbed"));

	&shr	("edx",3);			# bsz /= 8
&set_label("block");
	&movq	("mm0",&QWP(0,"eax"));
	&lea	("eax",&DWP(8,"eax"));
	&pxor	("mm0",&QWP(0,"edi"));
	&lea	("edi",&DWP(8,"edi"));
	&sub	("ecx",8);			# len -= 8
	&movq	(&QWP(-8,"edi"),"mm0");
	&dec	("edx");			# bsz--
	&jnz	(&label("block"));

	&lea	("edi",&DWP(8*5+100,"esp"));	# size optimization
	&mov	(&DWP(-8,"ebp"),"ecx");		# save len
	&call	("_KeccakF1600");
	&mov	("ecx",&DWP(-8,"ebp"));		# pull len
	&mov	("edx",&DWP(-4,"ebp"));		# pull bsz
	&lea	("edi",&DWP(-100,"esi"));
	&jmp	(&label("loop"));

&set_label("absorbed",16);
	&mov	("eax","ecx");			# return value
	&mov	("esp","ebp");
	&emms	();
&function_end("SHA3_absorb");

&function_begin("SHA3_squeeze");
	&mov	("esi",&wparam(0));		# A[][]
	&mov	("eax",&wparam(1));		# out
	&mov	("ecx",&wparam(2));		# len
	&mov	("edx",&wparam(3));		# bsz
	&mov	("ebp","esp");
	&sub	("esp",240+8);
	&call	(&label("pic_point"));
    &set_label("pic_point");
	&blindpop("ebx");
	&lea	("ebx",&DWP(&label("iotas")."-".&label("pic_point"),"ebx"));
	&and	("esp",-8);

	&shr	("edx",3);			# bsz /= 8
	&mov	("edi","esi");
	&lea	("esi",&DWP(100,"esi"));	# size optimization
	&mov	(&DWP(-4,"ebp"),"edx");		# save bsz
	&jmp	(&label("loop"));

&set_label("loop",16);
	&cmp	("ecx",8);			# len < 8?
	&jc	(&label("tail"));

	&movq	("mm0",&QWP(0,"edi"));
	&lea	("edi",&DWP(8,"edi"));
	&movq	(&QWP(0,"eax"),"mm0");
	&lea	("eax",&DWP(8,"eax"));
	&sub	("ecx",8);			# len -= 8
	&jz	(&label("done"));

	&dec	("edx");			# bsz--
	&jnz	(&label("loop"));

	&lea	("edi",&DWP(8*5+100,"esp"));	# size optimization
	&mov	(&DWP(-8,"ebp"),"ecx");		# save len
	&call	("_KeccakF1600");
	&mov	("ecx",&DWP(-8,"ebp"));		# pull len
	&mov	("edx",&DWP(-4,"ebp"));		# pull bsz
	&lea	("edi",&DWP(-100,"esi"));
	&jmp	(&label("loop"));

&set_label("tail",16);
	&mov	("esi","edi");
	&mov	("edi","eax");
	&data_word("0xA4F39066");		# rep movsb

&set_label("done");
	&mov	("esp","ebp");
	&emms	();
&function_end("SHA3_squeeze");

&set_label("iotas",32);
	&data_word(0x00000001,0x00000000);
	&data_word(0x00008082,0x00000000);
	&data_word(0x0000808a,0x80000000);
	&data_word(0x80008000,0x80000000);
	&data_word(0x0000808b,0x00000000);
	&data_word(0x80000001,0x00000000);
	&data_word(0x80008081,0x80000000);
	&data_word(0x00008009,0x80000000);
	&data_word(0x0000008a,0x00000000);
	&data_word(0x00000088,0x00000000);
	&data_word(0x80008009,0x00000000);
	&data_word(0x8000000a,0x00000000);
	&data_word(0x8000808b,0x00000000);
	&data_word(0x0000008b,0x80000000);
	&data_word(0x00008089,0x80000000);
	&data_word(0x00008003,0x80000000);
	&data_word(0x00008002,0x80000000);
	&data_word(0x00000080,0x80000000);
	&data_word(0x0000800a,0x00000000);
	&data_word(0x8000000a,0x80000000);
	&data_word(0x80008081,0x80000000);
	&data_word(0x00008080,0x80000000);
	&data_word(0x80000001,0x00000000);
	&data_word(0x80008008,0x80000000);
&asciz("Keccak-1600 absorb and squeeze for MMX, CRYPTOGAMS by <appro\@openssl.org>");

&asm_finish();

close STDOUT or die "error closing STDOUT: $!";


#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# Keccak-1600 for PPC64.
#
# June 2017.
#
# This is straightforward KECCAK_1X_ALT implementation that works on
# *any* PPC64. Then PowerISA 2.07 adds 2x64-bit vector rotate, and
# it's possible to achieve performance better than below, but that is
# naturally option only for POWER8 and successors...
#
######################################################################
# Numbers are cycles per processed byte.
#
#		r=1088(*)
#
# PPC970/G5	14.6/+120%
# POWER7	10.3/+100%
# POWER8	11.5/+85%
# POWER9	9.4/+45%
#
# (*)	Corresponds to SHA3-256. Percentage after slash is improvement
#	over gcc-4.x-generated KECCAK_1X_ALT code. Newer compilers do
#	much better (but watch out for them generating code specific
#	to processor they execute on).

$flavour = shift;

if ($flavour =~ /64/) {
	$SIZE_T	=8;
	$LRSAVE	=2*$SIZE_T;
	$UCMP	="cmpld";
	$STU	="stdu";
	$POP	="ld";
	$PUSH	="std";
} else { die "nonsense $flavour"; }

$0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1;
( $xlate="${dir}ppc-xlate.pl" and -f $xlate ) or
( $xlate="${dir}../../perlasm/ppc-xlate.pl" and -f $xlate) or
die "can't locate ppc-xlate.pl";

open STDOUT,"| $^X $xlate $flavour ".shift || die "can't call $xlate: $!";

$FRAME=24*$SIZE_T+6*$SIZE_T+32;
$LOCALS=6*$SIZE_T;
$TEMP=$LOCALS+6*$SIZE_T;

my $sp ="r1";

my @A = map([ "r$_", "r".($_+1), "r".($_+2), "r".($_+3), "r".($_+4) ],
            (7, 12, 17, 22, 27));
   $A[1][1] = "r6"; # r13 is reserved

my @C = map("r$_", (0,3,4,5));

my @rhotates = ([  0,  1, 62, 28, 27 ],
                [ 36, 44,  6, 55, 20 ],
                [  3, 10, 43, 25, 39 ],
                [ 41, 45, 15, 21,  8 ],
                [ 18,  2, 61, 56, 14 ]);

$code.=<<___;
.text

.type	KeccakF1600_int,\@function
.align	5
KeccakF1600_int:
	li	r0,24
	mtctr	r0
	b	.Loop
.align	4
.Loop:
	xor	$C[0],$A[0][0],$A[1][0]		; Theta
	std	$A[0][4],`$TEMP+0`($sp)
	xor	$C[1],$A[0][1],$A[1][1]
	std	$A[1][4],`$TEMP+8`($sp)
	xor	$C[2],$A[0][2],$A[1][2]
	std	$A[2][4],`$TEMP+16`($sp)
	xor	$C[3],$A[0][3],$A[1][3]
	std	$A[3][4],`$TEMP+24`($sp)
___
	$C[4]=$A[0][4];
	$C[5]=$A[1][4];
	$C[6]=$A[2][4];
	$C[7]=$A[3][4];
$code.=<<___;
	xor	$C[4],$A[0][4],$A[1][4]
	xor	$C[0],$C[0],$A[2][0]
	xor	$C[1],$C[1],$A[2][1]
	xor	$C[2],$C[2],$A[2][2]
	xor	$C[3],$C[3],$A[2][3]
	xor	$C[4],$C[4],$A[2][4]
	xor	$C[0],$C[0],$A[3][0]
	xor	$C[1],$C[1],$A[3][1]
	xor	$C[2],$C[2],$A[3][2]
	xor	$C[3],$C[3],$A[3][3]
	xor	$C[4],$C[4],$A[3][4]
	xor	$C[0],$C[0],$A[4][0]
	xor	$C[2],$C[2],$A[4][2]
	xor	$C[1],$C[1],$A[4][1]
	xor	$C[3],$C[3],$A[4][3]
	rotldi	$C[5],$C[2],1
	xor	$C[4],$C[4],$A[4][4]
	rotldi	$C[6],$C[3],1
	xor	$C[5],$C[5],$C[0]
	rotldi	$C[7],$C[4],1

	xor	$A[0][1],$A[0][1],$C[5]
	xor	$A[1][1],$A[1][1],$C[5]
	xor	$A[2][1],$A[2][1],$C[5]
	xor	$A[3][1],$A[3][1],$C[5]
	xor	$A[4][1],$A[4][1],$C[5]

	rotldi	$C[5],$C[0],1
	xor	$C[6],$C[6],$C[1]
	xor	$C[2],$C[2],$C[7]
	rotldi	$C[7],$C[1],1
	xor	$C[3],$C[3],$C[5]
	xor	$C[4],$C[4],$C[7]

	xor	$C[1],   $A[0][2],$C[6]			;mr	$C[1],$A[0][2]
	xor	$A[1][2],$A[1][2],$C[6]
	xor	$A[2][2],$A[2][2],$C[6]
	xor	$A[3][2],$A[3][2],$C[6]
	xor	$A[4][2],$A[4][2],$C[6]

	xor	$A[0][0],$A[0][0],$C[4]
	xor	$A[1][0],$A[1][0],$C[4]
	xor	$A[2][0],$A[2][0],$C[4]
	xor	$A[3][0],$A[3][0],$C[4]
	xor	$A[4][0],$A[4][0],$C[4]
___
	$C[4]=undef;
	$C[5]=undef;
	$C[6]=undef;
	$C[7]=undef;
$code.=<<___;
	ld	$A[0][4],`$TEMP+0`($sp)
	xor	$C[0],   $A[0][3],$C[2]			;mr	$C[0],$A[0][3]
	ld	$A[1][4],`$TEMP+8`($sp)
	xor	$A[1][3],$A[1][3],$C[2]
	ld	$A[2][4],`$TEMP+16`($sp)
	xor	$A[2][3],$A[2][3],$C[2]
	ld	$A[3][4],`$TEMP+24`($sp)
	xor	$A[3][3],$A[3][3],$C[2]
	xor	$A[4][3],$A[4][3],$C[2]

	xor	$C[2],   $A[0][4],$C[3]			;mr	$C[2],$A[0][4]
	xor	$A[1][4],$A[1][4],$C[3]
	xor	$A[2][4],$A[2][4],$C[3]
	xor	$A[3][4],$A[3][4],$C[3]
	xor	$A[4][4],$A[4][4],$C[3]

	mr	$C[3],$A[0][1]				; Rho+Pi
	rotldi	$A[0][1],$A[1][1],$rhotates[1][1]
	;mr	$C[1],$A[0][2]
	rotldi	$A[0][2],$A[2][2],$rhotates[2][2]
	;mr	$C[0],$A[0][3]
	rotldi	$A[0][3],$A[3][3],$rhotates[3][3]
	;mr	$C[2],$A[0][4]
	rotldi	$A[0][4],$A[4][4],$rhotates[4][4]

	rotldi	$A[1][1],$A[1][4],$rhotates[1][4]
	rotldi	$A[2][2],$A[2][3],$rhotates[2][3]
	rotldi	$A[3][3],$A[3][2],$rhotates[3][2]
	rotldi	$A[4][4],$A[4][1],$rhotates[4][1]

	rotldi	$A[1][4],$A[4][2],$rhotates[4][2]
	rotldi	$A[2][3],$A[3][4],$rhotates[3][4]
	rotldi	$A[3][2],$A[2][1],$rhotates[2][1]
	rotldi	$A[4][1],$A[1][3],$rhotates[1][3]

	rotldi	$A[4][2],$A[2][4],$rhotates[2][4]
	rotldi	$A[3][4],$A[4][3],$rhotates[4][3]
	rotldi	$A[2][1],$A[1][2],$rhotates[1][2]
	rotldi	$A[1][3],$A[3][1],$rhotates[3][1]

	rotldi	$A[2][4],$A[4][0],$rhotates[4][0]
	rotldi	$A[4][3],$A[3][0],$rhotates[3][0]
	rotldi	$A[1][2],$A[2][0],$rhotates[2][0]
	rotldi	$A[3][1],$A[1][0],$rhotates[1][0]

	rotldi	$A[1][0],$C[0],$rhotates[0][3]
	rotldi	$A[2][0],$C[3],$rhotates[0][1]
	rotldi	$A[3][0],$C[2],$rhotates[0][4]
	rotldi	$A[4][0],$C[1],$rhotates[0][2]

	andc	$C[0],$A[0][2],$A[0][1]			; Chi+Iota
	andc	$C[1],$A[0][3],$A[0][2]
	andc	$C[2],$A[0][0],$A[0][4]
	andc	$C[3],$A[0][1],$A[0][0]
	xor	$A[0][0],$A[0][0],$C[0]
	andc	$C[0],$A[0][4],$A[0][3]
	xor	$A[0][1],$A[0][1],$C[1]
	 ld	$C[1],`$LOCALS+4*$SIZE_T`($sp)
	xor	$A[0][3],$A[0][3],$C[2]
	xor	$A[0][4],$A[0][4],$C[3]
	xor	$A[0][2],$A[0][2],$C[0]
	 ldu	$C[3],8($C[1])				; Iota[i++]

	andc	$C[0],$A[1][2],$A[1][1]
	 std	$C[1],`$LOCALS+4*$SIZE_T`($sp)
	andc	$C[1],$A[1][3],$A[1][2]
	andc	$C[2],$A[1][0],$A[1][4]
	 xor	$A[0][0],$A[0][0],$C[3]			; A[0][0] ^= Iota
	andc	$C[3],$A[1][1],$A[1][0]
	xor	$A[1][0],$A[1][0],$C[0]
	andc	$C[0],$A[1][4],$A[1][3]
	xor	$A[1][1],$A[1][1],$C[1]
	xor	$A[1][3],$A[1][3],$C[2]
	xor	$A[1][4],$A[1][4],$C[3]
	xor	$A[1][2],$A[1][2],$C[0]

	andc	$C[0],$A[2][2],$A[2][1]
	andc	$C[1],$A[2][3],$A[2][2]
	andc	$C[2],$A[2][0],$A[2][4]
	andc	$C[3],$A[2][1],$A[2][0]
	xor	$A[2][0],$A[2][0],$C[0]
	andc	$C[0],$A[2][4],$A[2][3]
	xor	$A[2][1],$A[2][1],$C[1]
	xor	$A[2][3],$A[2][3],$C[2]
	xor	$A[2][4],$A[2][4],$C[3]
	xor	$A[2][2],$A[2][2],$C[0]

	andc	$C[0],$A[3][2],$A[3][1]
	andc	$C[1],$A[3][3],$A[3][2]
	andc	$C[2],$A[3][0],$A[3][4]
	andc	$C[3],$A[3][1],$A[3][0]
	xor	$A[3][0],$A[3][0],$C[0]
	andc	$C[0],$A[3][4],$A[3][3]
	xor	$A[3][1],$A[3][1],$C[1]
	xor	$A[3][3],$A[3][3],$C[2]
	xor	$A[3][4],$A[3][4],$C[3]
	xor	$A[3][2],$A[3][2],$C[0]

	andc	$C[0],$A[4][2],$A[4][1]
	andc	$C[1],$A[4][3],$A[4][2]
	andc	$C[2],$A[4][0],$A[4][4]
	andc	$C[3],$A[4][1],$A[4][0]
	xor	$A[4][0],$A[4][0],$C[0]
	andc	$C[0],$A[4][4],$A[4][3]
	xor	$A[4][1],$A[4][1],$C[1]
	xor	$A[4][3],$A[4][3],$C[2]
	xor	$A[4][4],$A[4][4],$C[3]
	xor	$A[4][2],$A[4][2],$C[0]

	bdnz	.Loop

	blr
	.long	0
	.byte	0,12,0x14,0,0,0,0,0
.size	KeccakF1600_int,.-KeccakF1600_int

.type	KeccakF1600,\@function
.align	5
KeccakF1600:
	$STU	$sp,-$FRAME($sp)
	mflr	r0
	$PUSH	r14,`$FRAME-$SIZE_T*18`($sp)
	$PUSH	r15,`$FRAME-$SIZE_T*17`($sp)
	$PUSH	r16,`$FRAME-$SIZE_T*16`($sp)
	$PUSH	r17,`$FRAME-$SIZE_T*15`($sp)
	$PUSH	r18,`$FRAME-$SIZE_T*14`($sp)
	$PUSH	r19,`$FRAME-$SIZE_T*13`($sp)
	$PUSH	r20,`$FRAME-$SIZE_T*12`($sp)
	$PUSH	r21,`$FRAME-$SIZE_T*11`($sp)
	$PUSH	r22,`$FRAME-$SIZE_T*10`($sp)
	$PUSH	r23,`$FRAME-$SIZE_T*9`($sp)
	$PUSH	r24,`$FRAME-$SIZE_T*8`($sp)
	$PUSH	r25,`$FRAME-$SIZE_T*7`($sp)
	$PUSH	r26,`$FRAME-$SIZE_T*6`($sp)
	$PUSH	r27,`$FRAME-$SIZE_T*5`($sp)
	$PUSH	r28,`$FRAME-$SIZE_T*4`($sp)
	$PUSH	r29,`$FRAME-$SIZE_T*3`($sp)
	$PUSH	r30,`$FRAME-$SIZE_T*2`($sp)
	$PUSH	r31,`$FRAME-$SIZE_T*1`($sp)
	$PUSH	r0,`$FRAME+$LRSAVE`($sp)

	bl	PICmeup
	subi	r12,r12,8			; prepare for ldu

	$PUSH	r3,`$LOCALS+0*$SIZE_T`($sp)
	;$PUSH	r4,`$LOCALS+1*$SIZE_T`($sp)
	;$PUSH	r5,`$LOCALS+2*$SIZE_T`($sp)
	;$PUSH	r6,`$LOCALS+3*$SIZE_T`($sp)
	$PUSH	r12,`$LOCALS+4*$SIZE_T`($sp)

	ld	$A[0][0],`8*0`(r3)		; load A[5][5]
	ld	$A[0][1],`8*1`(r3)
	ld	$A[0][2],`8*2`(r3)
	ld	$A[0][3],`8*3`(r3)
	ld	$A[0][4],`8*4`(r3)
	ld	$A[1][0],`8*5`(r3)
	ld	$A[1][1],`8*6`(r3)
	ld	$A[1][2],`8*7`(r3)
	ld	$A[1][3],`8*8`(r3)
	ld	$A[1][4],`8*9`(r3)
	ld	$A[2][0],`8*10`(r3)
	ld	$A[2][1],`8*11`(r3)
	ld	$A[2][2],`8*12`(r3)
	ld	$A[2][3],`8*13`(r3)
	ld	$A[2][4],`8*14`(r3)
	ld	$A[3][0],`8*15`(r3)
	ld	$A[3][1],`8*16`(r3)
	ld	$A[3][2],`8*17`(r3)
	ld	$A[3][3],`8*18`(r3)
	ld	$A[3][4],`8*19`(r3)
	ld	$A[4][0],`8*20`(r3)
	ld	$A[4][1],`8*21`(r3)
	ld	$A[4][2],`8*22`(r3)
	ld	$A[4][3],`8*23`(r3)
	ld	$A[4][4],`8*24`(r3)

	bl	KeccakF1600_int

	$POP	r3,`$LOCALS+0*$SIZE_T`($sp)
	std	$A[0][0],`8*0`(r3)		; return A[5][5]
	std	$A[0][1],`8*1`(r3)
	std	$A[0][2],`8*2`(r3)
	std	$A[0][3],`8*3`(r3)
	std	$A[0][4],`8*4`(r3)
	std	$A[1][0],`8*5`(r3)
	std	$A[1][1],`8*6`(r3)
	std	$A[1][2],`8*7`(r3)
	std	$A[1][3],`8*8`(r3)
	std	$A[1][4],`8*9`(r3)
	std	$A[2][0],`8*10`(r3)
	std	$A[2][1],`8*11`(r3)
	std	$A[2][2],`8*12`(r3)
	std	$A[2][3],`8*13`(r3)
	std	$A[2][4],`8*14`(r3)
	std	$A[3][0],`8*15`(r3)
	std	$A[3][1],`8*16`(r3)
	std	$A[3][2],`8*17`(r3)
	std	$A[3][3],`8*18`(r3)
	std	$A[3][4],`8*19`(r3)
	std	$A[4][0],`8*20`(r3)
	std	$A[4][1],`8*21`(r3)
	std	$A[4][2],`8*22`(r3)
	std	$A[4][3],`8*23`(r3)
	std	$A[4][4],`8*24`(r3)

	$POP	r0,`$FRAME+$LRSAVE`($sp)
	$POP	r14,`$FRAME-$SIZE_T*18`($sp)
	$POP	r15,`$FRAME-$SIZE_T*17`($sp)
	$POP	r16,`$FRAME-$SIZE_T*16`($sp)
	$POP	r17,`$FRAME-$SIZE_T*15`($sp)
	$POP	r18,`$FRAME-$SIZE_T*14`($sp)
	$POP	r19,`$FRAME-$SIZE_T*13`($sp)
	$POP	r20,`$FRAME-$SIZE_T*12`($sp)
	$POP	r21,`$FRAME-$SIZE_T*11`($sp)
	$POP	r22,`$FRAME-$SIZE_T*10`($sp)
	$POP	r23,`$FRAME-$SIZE_T*9`($sp)
	$POP	r24,`$FRAME-$SIZE_T*8`($sp)
	$POP	r25,`$FRAME-$SIZE_T*7`($sp)
	$POP	r26,`$FRAME-$SIZE_T*6`($sp)
	$POP	r27,`$FRAME-$SIZE_T*5`($sp)
	$POP	r28,`$FRAME-$SIZE_T*4`($sp)
	$POP	r29,`$FRAME-$SIZE_T*3`($sp)
	$POP	r30,`$FRAME-$SIZE_T*2`($sp)
	$POP	r31,`$FRAME-$SIZE_T*1`($sp)
	mtlr	r0
	addi	$sp,$sp,$FRAME
	blr
	.long	0
	.byte	0,12,4,1,0x80,18,1,0
	.long	0
.size	KeccakF1600,.-KeccakF1600

.type	dword_le_load,\@function
.align	5
dword_le_load:
	lbzu	r0,1(r3)
	lbzu	r4,1(r3)
	lbzu	r5,1(r3)
	insrdi	r0,r4,8,48
	lbzu	r4,1(r3)
	insrdi	r0,r5,8,40
	lbzu	r5,1(r3)
	insrdi	r0,r4,8,32
	lbzu	r4,1(r3)
	insrdi	r0,r5,8,24
	lbzu	r5,1(r3)
	insrdi	r0,r4,8,16
	lbzu	r4,1(r3)
	insrdi	r0,r5,8,8
	insrdi	r0,r4,8,0
	blr
	.long	0
	.byte	0,12,0x14,0,0,0,1,0
	.long	0
.size	dword_le_load,.-dword_le_load

.globl	SHA3_absorb
.type	SHA3_absorb,\@function
.align	5
SHA3_absorb:
	$STU	$sp,-$FRAME($sp)
	mflr	r0
	$PUSH	r14,`$FRAME-$SIZE_T*18`($sp)
	$PUSH	r15,`$FRAME-$SIZE_T*17`($sp)
	$PUSH	r16,`$FRAME-$SIZE_T*16`($sp)
	$PUSH	r17,`$FRAME-$SIZE_T*15`($sp)
	$PUSH	r18,`$FRAME-$SIZE_T*14`($sp)
	$PUSH	r19,`$FRAME-$SIZE_T*13`($sp)
	$PUSH	r20,`$FRAME-$SIZE_T*12`($sp)
	$PUSH	r21,`$FRAME-$SIZE_T*11`($sp)
	$PUSH	r22,`$FRAME-$SIZE_T*10`($sp)
	$PUSH	r23,`$FRAME-$SIZE_T*9`($sp)
	$PUSH	r24,`$FRAME-$SIZE_T*8`($sp)
	$PUSH	r25,`$FRAME-$SIZE_T*7`($sp)
	$PUSH	r26,`$FRAME-$SIZE_T*6`($sp)
	$PUSH	r27,`$FRAME-$SIZE_T*5`($sp)
	$PUSH	r28,`$FRAME-$SIZE_T*4`($sp)
	$PUSH	r29,`$FRAME-$SIZE_T*3`($sp)
	$PUSH	r30,`$FRAME-$SIZE_T*2`($sp)
	$PUSH	r31,`$FRAME-$SIZE_T*1`($sp)
	$PUSH	r0,`$FRAME+$LRSAVE`($sp)

	bl	PICmeup
	subi	r4,r4,1				; prepare for lbzu
	subi	r12,r12,8			; prepare for ldu

	$PUSH	r3,`$LOCALS+0*$SIZE_T`($sp)	; save A[][]
	$PUSH	r4,`$LOCALS+1*$SIZE_T`($sp)	; save inp
	$PUSH	r5,`$LOCALS+2*$SIZE_T`($sp)	; save len
	$PUSH	r6,`$LOCALS+3*$SIZE_T`($sp)	; save bsz
	mr	r0,r6
	$PUSH	r12,`$LOCALS+4*$SIZE_T`($sp)

	ld	$A[0][0],`8*0`(r3)		; load A[5][5]
	ld	$A[0][1],`8*1`(r3)
	ld	$A[0][2],`8*2`(r3)
	ld	$A[0][3],`8*3`(r3)
	ld	$A[0][4],`8*4`(r3)
	ld	$A[1][0],`8*5`(r3)
	ld	$A[1][1],`8*6`(r3)
	ld	$A[1][2],`8*7`(r3)
	ld	$A[1][3],`8*8`(r3)
	ld	$A[1][4],`8*9`(r3)
	ld	$A[2][0],`8*10`(r3)
	ld	$A[2][1],`8*11`(r3)
	ld	$A[2][2],`8*12`(r3)
	ld	$A[2][3],`8*13`(r3)
	ld	$A[2][4],`8*14`(r3)
	ld	$A[3][0],`8*15`(r3)
	ld	$A[3][1],`8*16`(r3)
	ld	$A[3][2],`8*17`(r3)
	ld	$A[3][3],`8*18`(r3)
	ld	$A[3][4],`8*19`(r3)
	ld	$A[4][0],`8*20`(r3)
	ld	$A[4][1],`8*21`(r3)
	ld	$A[4][2],`8*22`(r3)
	ld	$A[4][3],`8*23`(r3)
	ld	$A[4][4],`8*24`(r3)

	mr	r3,r4
	mr	r4,r5
	mr	r5,r0

	b	.Loop_absorb

.align	4
.Loop_absorb:
	$UCMP	r4,r5				; len < bsz?
	blt	.Labsorbed

	sub	r4,r4,r5			; len -= bsz
	srwi	r5,r5,3
	$PUSH	r4,`$LOCALS+2*$SIZE_T`($sp)	; save len
	mtctr	r5
	bl	dword_le_load			; *inp++
	xor	$A[0][0],$A[0][0],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[0][1],$A[0][1],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[0][2],$A[0][2],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[0][3],$A[0][3],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[0][4],$A[0][4],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[1][0],$A[1][0],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[1][1],$A[1][1],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[1][2],$A[1][2],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[1][3],$A[1][3],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[1][4],$A[1][4],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[2][0],$A[2][0],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[2][1],$A[2][1],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[2][2],$A[2][2],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[2][3],$A[2][3],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[2][4],$A[2][4],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[3][0],$A[3][0],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[3][1],$A[3][1],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[3][2],$A[3][2],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[3][3],$A[3][3],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[3][4],$A[3][4],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[4][0],$A[4][0],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[4][1],$A[4][1],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[4][2],$A[4][2],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[4][3],$A[4][3],r0
	bdz	.Lprocess_block
	bl	dword_le_load			; *inp++
	xor	$A[4][4],$A[4][4],r0

.Lprocess_block:
	$PUSH	r3,`$LOCALS+1*$SIZE_T`($sp)	; save inp

	bl	KeccakF1600_int

	$POP	r0,`$LOCALS+4*$SIZE_T`($sp)	; pull iotas[24]
	$POP	r5,`$LOCALS+3*$SIZE_T`($sp)	; restore bsz
	$POP	r4,`$LOCALS+2*$SIZE_T`($sp)	; restore len
	$POP	r3,`$LOCALS+1*$SIZE_T`($sp)	; restore inp
	addic	r0,r0,`-8*24`			; rewind iotas
	$PUSH	r0,`$LOCALS+4*$SIZE_T`($sp)

	b	.Loop_absorb

.align	4
.Labsorbed:
	$POP	r3,`$LOCALS+0*$SIZE_T`($sp)
	std	$A[0][0],`8*0`(r3)		; return A[5][5]
	std	$A[0][1],`8*1`(r3)
	std	$A[0][2],`8*2`(r3)
	std	$A[0][3],`8*3`(r3)
	std	$A[0][4],`8*4`(r3)
	std	$A[1][0],`8*5`(r3)
	std	$A[1][1],`8*6`(r3)
	std	$A[1][2],`8*7`(r3)
	std	$A[1][3],`8*8`(r3)
	std	$A[1][4],`8*9`(r3)
	std	$A[2][0],`8*10`(r3)
	std	$A[2][1],`8*11`(r3)
	std	$A[2][2],`8*12`(r3)
	std	$A[2][3],`8*13`(r3)
	std	$A[2][4],`8*14`(r3)
	std	$A[3][0],`8*15`(r3)
	std	$A[3][1],`8*16`(r3)
	std	$A[3][2],`8*17`(r3)
	std	$A[3][3],`8*18`(r3)
	std	$A[3][4],`8*19`(r3)
	std	$A[4][0],`8*20`(r3)
	std	$A[4][1],`8*21`(r3)
	std	$A[4][2],`8*22`(r3)
	std	$A[4][3],`8*23`(r3)
	std	$A[4][4],`8*24`(r3)

	mr	r3,r4				; return value
	$POP	r0,`$FRAME+$LRSAVE`($sp)
	$POP	r14,`$FRAME-$SIZE_T*18`($sp)
	$POP	r15,`$FRAME-$SIZE_T*17`($sp)
	$POP	r16,`$FRAME-$SIZE_T*16`($sp)
	$POP	r17,`$FRAME-$SIZE_T*15`($sp)
	$POP	r18,`$FRAME-$SIZE_T*14`($sp)
	$POP	r19,`$FRAME-$SIZE_T*13`($sp)
	$POP	r20,`$FRAME-$SIZE_T*12`($sp)
	$POP	r21,`$FRAME-$SIZE_T*11`($sp)
	$POP	r22,`$FRAME-$SIZE_T*10`($sp)
	$POP	r23,`$FRAME-$SIZE_T*9`($sp)
	$POP	r24,`$FRAME-$SIZE_T*8`($sp)
	$POP	r25,`$FRAME-$SIZE_T*7`($sp)
	$POP	r26,`$FRAME-$SIZE_T*6`($sp)
	$POP	r27,`$FRAME-$SIZE_T*5`($sp)
	$POP	r28,`$FRAME-$SIZE_T*4`($sp)
	$POP	r29,`$FRAME-$SIZE_T*3`($sp)
	$POP	r30,`$FRAME-$SIZE_T*2`($sp)
	$POP	r31,`$FRAME-$SIZE_T*1`($sp)
	mtlr	r0
	addi	$sp,$sp,$FRAME
	blr
	.long	0
	.byte	0,12,4,1,0x80,18,4,0
	.long	0
.size	SHA3_absorb,.-SHA3_absorb
___
{
my ($A_flat,$out,$len,$bsz) = map("r$_",(28..31));
$code.=<<___;
.globl	SHA3_squeeze
.type	SHA3_squeeze,\@function
.align	5
SHA3_squeeze:
	$STU	$sp,`-10*$SIZE_T`($sp)
	mflr	r0
	$PUSH	r28,`6*$SIZE_T`($sp)
	$PUSH	r29,`7*$SIZE_T`($sp)
	$PUSH	r30,`8*$SIZE_T`($sp)
	$PUSH	r31,`9*$SIZE_T`($sp)
	$PUSH	r0,`10*$SIZE_T+$LRSAVE`($sp)

	mr	$A_flat,r3
	subi	r3,r3,8			; prepare for ldu
	subi	$out,r4,1		; prepare for stbu
	mr	$len,r5
	mr	$bsz,r6
	b	.Loop_squeeze

.align	4
.Loop_squeeze:
	ldu	r0,8(r3)
	${UCMP}i $len,8
	blt	.Lsqueeze_tail

	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)
	srdi	r0,r0,8
	stbu	r0,1($out)

	subic.	$len,$len,8
	beq	.Lsqueeze_done

	subic.	r6,r6,8
	bgt	.Loop_squeeze

	mr	r3,$A_flat
	bl	KeccakF1600
	subi	r3,$A_flat,8		; prepare for ldu
	mr	r6,$bsz
	b	.Loop_squeeze

.align	4
.Lsqueeze_tail:
	mtctr	$len
.Loop_tail:
	stbu	r0,1($out)
	srdi	r0,r0,8
	bdnz	.Loop_tail

.Lsqueeze_done:
	$POP	r0,`10*$SIZE_T+$LRSAVE`($sp)
	$POP	r28,`6*$SIZE_T`($sp)
	$POP	r29,`7*$SIZE_T`($sp)
	$POP	r30,`8*$SIZE_T`($sp)
	$POP	r31,`9*$SIZE_T`($sp)
	mtlr	r0
	addi	$sp,$sp,`10*$SIZE_T`
	blr
	.long	0
	.byte	0,12,4,1,0x80,4,4,0
	.long	0
.size	SHA3_squeeze,.-SHA3_squeeze
___
}

# Ugly hack here, because PPC assembler syntax seem to vary too
# much from platforms to platform...
$code.=<<___;
.align	6
PICmeup:
	mflr	r0
	bcl	20,31,\$+4
	mflr	r12   ; vvvvvv "distance" between . and 1st data entry
	addi	r12,r12,`64-8`
	mtlr	r0
	blr
	.long	0
	.byte	0,12,0x14,0,0,0,0,0
	.space	`64-9*4`
.type	iotas,\@object
iotas:
	.quad	0x0000000000000001
	.quad	0x0000000000008082
	.quad	0x800000000000808a
	.quad	0x8000000080008000
	.quad	0x000000000000808b
	.quad	0x0000000080000001
	.quad	0x8000000080008081
	.quad	0x8000000000008009
	.quad	0x000000000000008a
	.quad	0x0000000000000088
	.quad	0x0000000080008009
	.quad	0x000000008000000a
	.quad	0x000000008000808b
	.quad	0x800000000000008b
	.quad	0x8000000000008089
	.quad	0x8000000000008003
	.quad	0x8000000000008002
	.quad	0x8000000000000080
	.quad	0x000000000000800a
	.quad	0x800000008000000a
	.quad	0x8000000080008081
	.quad	0x8000000000008080
	.quad	0x0000000080000001
	.quad	0x8000000080008008
.size	iotas,.-iotas
.asciz	"Keccak-1600 absorb and squeeze for PPC64, CRYPTOGAMS by <appro\@openssl.org>"
___

$code =~ s/\`([^\`]*)\`/eval $1/gem;
print $code;
close STDOUT or die "error closing STDOUT: $!";


#!/usr/bin/env perl
# Copyright 2017-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/.
# ====================================================================
#
# Keccak-1600 for s390x.
#
# June 2017.
#
# Below code is [lane complementing] KECCAK_2X implementation (see
# sha/keccak1600.c) with C[5] and D[5] held in register bank. Though
# instead of actually unrolling the loop pair-wise I simply flip
# pointers to T[][] and A[][] at the end of round. Since number of
# rounds is even, last round writes to A[][] and everything works out.
# In the nutshell it's transliteration of x86_64 module, because both
# architectures have similar capabilities/limitations. Performance
# measurement is problematic as I don't have access to an idle system.
# It looks like z13 processes one byte [out of long message] in ~14
# cycles. At least the result is consistent with estimate based on
# amount of instruction and assumed instruction issue rate. It's ~2.5x
# faster than compiler-generated code.

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

my @A = map([ 8*$_, 8*($_+1), 8*($_+2), 8*($_+3), 8*($_+4) ], (0,5,10,15,20));

my @C = map("%r$_",(0,1,5..7));
my @D = map("%r$_",(8..12));
my @T = map("%r$_",(13..14));
my ($src,$dst,$iotas) = map("%r$_",(2..4));
my $sp = "%r15";

$stdframe=16*$SIZE_T+4*8;
$frame=$stdframe+25*8;

my @rhotates = ([  0,  1, 62, 28, 27 ],
                [ 36, 44,  6, 55, 20 ],
                [  3, 10, 43, 25, 39 ],
                [ 41, 45, 15, 21,  8 ],
                [ 18,  2, 61, 56, 14 ]);

{ my @C = @C;	# copy, because we mess them up...
  my @D = @D;

$code.=<<___;
.text

.type	__KeccakF1600,\@function
.align	32
__KeccakF1600:
	st${g}	%r14,$SIZE_T*14($sp)
	lg	@C[0],$A[4][0]($src)
	lg	@C[1],$A[4][1]($src)
	lg	@C[2],$A[4][2]($src)
	lg	@C[3],$A[4][3]($src)
	lg	@C[4],$A[4][4]($src)
	larl	$iotas,iotas
	j	.Loop

.align	16
.Loop:
	lg	@D[0],$A[0][0]($src)
	lg	@D[1],$A[1][1]($src)
	lg	@D[2],$A[2][2]($src)
	lg	@D[3],$A[3][3]($src)

	xgr	@C[0],@D[0]
	xg	@C[1],$A[0][1]($src)
	xg	@C[2],$A[0][2]($src)
	xg	@C[3],$A[0][3]($src)
	lgr	@D[4],@C[4]
	xg	@C[4],$A[0][4]($src)

	xg	@C[0],$A[1][0]($src)
	xgr	@C[1],@D[1]
	xg	@C[2],$A[1][2]($src)
	xg	@C[3],$A[1][3]($src)
	xg	@C[4],$A[1][4]($src)

	xg	@C[0],$A[2][0]($src)
	xg	@C[1],$A[2][1]($src)
	xgr	@C[2],@D[2]
	xg	@C[3],$A[2][3]($src)
	xg	@C[4],$A[2][4]($src)

	xg	@C[0],$A[3][0]($src)
	xg	@C[1],$A[3][1]($src)
	xg	@C[2],$A[3][2]($src)
	xgr	@C[3],@D[3]
	xg	@C[4],$A[3][4]($src)

	lgr	@T[0],@C[2]
	rllg	@C[2],@C[2],1
	xgr	@C[2],@C[0]		# D[1] = ROL64(C[2], 1) ^ C[0]

	rllg	@C[0],@C[0],1
	xgr	@C[0],@C[3]		# D[4] = ROL64(C[0], 1) ^ C[3]

	rllg	@C[3],@C[3],1
	xgr	@C[3],@C[1]		# D[2] = ROL64(C[3], 1) ^ C[1]

	rllg	@C[1],@C[1],1
	xgr	@C[1],@C[4]		# D[0] = ROL64(C[1], 1) ^ C[4]

	rllg	@C[4],@C[4],1
	xgr	@C[4],@T[0]		# D[3] = ROL64(C[4], 1) ^ C[2]
___
	(@D[0..4], @C) = (@C[1..4,0], @D);
$code.=<<___;
	xgr	@C[1],@D[1]
	xgr	@C[2],@D[2]
	xgr	@C[3],@D[3]
	 rllg	@C[1],@C[1],$rhotates[1][1]
	xgr	@C[4],@D[4]
	 rllg	@C[2],@C[2],$rhotates[2][2]
	xgr	@C[0],@D[0]

	lgr	@T[0],@C[1]
	ogr	@C[1],@C[2]
	 rllg	@C[3],@C[3],$rhotates[3][3]
	xgr	@C[1],@C[0]		#	    C[0] ^ ( C[1] | C[2])
	 rllg	@C[4],@C[4],$rhotates[4][4]
	xg	@C[1],0($iotas)
	la	$iotas,8($iotas)
	stg	@C[1],$A[0][0]($dst)	# R[0][0] = C[0] ^ ( C[1] | C[2]) ^ iotas[i]

	lgr	@T[1],@C[4]
	ngr	@C[4],@C[3]
	 lghi	@C[1],-1		# no 'not' instruction :-(
	xgr	@C[4],@C[2]		#	    C[2] ^ ( C[4] & C[3])
	 xgr	@C[2],@C[1]		# not	@C[2]
	stg	@C[4],$A[0][2]($dst)	# R[0][2] = C[2] ^ ( C[4] & C[3])
	 ogr	@C[2],@C[3]
	 xgr	@C[2],@T[0]		#	    C[1] ^ (~C[2] | C[3])

	ngr	@T[0],@C[0]
	 stg	@C[2],$A[0][1]($dst)	# R[0][1] = C[1] ^ (~C[2] | C[3])
	xgr	@T[0],@T[1]		#	    C[4] ^ ( C[1] & C[0])
	 ogr	@T[1],@C[0]
	stg	@T[0],$A[0][4]($dst)	# R[0][4] = C[4] ^ ( C[1] & C[0])
	 xgr	@T[1],@C[3]		#	    C[3] ^ ( C[4] | C[0])
	 stg	@T[1],$A[0][3]($dst)	# R[0][3] = C[3] ^ ( C[4] | C[0])

	lg	@C[0],$A[0][3]($src)
	lg	@C[4],$A[4][2]($src)
	lg	@C[3],$A[3][1]($src)
	lg	@C[1],$A[1][4]($src)
	lg	@C[2],$A[2][0]($src)

	xgr	@C[0],@D[3]
	xgr	@C[4],@D[2]
	 rllg	@C[0],@C[0],$rhotates[0][3]
	xgr	@C[3],@D[1]
	 rllg	@C[4],@C[4],$rhotates[4][2]
	xgr	@C[1],@D[4]
	 rllg	@C[3],@C[3],$rhotates[3][1]
	xgr	@C[2],@D[0]

	lgr	@T[0],@C[0]
	ogr	@C[0],@C[4]
	 rllg	@C[1],@C[1],$rhotates[1][4]
	xgr	@C[0],@C[3]		#	    C[3] ^ (C[0] |  C[4])
	 rllg	@C[2],@C[2],$rhotates[2][0]
	stg	@C[0],$A[1][3]($dst)	# R[1][3] = C[3] ^ (C[0] |  C[4])

	lgr	@T[1],@C[1]
	ngr	@C[1],@T[0]
	 lghi	@C[0],-1		# no 'not' instruction :-(
	xgr	@C[1],@C[4]		#	    C[4] ^ (C[1] &  C[0])
	 xgr	@C[4],@C[0]		# not	@C[4]
	stg	@C[1],$A[1][4]($dst)	# R[1][4] = C[4] ^ (C[1] &  C[0])

	 ogr	@C[4],@C[3]
	 xgr	@C[4],@C[2]		#	    C[2] ^ (~C[4] | C[3])

	ngr	@C[3],@C[2]
	 stg	@C[4],$A[1][2]($dst)	# R[1][2] = C[2] ^ (~C[4] | C[3])
	xgr	@C[3],@T[1]		#	    C[1] ^ (C[3] &  C[2])
	 ogr	@T[1],@C[2]
	stg	@C[3],$A[1][1]($dst)	# R[1][1] = C[1] ^ (C[3] &  C[2])
	 xgr	@T[1],@T[0]		#	    C[0] ^ (C[1] |  C[2])
	 stg	@T[1],$A[1][0]($dst)	# R[1][0] = C[0] ^ (C[1] |  C[2])

	lg	@C[2],$A[2][3]($src)
	lg	@C[3],$A[3][4]($src)
	lg	@C[1],$A[1][2]($src)
	lg	@C[4],$A[4][0]($src)
	lg	@C[0],$A[0][1]($src)

	xgr	@C[2],@D[3]
	xgr	@C[3],@D[4]
	 rllg	@C[2],@C[2],$rhotates[2][3]
	xgr	@C[1],@D[2]
	 rllg	@C[3],@C[3],$rhotates[3][4]
	xgr	@C[4],@D[0]
	 rllg	@C[1],@C[1],$rhotates[1][2]
	xgr	@C[0],@D[1]

	lgr	@T[0],@C[2]
	ngr	@C[2],@C[3]
	 rllg	@C[4],@C[4],$rhotates[4][0]
	xgr	@C[2],@C[1]		#	     C[1] ^ ( C[2] & C[3])
	lghi	@T[1],-1		# no 'not' instruction :-(
	stg	@C[2],$A[2][1]($dst)	# R[2][1] =  C[1] ^ ( C[2] & C[3])

	xgr	@C[3],@T[1]		# not	@C[3]
	lgr	@T[1],@C[4]
	ngr	@C[4],@C[3]
	 rllg	@C[0],@C[0],$rhotates[0][1]
	xgr	@C[4],@T[0]		#	     C[2] ^ ( C[4] & ~C[3])
	 ogr	@T[0],@C[1]
	stg	@C[4],$A[2][2]($dst)	# R[2][2] =  C[2] ^ ( C[4] & ~C[3])
	 xgr	@T[0],@C[0]		#	     C[0] ^ ( C[2] | C[1])

	ngr	@C[1],@C[0]
	 stg	@T[0],$A[2][0]($dst)	# R[2][0] =  C[0] ^ ( C[2] | C[1])
	xgr	@C[1],@T[1]		#	     C[4] ^ ( C[1] & C[0])
	 ogr	@C[0],@T[1]
	stg	@C[1],$A[2][4]($dst)	# R[2][4] =  C[4] ^ ( C[1] & C[0])
	 xgr	@C[0],@C[3]		#	    ~C[3] ^ ( C[0] | C[4])
	 stg	@C[0],$A[2][3]($dst)	# R[2][3] = ~C[3] ^ ( C[0] | C[4])

	lg	@C[2],$A[2][1]($src)
	lg	@C[3],$A[3][2]($src)
	lg	@C[1],$A[1][0]($src)
	lg	@C[4],$A[4][3]($src)
	lg	@C[0],$A[0][4]($src)

	xgr	@C[2],@D[1]
	xgr	@C[3],@D[2]
	 rllg	@C[2],@C[2],$rhotates[2][1]
	xgr	@C[1],@D[0]
	 rllg	@C[3],@C[3],$rhotates[3][2]
	xgr	@C[4],@D[3]
	 rllg	@C[1],@C[1],$rhotates[1][0]
	xgr	@C[0],@D[4]
	 rllg	@C[4],@C[4],$rhotates[4][3]

	lgr	@T[0],@C[2]
	ogr	@C[2],@C[3]
	lghi	@T[1],-1		# no 'not' instruction :-(
	xgr	@C[2],@C[1]		#	     C[1] ^ ( C[2] | C[3])
	xgr	@C[3],@T[1]		# not	@C[3]
	stg	@C[2],$A[3][1]($dst)	# R[3][1] =  C[1] ^ ( C[2] | C[3])

	lgr	@T[1],@C[4]
	ogr	@C[4],@C[3]
	 rllg	@C[0],@C[0],$rhotates[0][4]
	xgr	@C[4],@T[0]		#	     C[2] ^ ( C[4] | ~C[3])
	 ngr	@T[0],@C[1]
	stg	@C[4],$A[3][2]($dst)	# R[3][2] =  C[2] ^ ( C[4] | ~C[3])
	 xgr	@T[0],@C[0]		#	     C[0] ^ ( C[2] & C[1])

	ogr	@C[1],@C[0]
	 stg	@T[0],$A[3][0]($dst)	# R[3][0] =  C[0] ^ ( C[2] & C[1])
	xgr	@C[1],@T[1]		#	     C[4] ^ ( C[1] | C[0])
	 ngr	@C[0],@T[1]
	stg	@C[1],$A[3][4]($dst)	# R[3][4] =  C[4] ^ ( C[1] | C[0])
	 xgr	@C[0],@C[3]		#	    ~C[3] ^ ( C[0] & C[4])
	 stg	@C[0],$A[3][3]($dst)	# R[3][3] = ~C[3] ^ ( C[0] & C[4])

	xg	@D[2],$A[0][2]($src)
	xg	@D[3],$A[1][3]($src)
	xg	@D[1],$A[4][1]($src)
	xg	@D[4],$A[2][4]($src)
	xgr	$dst,$src		# xchg	$dst,$src
	 rllg	@D[2],@D[2],$rhotates[0][2]
	xg	@D[0],$A[3][0]($src)
	 rllg	@D[3],@D[3],$rhotates[1][3]
	xgr	$src,$dst
	 rllg	@D[1],@D[1],$rhotates[4][1]
	xgr	$dst,$src
	 rllg	@D[4],@D[4],$rhotates[2][4]
___
	@C = @D[2..4,0,1];
$code.=<<___;
	lgr	@T[0],@C[0]
	ngr	@C[0],@C[1]
	lghi	@T[1],-1		# no 'not' instruction :-(
	xgr	@C[0],@C[4]		#	     C[4] ^ ( C[0] & C[1])
	xgr	@C[1],@T[1]		# not	@C[1]
	stg	@C[0],$A[4][4]($src)	# R[4][4] =  C[4] ^ ( C[0] & C[1])

	lgr	@T[1],@C[2]
	ngr	@C[2],@C[1]
	 rllg	@D[0],@D[0],$rhotates[3][0]
	xgr	@C[2],@T[0]		#	     C[0] ^ ( C[2] & ~C[1])
	 ogr	@T[0],@C[4]
	stg	@C[2],$A[4][0]($src)	# R[4][0] =  C[0] ^ ( C[2] & ~C[1])
	 xgr	@T[0],@C[3]		#	     C[3] ^ ( C[0] | C[4])

	ngr	@C[4],@C[3]
	 stg	@T[0],$A[4][3]($src)	# R[4][3] =  C[3] ^ ( C[0] | C[4])
	xgr	@C[4],@T[1]		#	     C[2] ^ ( C[4] & C[3])
	 ogr	@C[3],@T[1]
	stg	@C[4],$A[4][2]($src)	# R[4][2] =  C[2] ^ ( C[4] & C[3])
	 xgr	@C[3],@C[1]		#	    ~C[1] ^ ( C[2] | C[3])

	lgr	@C[1],@C[0]		# harmonize with the loop top
	lgr	@C[0],@T[0]
	 stg	@C[3],$A[4][1]($src)	# R[4][1] = ~C[1] ^ ( C[2] | C[3])

	tmll	$iotas,255
	jnz	.Loop

	l${g}	%r14,$SIZE_T*14($sp)
	br	%r14
.size	__KeccakF1600,.-__KeccakF1600
___
}
{
$code.=<<___;
.type	KeccakF1600,\@function
.align	32
KeccakF1600:
.LKeccakF1600:
	lghi	%r1,-$frame
	stm${g}	%r6,%r15,$SIZE_T*6($sp)
	lgr	%r0,$sp
	la	$sp,0(%r1,$sp)
	st${g}	%r0,0($sp)

	lghi	@D[0],-1		# no 'not' instruction :-(
	lghi	@D[1],-1
	lghi	@D[2],-1
	lghi	@D[3],-1
	lghi	@D[4],-1
	lghi	@T[0],-1
	xg	@D[0],$A[0][1]($src)
	xg	@D[1],$A[0][2]($src)
	xg	@D[2],$A[1][3]($src)
	xg	@D[3],$A[2][2]($src)
	xg	@D[4],$A[3][2]($src)
	xg	@T[0],$A[4][0]($src)
	stmg	@D[0],@D[1],$A[0][1]($src)
	stg	@D[2],$A[1][3]($src)
	stg	@D[3],$A[2][2]($src)
	stg	@D[4],$A[3][2]($src)
	stg	@T[0],$A[4][0]($src)

	la	$dst,$stdframe($sp)

	bras	%r14,__KeccakF1600

	lghi	@D[0],-1		# no 'not' instruction :-(
	lghi	@D[1],-1
	lghi	@D[2],-1
	lghi	@D[3],-1
	lghi	@D[4],-1
	lghi	@T[0],-1
	xg	@D[0],$A[0][1]($src)
	xg	@D[1],$A[0][2]($src)
	xg	@D[2],$A[1][3]($src)
	xg	@D[3],$A[2][2]($src)
	xg	@D[4],$A[3][2]($src)
	xg	@T[0],$A[4][0]($src)
	stmg	@D[0],@D[1],$A[0][1]($src)
	stg	@D[2],$A[1][3]($src)
	stg	@D[3],$A[2][2]($src)
	stg	@D[4],$A[3][2]($src)
	stg	@T[0],$A[4][0]($src)

	lm${g}	%r6,%r15,$frame+6*$SIZE_T($sp)
	br	%r14
.size	KeccakF1600,.-KeccakF1600
___
}
{ my ($A_flat,$inp,$len,$bsz) = map("%r$_",(2..5));

$code.=<<___;
.globl	SHA3_absorb
.type	SHA3_absorb,\@function
.align	32
SHA3_absorb:
	lghi	%r1,-$frame
	stm${g}	%r5,%r15,$SIZE_T*5($sp)
	lgr	%r0,$sp
	la	$sp,0(%r1,$sp)
	st${g}	%r0,0($sp)

	lghi	@D[0],-1		# no 'not' instruction :-(
	lghi	@D[1],-1
	lghi	@D[2],-1
	lghi	@D[3],-1
	lghi	@D[4],-1
	lghi	@T[0],-1
	xg	@D[0],$A[0][1]($src)
	xg	@D[1],$A[0][2]($src)
	xg	@D[2],$A[1][3]($src)
	xg	@D[3],$A[2][2]($src)
	xg	@D[4],$A[3][2]($src)
	xg	@T[0],$A[4][0]($src)
	stmg	@D[0],@D[1],$A[0][1]($src)
	stg	@D[2],$A[1][3]($src)
	stg	@D[3],$A[2][2]($src)
	stg	@D[4],$A[3][2]($src)
	stg	@T[0],$A[4][0]($src)

.Loop_absorb:
	cl${g}r	$len,$bsz
	jl	.Ldone_absorb

	srl${g}	$bsz,3
	la	%r1,0($A_flat)

.Lblock_absorb:
	lrvg	%r0,0($inp)
	la	$inp,8($inp)
	xg	%r0,0(%r1)
	a${g}hi	$len,-8
	stg	%r0,0(%r1)
	la	%r1,8(%r1)
	brct	$bsz,.Lblock_absorb

	stm${g}	$inp,$len,$frame+3*$SIZE_T($sp)
	la	$dst,$stdframe($sp)
	bras	%r14,__KeccakF1600
	lm${g}	$inp,$bsz,$frame+3*$SIZE_T($sp)
	j	.Loop_absorb

.align	16
.Ldone_absorb:
	lghi	@D[0],-1		# no 'not' instruction :-(
	lghi	@D[1],-1
	lghi	@D[2],-1
	lghi	@D[3],-1
	lghi	@D[4],-1
	lghi	@T[0],-1
	xg	@D[0],$A[0][1]($src)
	xg	@D[1],$A[0][2]($src)
	xg	@D[2],$A[1][3]($src)
	xg	@D[3],$A[2][2]($src)
	xg	@D[4],$A[3][2]($src)
	xg	@T[0],$A[4][0]($src)
	stmg	@D[0],@D[1],$A[0][1]($src)
	stg	@D[2],$A[1][3]($src)
	stg	@D[3],$A[2][2]($src)
	stg	@D[4],$A[3][2]($src)
	stg	@T[0],$A[4][0]($src)

	lgr	%r2,$len		# return value

	lm${g}	%r6,%r15,$frame+6*$SIZE_T($sp)
	br	%r14
.size	SHA3_absorb,.-SHA3_absorb
___
}
{ my ($A_flat,$out,$len,$bsz) = map("%r$_",(2..5));

$code.=<<___;
.globl	SHA3_squeeze
.type	SHA3_squeeze,\@function
.align	32
SHA3_squeeze:
	srl${g}	$bsz,3
	st${g}	%r14,2*$SIZE_T($sp)
	lghi	%r14,8
	st${g}	$bsz,5*$SIZE_T($sp)
	la	%r1,0($A_flat)

	j	.Loop_squeeze

.align	16
.Loop_squeeze:
	cl${g}r $len,%r14
	jl	.Ltail_squeeze

	lrvg	%r0,0(%r1)
	la	%r1,8(%r1)
	stg	%r0,0($out)
	la	$out,8($out)
	a${g}hi	$len,-8			# len -= 8
	jz	.Ldone_squeeze

	brct	$bsz,.Loop_squeeze	# bsz--

	stm${g}	$out,$len,3*$SIZE_T($sp)
	bras	%r14,.LKeccakF1600
	lm${g}	$out,$bsz,3*$SIZE_T($sp)
	lghi	%r14,8
	la	%r1,0($A_flat)
	j	.Loop_squeeze

.Ltail_squeeze:
	lg	%r0,0(%r1)
.Loop_tail_squeeze:
	stc	%r0,0($out)
	la	$out,1($out)
	srlg	%r0,8
	brct	$len,.Loop_tail_squeeze

.Ldone_squeeze:
	l${g}	%r14,2*$SIZE_T($sp)
	br	%r14
.size	SHA3_squeeze,.-SHA3_squeeze
___
}
$code.=<<___;
.align	256
	.quad	0,0,0,0,0,0,0,0
.type	iotas,\@object
iotas:
	.quad	0x0000000000000001
	.quad	0x0000000000008082
	.quad	0x800000000000808a
	.quad	0x8000000080008000
	.quad	0x000000000000808b
	.quad	0x0000000080000001
	.quad	0x8000000080008081
	.quad	0x8000000000008009
	.quad	0x000000000000008a
	.quad	0x0000000000000088
	.quad	0x0000000080008009
	.quad	0x000000008000000a
	.quad	0x000000008000808b
	.quad	0x800000000000008b
	.quad	0x8000000000008089
	.quad	0x8000000000008003
	.quad	0x8000000000008002
	.quad	0x8000000000000080
	.quad	0x000000000000800a
	.quad	0x800000008000000a
	.quad	0x8000000080008081
	.quad	0x8000000000008080
	.quad	0x0000000080000001
	.quad	0x8000000080008008
.size	iotas,.-iotas
.asciz	"Keccak-1600 absorb and squeeze for s390x, CRYPTOGAMS by <appro\@openssl.org>"
___

# unlike 32-bit shift 64-bit one takes three arguments
$code =~ s/(srlg\s+)(%r[0-9]+),/$1$2,$2,/gm;

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