#! /usr/bin/env perl
# Copyright 2009-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html

# ====================================================================
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
# project. The module is, however, dual licensed under OpenSSL and
# CRYPTOGAMS licenses depending on where you obtain it. For further
# details see http://www.openssl.org/~appro/cryptogams/.
# ====================================================================

# SHA1 block procedure for PA-RISC.

# June 2009.
#
# On PA-7100LC performance is >30% better than gcc 3.2 generated code
# for aligned input and >50% better for unaligned. Compared to vendor
# compiler on PA-8600 it's almost 60% faster in 64-bit build and just
# few percent faster in 32-bit one (this for aligned input, data for
# unaligned input is not available).
#
# Special thanks to polarhome.com for providing HP-UX account.

$flavour = shift;
$output = shift;
open STDOUT,">$output";

if ($flavour =~ /64/) {
	$LEVEL		="2.0W";
	$SIZE_T		=8;
	$FRAME_MARKER	=80;
	$SAVED_RP	=16;
	$PUSH		="std";
	$PUSHMA		="std,ma";
	$POP		="ldd";
	$POPMB		="ldd,mb";
} else {
	$LEVEL		="1.0";
	$SIZE_T		=4;
	$FRAME_MARKER	=48;
	$SAVED_RP	=20;
	$PUSH		="stw";
	$PUSHMA		="stwm";
	$POP		="ldw";
	$POPMB		="ldwm";
}

$FRAME=14*$SIZE_T+$FRAME_MARKER;# 14 saved regs + frame marker
				#                 [+ argument transfer]
$ctx="%r26";		# arg0
$inp="%r25";		# arg1
$num="%r24";		# arg2

$t0="%r28";
$t1="%r29";
$K="%r31";

@X=("%r1", "%r2", "%r3", "%r4", "%r5", "%r6", "%r7", "%r8",
    "%r9", "%r10","%r11","%r12","%r13","%r14","%r15","%r16",$t0);

@V=($A,$B,$C,$D,$E)=("%r19","%r20","%r21","%r22","%r23");

sub BODY_00_19 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i+1;
$code.=<<___ if ($i<15);
	addl	$K,$e,$e	; $i
	shd	$a,$a,27,$t1
	addl	@X[$i],$e,$e
	and	$c,$b,$t0
	addl	$t1,$e,$e
	andcm	$d,$b,$t1
	shd	$b,$b,2,$b
	or	$t1,$t0,$t0
	addl	$t0,$e,$e
___
$code.=<<___ if ($i>=15);	# with forward Xupdate
	addl	$K,$e,$e	; $i
	shd	$a,$a,27,$t1
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]
	addl	@X[$i%16],$e,$e
	and	$c,$b,$t0
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
	addl	$t1,$e,$e
	andcm	$d,$b,$t1
	shd	$b,$b,2,$b
	or	$t1,$t0,$t0
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
	add	$t0,$e,$e
	shd	@X[$j%16],@X[$j%16],31,@X[$j%16]
___
}

sub BODY_20_39 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i+1;
$code.=<<___ if ($i<79);
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]	; $i
	addl	$K,$e,$e
	shd	$a,$a,27,$t1
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
	addl	@X[$i%16],$e,$e
	xor	$b,$c,$t0
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
	addl	$t1,$e,$e
	shd	$b,$b,2,$b
	xor	$d,$t0,$t0
	shd	@X[$j%16],@X[$j%16],31,@X[$j%16]
	addl	$t0,$e,$e
___
$code.=<<___ if ($i==79);	# with context load
	ldw	0($ctx),@X[0]	; $i
	addl	$K,$e,$e
	shd	$a,$a,27,$t1
	ldw	4($ctx),@X[1]
	addl	@X[$i%16],$e,$e
	xor	$b,$c,$t0
	ldw	8($ctx),@X[2]
	addl	$t1,$e,$e
	shd	$b,$b,2,$b
	xor	$d,$t0,$t0
	ldw	12($ctx),@X[3]
	addl	$t0,$e,$e
	ldw	16($ctx),@X[4]
___
}

sub BODY_40_59 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i+1;
$code.=<<___;
	shd	$a,$a,27,$t1	; $i
	addl	$K,$e,$e
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]
	xor	$d,$c,$t0
	addl	@X[$i%16],$e,$e
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
	and	$b,$t0,$t0
	addl	$t1,$e,$e
	shd	$b,$b,2,$b
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
	addl	$t0,$e,$e
	and	$d,$c,$t1
	shd	@X[$j%16],@X[$j%16],31,@X[$j%16]
	addl	$t1,$e,$e
___
}

$code=<<___;
	.LEVEL	$LEVEL
	.SPACE	\$TEXT\$
	.SUBSPA	\$CODE\$,QUAD=0,ALIGN=8,ACCESS=0x2C,CODE_ONLY

	.EXPORT	sha1_block_data_order,ENTRY,ARGW0=GR,ARGW1=GR,ARGW2=GR
sha1_block_data_order
	.PROC
	.CALLINFO	FRAME=`$FRAME-14*$SIZE_T`,NO_CALLS,SAVE_RP,ENTRY_GR=16
	.ENTRY
	$PUSH	%r2,-$SAVED_RP(%sp)	; standard prologue
	$PUSHMA	%r3,$FRAME(%sp)
	$PUSH	%r4,`-$FRAME+1*$SIZE_T`(%sp)
	$PUSH	%r5,`-$FRAME+2*$SIZE_T`(%sp)
	$PUSH	%r6,`-$FRAME+3*$SIZE_T`(%sp)
	$PUSH	%r7,`-$FRAME+4*$SIZE_T`(%sp)
	$PUSH	%r8,`-$FRAME+5*$SIZE_T`(%sp)
	$PUSH	%r9,`-$FRAME+6*$SIZE_T`(%sp)
	$PUSH	%r10,`-$FRAME+7*$SIZE_T`(%sp)
	$PUSH	%r11,`-$FRAME+8*$SIZE_T`(%sp)
	$PUSH	%r12,`-$FRAME+9*$SIZE_T`(%sp)
	$PUSH	%r13,`-$FRAME+10*$SIZE_T`(%sp)
	$PUSH	%r14,`-$FRAME+11*$SIZE_T`(%sp)
	$PUSH	%r15,`-$FRAME+12*$SIZE_T`(%sp)
	$PUSH	%r16,`-$FRAME+13*$SIZE_T`(%sp)

	ldw	0($ctx),$A
	ldw	4($ctx),$B
	ldw	8($ctx),$C
	ldw	12($ctx),$D
	ldw	16($ctx),$E

	extru	$inp,31,2,$t0		; t0=inp&3;
	sh3addl	$t0,%r0,$t0		; t0*=8;
	subi	32,$t0,$t0		; t0=32-t0;
	mtctl	$t0,%cr11		; %sar=t0;

L\$oop
	ldi	3,$t0
	andcm	$inp,$t0,$t0		; 64-bit neutral
___
	for ($i=0;$i<15;$i++) {		# load input block
	$code.="\tldw	`4*$i`($t0),@X[$i]\n";		}
$code.=<<___;
	cmpb,*=	$inp,$t0,L\$aligned
	ldw	60($t0),@X[15]
	ldw	64($t0),@X[16]
___
	for ($i=0;$i<16;$i++) {		# align input
	$code.="\tvshd	@X[$i],@X[$i+1],@X[$i]\n";	}
$code.=<<___;
L\$aligned
	ldil	L'0x5a827000,$K		; K_00_19
	ldo	0x999($K),$K
___
for ($i=0;$i<20;$i++)   { &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	ldil	L'0x6ed9e000,$K		; K_20_39
	ldo	0xba1($K),$K
___

for (;$i<40;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	ldil	L'0x8f1bb000,$K		; K_40_59
	ldo	0xcdc($K),$K
___

for (;$i<60;$i++)       { &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	ldil	L'0xca62c000,$K		; K_60_79
	ldo	0x1d6($K),$K
___
for (;$i<80;$i++)       { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }

$code.=<<___;
	addl	@X[0],$A,$A
	addl	@X[1],$B,$B
	addl	@X[2],$C,$C
	addl	@X[3],$D,$D
	addl	@X[4],$E,$E
	stw	$A,0($ctx)
	stw	$B,4($ctx)
	stw	$C,8($ctx)
	stw	$D,12($ctx)
	stw	$E,16($ctx)
	addib,*<> -1,$num,L\$oop
	ldo	64($inp),$inp

	$POP	`-$FRAME-$SAVED_RP`(%sp),%r2	; standard epilogue
	$POP	`-$FRAME+1*$SIZE_T`(%sp),%r4
	$POP	`-$FRAME+2*$SIZE_T`(%sp),%r5
	$POP	`-$FRAME+3*$SIZE_T`(%sp),%r6
	$POP	`-$FRAME+4*$SIZE_T`(%sp),%r7
	$POP	`-$FRAME+5*$SIZE_T`(%sp),%r8
	$POP	`-$FRAME+6*$SIZE_T`(%sp),%r9
	$POP	`-$FRAME+7*$SIZE_T`(%sp),%r10
	$POP	`-$FRAME+8*$SIZE_T`(%sp),%r11
	$POP	`-$FRAME+9*$SIZE_T`(%sp),%r12
	$POP	`-$FRAME+10*$SIZE_T`(%sp),%r13
	$POP	`-$FRAME+11*$SIZE_T`(%sp),%r14
	$POP	`-$FRAME+12*$SIZE_T`(%sp),%r15
	$POP	`-$FRAME+13*$SIZE_T`(%sp),%r16
	bv	(%r2)
	.EXIT
	$POPMB	-$FRAME(%sp),%r3
	.PROCEND
	.STRINGZ "SHA1 block transform for PA-RISC, CRYPTOGAMS by <appro\@openssl.org>"
___

if (`$ENV{CC} -Wa,-v -c -o /dev/null -x assembler /dev/null 2>&1`
	=~ /GNU assembler/) {
    $gnuas = 1;
}

foreach(split("\n",$code)) {
	s/\`([^\`]*)\`/eval $1/ge;

	s/(\.LEVEL\s+2\.0)W/$1w/	if ($gnuas && $SIZE_T==8);
	s/\.SPACE\s+\$TEXT\$/.text/	if ($gnuas && $SIZE_T==8);
	s/\.SUBSPA.*//			if ($gnuas && $SIZE_T==8);
	s/,\*/,/			if ($SIZE_T==4);
	s/\bbv\b/bve/			if ($SIZE_T==8);

	print $_,"\n";
}
close STDOUT or die "error closing STDOUT: $!";


#! /usr/bin/env perl
# Copyright 2006-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/.
# ====================================================================

# I let hardware handle unaligned input(*), except on page boundaries
# (see below for details). Otherwise straightforward implementation
# with X vector in register bank.
#
# (*) this means that this module is inappropriate for PPC403? Does
#     anybody know if pre-POWER3 can sustain unaligned load?

# 			-m64	-m32
# ----------------------------------
# PPC970,gcc-4.0.0	+76%	+59%
# Power6,xlc-7		+68%	+33%

$flavour = shift;

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

# Define endianness based on flavour
# i.e.: linux64le
$LITTLE_ENDIAN = ($flavour=~/le$/) ? $SIZE_T : 0;

$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+64;
$LOCALS=6*$SIZE_T;

$K  ="r0";
$sp ="r1";
$toc="r2";
$ctx="r3";
$inp="r4";
$num="r5";
$t0 ="r15";
$t1 ="r6";

$A  ="r7";
$B  ="r8";
$C  ="r9";
$D  ="r10";
$E  ="r11";
$T  ="r12";

@V=($A,$B,$C,$D,$E,$T);
@X=("r16","r17","r18","r19","r20","r21","r22","r23",
    "r24","r25","r26","r27","r28","r29","r30","r31");

sub loadbe {
my ($dst, $src, $temp_reg) = @_;
$code.=<<___ if (!$LITTLE_ENDIAN);
	lwz	$dst,$src
___
$code.=<<___ if ($LITTLE_ENDIAN);
	lwz	$temp_reg,$src
	rotlwi	$dst,$temp_reg,8
	rlwimi	$dst,$temp_reg,24,0,7
	rlwimi	$dst,$temp_reg,24,16,23
___
}

sub BODY_00_19 {
my ($i,$a,$b,$c,$d,$e,$f)=@_;
my $j=$i+1;

	# Since the last value of $f is discarded, we can use
	# it as a temp reg to swap byte-order when needed.
	loadbe("@X[$i]","`$i*4`($inp)",$f) if ($i==0);
	loadbe("@X[$j]","`$j*4`($inp)",$f) if ($i<15);
$code.=<<___ if ($i<15);
	add	$f,$K,$e
	rotlwi	$e,$a,5
	add	$f,$f,@X[$i]
	and	$t0,$c,$b
	add	$f,$f,$e
	andc	$t1,$d,$b
	rotlwi	$b,$b,30
	or	$t0,$t0,$t1
	add	$f,$f,$t0
___
$code.=<<___ if ($i>=15);
	add	$f,$K,$e
	rotlwi	$e,$a,5
	xor	@X[$j%16],@X[$j%16],@X[($j+2)%16]
	add	$f,$f,@X[$i%16]
	and	$t0,$c,$b
	xor	@X[$j%16],@X[$j%16],@X[($j+8)%16]
	add	$f,$f,$e
	andc	$t1,$d,$b
	rotlwi	$b,$b,30
	or	$t0,$t0,$t1
	xor	@X[$j%16],@X[$j%16],@X[($j+13)%16]
	add	$f,$f,$t0
	rotlwi	@X[$j%16],@X[$j%16],1
___
}

sub BODY_20_39 {
my ($i,$a,$b,$c,$d,$e,$f)=@_;
my $j=$i+1;
$code.=<<___ if ($i<79);
	add	$f,$K,$e
	xor	$t0,$b,$d
	rotlwi	$e,$a,5
	xor	@X[$j%16],@X[$j%16],@X[($j+2)%16]
	add	$f,$f,@X[$i%16]
	xor	$t0,$t0,$c
	xor	@X[$j%16],@X[$j%16],@X[($j+8)%16]
	add	$f,$f,$t0
	rotlwi	$b,$b,30
	xor	@X[$j%16],@X[$j%16],@X[($j+13)%16]
	add	$f,$f,$e
	rotlwi	@X[$j%16],@X[$j%16],1
___
$code.=<<___ if ($i==79);
	add	$f,$K,$e
	xor	$t0,$b,$d
	rotlwi	$e,$a,5
	lwz	r16,0($ctx)
	add	$f,$f,@X[$i%16]
	xor	$t0,$t0,$c
	lwz	r17,4($ctx)
	add	$f,$f,$t0
	rotlwi	$b,$b,30
	lwz	r18,8($ctx)
	lwz	r19,12($ctx)
	add	$f,$f,$e
	lwz	r20,16($ctx)
___
}

sub BODY_40_59 {
my ($i,$a,$b,$c,$d,$e,$f)=@_;
my $j=$i+1;
$code.=<<___;
	add	$f,$K,$e
	rotlwi	$e,$a,5
	xor	@X[$j%16],@X[$j%16],@X[($j+2)%16]
	add	$f,$f,@X[$i%16]
	and	$t0,$b,$c
	xor	@X[$j%16],@X[$j%16],@X[($j+8)%16]
	add	$f,$f,$e
	or	$t1,$b,$c
	rotlwi	$b,$b,30
	xor	@X[$j%16],@X[$j%16],@X[($j+13)%16]
	and	$t1,$t1,$d
	or	$t0,$t0,$t1
	rotlwi	@X[$j%16],@X[$j%16],1
	add	$f,$f,$t0
___
}

$code=<<___;
.machine	"any"
.text

.globl	.sha1_block_data_order
.align	4
.sha1_block_data_order:
	$STU	$sp,-$FRAME($sp)
	mflr	r0
	$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)
	lwz	$A,0($ctx)
	lwz	$B,4($ctx)
	lwz	$C,8($ctx)
	lwz	$D,12($ctx)
	lwz	$E,16($ctx)
	andi.	r0,$inp,3
	bne	Lunaligned
Laligned:
	mtctr	$num
	bl	Lsha1_block_private
	b	Ldone

; PowerPC specification allows an implementation to be ill-behaved
; upon unaligned access which crosses page boundary. "Better safe
; than sorry" principle makes me treat it specially. But I don't
; look for particular offending word, but rather for 64-byte input
; block which crosses the boundary. Once found that block is aligned
; and hashed separately...
.align	4
Lunaligned:
	subfic	$t1,$inp,4096
	andi.	$t1,$t1,4095	; distance to closest page boundary
	srwi.	$t1,$t1,6	; t1/=64
	beq	Lcross_page
	$UCMP	$num,$t1
	ble	Laligned	; didn't cross the page boundary
	mtctr	$t1
	subfc	$num,$t1,$num
	bl	Lsha1_block_private
Lcross_page:
	li	$t1,16
	mtctr	$t1
	addi	r20,$sp,$LOCALS	; spot within the frame
Lmemcpy:
	lbz	r16,0($inp)
	lbz	r17,1($inp)
	lbz	r18,2($inp)
	lbz	r19,3($inp)
	addi	$inp,$inp,4
	stb	r16,0(r20)
	stb	r17,1(r20)
	stb	r18,2(r20)
	stb	r19,3(r20)
	addi	r20,r20,4
	bdnz	Lmemcpy

	$PUSH	$inp,`$FRAME-$SIZE_T*18`($sp)
	li	$t1,1
	addi	$inp,$sp,$LOCALS
	mtctr	$t1
	bl	Lsha1_block_private
	$POP	$inp,`$FRAME-$SIZE_T*18`($sp)
	addic.	$num,$num,-1
	bne	Lunaligned

Ldone:
	$POP	r0,`$FRAME+$LRSAVE`($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,3,0
	.long	0
___

# This is private block function, which uses tailored calling
# interface, namely upon entry SHA_CTX is pre-loaded to given
# registers and counter register contains amount of chunks to
# digest...
$code.=<<___;
.align	4
Lsha1_block_private:
___
$code.=<<___;	# load K_00_19
	lis	$K,0x5a82
	ori	$K,$K,0x7999
___
for($i=0;$i<20;$i++)	{ &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;	# load K_20_39
	lis	$K,0x6ed9
	ori	$K,$K,0xeba1
___
for(;$i<40;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;	# load K_40_59
	lis	$K,0x8f1b
	ori	$K,$K,0xbcdc
___
for(;$i<60;$i++)	{ &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;	# load K_60_79
	lis	$K,0xca62
	ori	$K,$K,0xc1d6
___
for(;$i<80;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	add	r16,r16,$E
	add	r17,r17,$T
	add	r18,r18,$A
	add	r19,r19,$B
	add	r20,r20,$C
	stw	r16,0($ctx)
	mr	$A,r16
	stw	r17,4($ctx)
	mr	$B,r17
	stw	r18,8($ctx)
	mr	$C,r18
	stw	r19,12($ctx)
	mr	$D,r19
	stw	r20,16($ctx)
	mr	$E,r20
	addi	$inp,$inp,`16*4`
	bdnz	Lsha1_block_private
	blr
	.long	0
	.byte	0,12,0x14,0,0,0,0,0
.size	.sha1_block_data_order,.-.sha1_block_data_order
___
$code.=<<___;
.asciz	"SHA1 block transform for PPC, CRYPTOGAMS by <appro\@fy.chalmers.se>"
___

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


#! /usr/bin/env perl
# Copyright 2007-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html

# ====================================================================
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
# project. The module is, however, dual licensed under OpenSSL and
# CRYPTOGAMS licenses depending on where you obtain it. For further
# details see http://www.openssl.org/~appro/cryptogams/.
# ====================================================================

# SHA1 block procedure for s390x.

# April 2007.
#
# Performance is >30% better than gcc 3.3 generated code. But the real
# twist is that SHA1 hardware support is detected and utilized. In
# which case performance can reach further >4.5x for larger chunks.

# January 2009.
#
# Optimize Xupdate for amount of memory references and reschedule
# instructions to favour dual-issue z10 pipeline. On z10 hardware is
# "only" ~2.3x faster than software.

# November 2010.
#
# Adapt for -m31 build. If kernel supports what's called "highgprs"
# feature on Linux [see /proc/cpuinfo], it's possible to use 64-bit
# instructions and achieve "64-bit" performance even in 31-bit legacy
# application context. The feature is not specific to any particular
# processor, as long as it's "z-CPU". Latter implies that the code
# remains z/Architecture specific. On z990 it was measured to perform
# 23% better than code generated by gcc 4.3.

$kimdfunc=1;	# magic function code for kimd instruction

$flavour = shift;

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

while (($output=shift) && ($output!~/\w[\w\-]*\.\w+$/)) {}
open STDOUT,">$output";

$K_00_39="%r0"; $K=$K_00_39;
$K_40_79="%r1";
$ctx="%r2";	$prefetch="%r2";
$inp="%r3";
$len="%r4";

$A="%r5";
$B="%r6";
$C="%r7";
$D="%r8";
$E="%r9";	@V=($A,$B,$C,$D,$E);
$t0="%r10";
$t1="%r11";
@X=("%r12","%r13","%r14");
$sp="%r15";

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

sub Xupdate {
my $i=shift;

$code.=<<___ if ($i==15);
	lg	$prefetch,$stdframe($sp)	### Xupdate(16) warm-up
	lr	$X[0],$X[2]
___
return if ($i&1);	# Xupdate is vectorized and executed every 2nd cycle
$code.=<<___ if ($i<16);
	lg	$X[0],`$i*4`($inp)	### Xload($i)
	rllg	$X[1],$X[0],32
___
$code.=<<___ if ($i>=16);
	xgr	$X[0],$prefetch		### Xupdate($i)
	lg	$prefetch,`$stdframe+4*(($i+2)%16)`($sp)
	xg	$X[0],`$stdframe+4*(($i+8)%16)`($sp)
	xgr	$X[0],$prefetch
	rll	$X[0],$X[0],1
	rllg	$X[1],$X[0],32
	rll	$X[1],$X[1],1
	rllg	$X[0],$X[1],32
	lr	$X[2],$X[1]		# feedback
___
$code.=<<___ if ($i<=70);
	stg	$X[0],`$stdframe+4*($i%16)`($sp)
___
unshift(@X,pop(@X));
}

sub BODY_00_19 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi=$X[1];

	&Xupdate($i);
$code.=<<___;
	alr	$e,$K		### $i
	rll	$t1,$a,5
	lr	$t0,$d
	xr	$t0,$c
	alr	$e,$t1
	nr	$t0,$b
	alr	$e,$xi
	xr	$t0,$d
	rll	$b,$b,30
	alr	$e,$t0
___
}

sub BODY_20_39 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi=$X[1];

	&Xupdate($i);
$code.=<<___;
	alr	$e,$K		### $i
	rll	$t1,$a,5
	lr	$t0,$b
	alr	$e,$t1
	xr	$t0,$c
	alr	$e,$xi
	xr	$t0,$d
	rll	$b,$b,30
	alr	$e,$t0
___
}

sub BODY_40_59 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi=$X[1];

	&Xupdate($i);
$code.=<<___;
	alr	$e,$K		### $i
	rll	$t1,$a,5
	lr	$t0,$b
	alr	$e,$t1
	or	$t0,$c
	lr	$t1,$b
	nr	$t0,$d
	nr	$t1,$c
	alr	$e,$xi
	or	$t0,$t1
	rll	$b,$b,30
	alr	$e,$t0
___
}

$code.=<<___;
#include "s390x_arch.h"

.text
.align	64
.type	Ktable,\@object
Ktable: .long	0x5a827999,0x6ed9eba1,0x8f1bbcdc,0xca62c1d6
	.skip	48	#.long	0,0,0,0,0,0,0,0,0,0,0,0
.size	Ktable,.-Ktable
.globl	sha1_block_data_order
.type	sha1_block_data_order,\@function
sha1_block_data_order:
___
$code.=<<___ if ($kimdfunc);
	larl	%r1,OPENSSL_s390xcap_P
	lg	%r0,S390X_KIMD(%r1)	# check kimd capabilities
	tmhh	%r0,`0x8000>>$kimdfunc`
	jz	.Lsoftware
	lghi	%r0,$kimdfunc
	lgr	%r1,$ctx
	lgr	%r2,$inp
	sllg	%r3,$len,6
	.long	0xb93e0002	# kimd %r0,%r2
	brc	1,.-4		# pay attention to "partial completion"
	br	%r14
.align	16
.Lsoftware:
___
$code.=<<___;
	lghi	%r1,-$frame
	st${g}	$ctx,`2*$SIZE_T`($sp)
	stm${g}	%r6,%r15,`6*$SIZE_T`($sp)
	lgr	%r0,$sp
	la	$sp,0(%r1,$sp)
	st${g}	%r0,0($sp)

	larl	$t0,Ktable
	llgf	$A,0($ctx)
	llgf	$B,4($ctx)
	llgf	$C,8($ctx)
	llgf	$D,12($ctx)
	llgf	$E,16($ctx)

	lg	$K_00_39,0($t0)
	lg	$K_40_79,8($t0)

.Lloop:
	rllg	$K_00_39,$K_00_39,32
___
for ($i=0;$i<20;$i++)	{ &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	rllg	$K_00_39,$K_00_39,32
___
for (;$i<40;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;	$K=$K_40_79;
	rllg	$K_40_79,$K_40_79,32
___
for (;$i<60;$i++)	{ &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	rllg	$K_40_79,$K_40_79,32
___
for (;$i<80;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;

	l${g}	$ctx,`$frame+2*$SIZE_T`($sp)
	la	$inp,64($inp)
	al	$A,0($ctx)
	al	$B,4($ctx)
	al	$C,8($ctx)
	al	$D,12($ctx)
	al	$E,16($ctx)
	st	$A,0($ctx)
	st	$B,4($ctx)
	st	$C,8($ctx)
	st	$D,12($ctx)
	st	$E,16($ctx)
	brct${g} $len,.Lloop

	lm${g}	%r6,%r15,`$frame+6*$SIZE_T`($sp)
	br	%r14
.size	sha1_block_data_order,.-sha1_block_data_order
.string	"SHA1 block transform for s390x, CRYPTOGAMS by <appro\@openssl.org>"
___

$code =~ s/\`([^\`]*)\`/eval $1/gem;

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


#! /usr/bin/env perl
# Copyright 2007-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html

# ====================================================================
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
# project. The module is, however, dual licensed under OpenSSL and
# CRYPTOGAMS licenses depending on where you obtain it. For further
# details see http://www.openssl.org/~appro/cryptogams/.
#
# Hardware SPARC T4 support by David S. Miller
# ====================================================================

# Performance improvement is not really impressive on pre-T1 CPU: +8%
# over Sun C and +25% over gcc [3.3]. While on T1, a.k.a. Niagara, it
# turned to be 40% faster than 64-bit code generated by Sun C 5.8 and
# >2x than 64-bit code generated by gcc 3.4. And there is a gimmick.
# X[16] vector is packed to 8 64-bit registers and as result nothing
# is spilled on stack. In addition input data is loaded in compact
# instruction sequence, thus minimizing the window when the code is
# subject to [inter-thread] cache-thrashing hazard. The goal is to
# ensure scalability on UltraSPARC T1, or rather to avoid decay when
# amount of active threads exceeds the number of physical cores.

# SPARC T4 SHA1 hardware achieves 3.72 cycles per byte, which is 3.1x
# faster than software. Multi-process benchmark saturates at 11x
# single-process result on 8-core processor, or ~9GBps per 2.85GHz
# socket.

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

@X=("%o0","%o1","%o2","%o3","%o4","%o5","%g1","%o7");
$rot1m="%g2";
$tmp64="%g3";
$Xi="%g4";
$A="%l0";
$B="%l1";
$C="%l2";
$D="%l3";
$E="%l4";
@V=($A,$B,$C,$D,$E);
$K_00_19="%l5";
$K_20_39="%l6";
$K_40_59="%l7";
$K_60_79="%g5";
@K=($K_00_19,$K_20_39,$K_40_59,$K_60_79);

$ctx="%i0";
$inp="%i1";
$len="%i2";
$tmp0="%i3";
$tmp1="%i4";
$tmp2="%i5";

sub BODY_00_15 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi=($i&1)?@X[($i/2)%8]:$Xi;

$code.=<<___;
	sll	$a,5,$tmp0		!! $i
	add	@K[$i/20],$e,$e
	srl	$a,27,$tmp1
	add	$tmp0,$e,$e
	and	$c,$b,$tmp0
	add	$tmp1,$e,$e
	sll	$b,30,$tmp2
	andn	$d,$b,$tmp1
	srl	$b,2,$b
	or	$tmp1,$tmp0,$tmp1
	or	$tmp2,$b,$b
	add	$xi,$e,$e
___
if ($i&1 && $i<15) {
	$code.=
	"	srlx	@X[(($i+1)/2)%8],32,$Xi\n";
}
$code.=<<___;
	add	$tmp1,$e,$e
___
}

sub Xupdate {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i/2;

if ($i&1) {
$code.=<<___;
	sll	$a,5,$tmp0		!! $i
	add	@K[$i/20],$e,$e
	srl	$a,27,$tmp1
___
} else {
$code.=<<___;
	sllx	@X[($j+6)%8],32,$Xi	! Xupdate($i)
	xor	@X[($j+1)%8],@X[$j%8],@X[$j%8]
	srlx	@X[($j+7)%8],32,$tmp1
	xor	@X[($j+4)%8],@X[$j%8],@X[$j%8]
	sll	$a,5,$tmp0		!! $i
	or	$tmp1,$Xi,$Xi
	add	@K[$i/20],$e,$e		!!
	xor	$Xi,@X[$j%8],@X[$j%8]
	srlx	@X[$j%8],31,$Xi
	add	@X[$j%8],@X[$j%8],@X[$j%8]
	and	$Xi,$rot1m,$Xi
	andn	@X[$j%8],$rot1m,@X[$j%8]
	srl	$a,27,$tmp1		!!
	or	$Xi,@X[$j%8],@X[$j%8]
___
}
}

sub BODY_16_19 {
my ($i,$a,$b,$c,$d,$e)=@_;

	&Xupdate(@_);
    if ($i&1) {
	$xi=@X[($i/2)%8];
    } else {
	$xi=$Xi;
	$code.="\tsrlx	@X[($i/2)%8],32,$xi\n";
    }
$code.=<<___;
	add	$tmp0,$e,$e		!!
	and	$c,$b,$tmp0
	add	$tmp1,$e,$e
	sll	$b,30,$tmp2
	add	$xi,$e,$e
	andn	$d,$b,$tmp1
	srl	$b,2,$b
	or	$tmp1,$tmp0,$tmp1
	or	$tmp2,$b,$b
	add	$tmp1,$e,$e
___
}

sub BODY_20_39 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi;
	&Xupdate(@_);
    if ($i&1) {
	$xi=@X[($i/2)%8];
    } else {
	$xi=$Xi;
	$code.="\tsrlx	@X[($i/2)%8],32,$xi\n";
    }
$code.=<<___;
	add	$tmp0,$e,$e		!!
	xor	$c,$b,$tmp0
	add	$tmp1,$e,$e
	sll	$b,30,$tmp2
	xor	$d,$tmp0,$tmp1
	srl	$b,2,$b
	add	$tmp1,$e,$e
	or	$tmp2,$b,$b
	add	$xi,$e,$e
___
}

sub BODY_40_59 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $xi;
	&Xupdate(@_);
    if ($i&1) {
	$xi=@X[($i/2)%8];
    } else {
	$xi=$Xi;
	$code.="\tsrlx	@X[($i/2)%8],32,$xi\n";
    }
$code.=<<___;
	add	$tmp0,$e,$e		!!
	and	$c,$b,$tmp0
	add	$tmp1,$e,$e
	sll	$b,30,$tmp2
	or	$c,$b,$tmp1
	srl	$b,2,$b
	and	$d,$tmp1,$tmp1
	add	$xi,$e,$e
	or	$tmp1,$tmp0,$tmp1
	or	$tmp2,$b,$b
	add	$tmp1,$e,$e
___
}

$code.=<<___;
#include "sparc_arch.h"

#ifdef __arch64__
.register	%g2,#scratch
.register	%g3,#scratch
#endif

.section	".text",#alloc,#execinstr

#ifdef __PIC__
SPARC_PIC_THUNK(%g1)
#endif

.align	32
.globl	sha1_block_data_order
sha1_block_data_order:
	SPARC_LOAD_ADDRESS_LEAF(OPENSSL_sparcv9cap_P,%g1,%g5)
	ld	[%g1+4],%g1		! OPENSSL_sparcv9cap_P[1]

	andcc	%g1, CFR_SHA1, %g0
	be	.Lsoftware
	nop

	ld	[%o0 + 0x00], %f0	! load context
	ld	[%o0 + 0x04], %f1
	ld	[%o0 + 0x08], %f2
	andcc	%o1, 0x7, %g0
	ld	[%o0 + 0x0c], %f3
	bne,pn	%icc, .Lhwunaligned
	 ld	[%o0 + 0x10], %f4

.Lhw_loop:
	ldd	[%o1 + 0x00], %f8
	ldd	[%o1 + 0x08], %f10
	ldd	[%o1 + 0x10], %f12
	ldd	[%o1 + 0x18], %f14
	ldd	[%o1 + 0x20], %f16
	ldd	[%o1 + 0x28], %f18
	ldd	[%o1 + 0x30], %f20
	subcc	%o2, 1, %o2		! done yet?
	ldd	[%o1 + 0x38], %f22
	add	%o1, 0x40, %o1
	prefetch [%o1 + 63], 20

	.word	0x81b02820		! SHA1

	bne,pt	SIZE_T_CC, .Lhw_loop
	nop

.Lhwfinish:
	st	%f0, [%o0 + 0x00]	! store context
	st	%f1, [%o0 + 0x04]
	st	%f2, [%o0 + 0x08]
	st	%f3, [%o0 + 0x0c]
	retl
	st	%f4, [%o0 + 0x10]

.align	8
.Lhwunaligned:
	alignaddr %o1, %g0, %o1

	ldd	[%o1 + 0x00], %f10
.Lhwunaligned_loop:
	ldd	[%o1 + 0x08], %f12
	ldd	[%o1 + 0x10], %f14
	ldd	[%o1 + 0x18], %f16
	ldd	[%o1 + 0x20], %f18
	ldd	[%o1 + 0x28], %f20
	ldd	[%o1 + 0x30], %f22
	ldd	[%o1 + 0x38], %f24
	subcc	%o2, 1, %o2		! done yet?
	ldd	[%o1 + 0x40], %f26
	add	%o1, 0x40, %o1
	prefetch [%o1 + 63], 20

	faligndata %f10, %f12, %f8
	faligndata %f12, %f14, %f10
	faligndata %f14, %f16, %f12
	faligndata %f16, %f18, %f14
	faligndata %f18, %f20, %f16
	faligndata %f20, %f22, %f18
	faligndata %f22, %f24, %f20
	faligndata %f24, %f26, %f22

	.word	0x81b02820		! SHA1

	bne,pt	SIZE_T_CC, .Lhwunaligned_loop
	for	%f26, %f26, %f10	! %f10=%f26

	ba	.Lhwfinish
	nop

.align	16
.Lsoftware:
	save	%sp,-STACK_FRAME,%sp
	sllx	$len,6,$len
	add	$inp,$len,$len

	or	%g0,1,$rot1m
	sllx	$rot1m,32,$rot1m
	or	$rot1m,1,$rot1m

	ld	[$ctx+0],$A
	ld	[$ctx+4],$B
	ld	[$ctx+8],$C
	ld	[$ctx+12],$D
	ld	[$ctx+16],$E
	andn	$inp,7,$tmp0

	sethi	%hi(0x5a827999),$K_00_19
	or	$K_00_19,%lo(0x5a827999),$K_00_19
	sethi	%hi(0x6ed9eba1),$K_20_39
	or	$K_20_39,%lo(0x6ed9eba1),$K_20_39
	sethi	%hi(0x8f1bbcdc),$K_40_59
	or	$K_40_59,%lo(0x8f1bbcdc),$K_40_59
	sethi	%hi(0xca62c1d6),$K_60_79
	or	$K_60_79,%lo(0xca62c1d6),$K_60_79

.Lloop:
	ldx	[$tmp0+0],@X[0]
	ldx	[$tmp0+16],@X[2]
	ldx	[$tmp0+32],@X[4]
	ldx	[$tmp0+48],@X[6]
	and	$inp,7,$tmp1
	ldx	[$tmp0+8],@X[1]
	sll	$tmp1,3,$tmp1
	ldx	[$tmp0+24],@X[3]
	subcc	%g0,$tmp1,$tmp2	! should be 64-$tmp1, but -$tmp1 works too
	ldx	[$tmp0+40],@X[5]
	bz,pt	%icc,.Laligned
	ldx	[$tmp0+56],@X[7]

	sllx	@X[0],$tmp1,@X[0]
	ldx	[$tmp0+64],$tmp64
___
for($i=0;$i<7;$i++)
{   $code.=<<___;
	srlx	@X[$i+1],$tmp2,$Xi
	sllx	@X[$i+1],$tmp1,@X[$i+1]
	or	$Xi,@X[$i],@X[$i]
___
}
$code.=<<___;
	srlx	$tmp64,$tmp2,$tmp64
	or	$tmp64,@X[7],@X[7]
.Laligned:
	srlx	@X[0],32,$Xi
___
for ($i=0;$i<16;$i++)	{ &BODY_00_15($i,@V); unshift(@V,pop(@V)); }
for (;$i<20;$i++)	{ &BODY_16_19($i,@V); unshift(@V,pop(@V)); }
for (;$i<40;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
for (;$i<60;$i++)	{ &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
for (;$i<80;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;

	ld	[$ctx+0],@X[0]
	ld	[$ctx+4],@X[1]
	ld	[$ctx+8],@X[2]
	ld	[$ctx+12],@X[3]
	add	$inp,64,$inp
	ld	[$ctx+16],@X[4]
	cmp	$inp,$len

	add	$A,@X[0],$A
	st	$A,[$ctx+0]
	add	$B,@X[1],$B
	st	$B,[$ctx+4]
	add	$C,@X[2],$C
	st	$C,[$ctx+8]
	add	$D,@X[3],$D
	st	$D,[$ctx+12]
	add	$E,@X[4],$E
	st	$E,[$ctx+16]

	bne	SIZE_T_CC,.Lloop
	andn	$inp,7,$tmp0

	ret
	restore
.type	sha1_block_data_order,#function
.size	sha1_block_data_order,(.-sha1_block_data_order)
.asciz	"SHA1 block transform for SPARCv9, CRYPTOGAMS by <appro\@openssl.org>"
.align	4
___

# Purpose of these subroutines is to explicitly encode VIS instructions,
# so that one can compile the module without having to specify VIS
# extensions on compiler command line, e.g. -xarch=v9 vs. -xarch=v9a.
# Idea is to reserve for option to produce "universal" binary and let
# programmer detect if current CPU is VIS capable at run-time.
sub unvis {
my ($mnemonic,$rs1,$rs2,$rd)=@_;
my $ref,$opf;
my %visopf = (	"faligndata"	=> 0x048,
		"for"		=> 0x07c	);

    $ref = "$mnemonic\t$rs1,$rs2,$rd";

    if ($opf=$visopf{$mnemonic}) {
	foreach ($rs1,$rs2,$rd) {
	    return $ref if (!/%f([0-9]{1,2})/);
	    $_=$1;
	    if ($1>=32) {
		return $ref if ($1&1);
		# re-encode for upper double register addressing
		$_=($1|$1>>5)&31;
	    }
	}

	return	sprintf ".word\t0x%08x !%s",
			0x81b00000|$rd<<25|$rs1<<14|$opf<<5|$rs2,
			$ref;
    } else {
	return $ref;
    }
}
sub unalignaddr {
my ($mnemonic,$rs1,$rs2,$rd)=@_;
my %bias = ( "g" => 0, "o" => 8, "l" => 16, "i" => 24 );
my $ref="$mnemonic\t$rs1,$rs2,$rd";

    foreach ($rs1,$rs2,$rd) {
	if (/%([goli])([0-7])/)	{ $_=$bias{$1}+$2; }
	else			{ return $ref; }
    }
    return  sprintf ".word\t0x%08x !%s",
		    0x81b00300|$rd<<25|$rs1<<14|$rs2,
		    $ref;
}

foreach (split("\n",$code)) {
	s/\`([^\`]*)\`/eval $1/ge;

	s/\b(f[^\s]*)\s+(%f[0-9]{1,2}),\s*(%f[0-9]{1,2}),\s*(%f[0-9]{1,2})/
		&unvis($1,$2,$3,$4)
	 /ge;
	s/\b(alignaddr)\s+(%[goli][0-7]),\s*(%[goli][0-7]),\s*(%[goli][0-7])/
		&unalignaddr($1,$2,$3,$4)
	 /ge;

	print $_,"\n";
}

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


#! /usr/bin/env perl
# Copyright 2009-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html

# ====================================================================
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
# project. The module is, however, dual licensed under OpenSSL and
# CRYPTOGAMS licenses depending on where you obtain it. For further
# details see http://www.openssl.org/~appro/cryptogams/.
# ====================================================================

# January 2009
#
# Provided that UltraSPARC VIS instructions are pipe-lined(*) and
# pairable(*) with IALU ones, offloading of Xupdate to the UltraSPARC
# Graphic Unit would make it possible to achieve higher instruction-
# level parallelism, ILP, and thus higher performance. It should be
# explicitly noted that ILP is the keyword, and it means that this
# code would be unsuitable for cores like UltraSPARC-Tx. The idea is
# not really novel, Sun had VIS-powered implementation for a while.
# Unlike Sun's implementation this one can process multiple unaligned
# input blocks, and as such works as drop-in replacement for OpenSSL
# sha1_block_data_order. Performance improvement was measured to be
# 40% over pure IALU sha1-sparcv9.pl on UltraSPARC-IIi, but 12% on
# UltraSPARC-III. See below for discussion...
#
# The module does not present direct interest for OpenSSL, because
# it doesn't provide better performance on contemporary SPARCv9 CPUs,
# UltraSPARC-Tx and SPARC64-V[II] to be specific. Those who feel they
# absolutely must score on UltraSPARC-I-IV can simply replace
# crypto/sha/asm/sha1-sparcv9.pl with this module.
#
# (*)	"Pipe-lined" means that even if it takes several cycles to
#	complete, next instruction using same functional unit [but not
#	depending on the result of the current instruction] can start
#	execution without having to wait for the unit. "Pairable"
#	means that two [or more] independent instructions can be
#	issued at the very same time.

$bits=32;
for (@ARGV)	{ $bits=64 if (/\-m64/ || /\-xarch\=v9/); }
if ($bits==64)	{ $bias=2047; $frame=192; }
else		{ $bias=0;    $frame=112; }

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

$ctx="%i0";
$inp="%i1";
$len="%i2";
$tmp0="%i3";
$tmp1="%i4";
$tmp2="%i5";
$tmp3="%g5";

$base="%g1";
$align="%g4";
$Xfer="%o5";
$nXfer=$tmp3;
$Xi="%o7";

$A="%l0";
$B="%l1";
$C="%l2";
$D="%l3";
$E="%l4";
@V=($A,$B,$C,$D,$E);

$Actx="%o0";
$Bctx="%o1";
$Cctx="%o2";
$Dctx="%o3";
$Ectx="%o4";

$fmul="%f32";
$VK_00_19="%f34";
$VK_20_39="%f36";
$VK_40_59="%f38";
$VK_60_79="%f40";
@VK=($VK_00_19,$VK_20_39,$VK_40_59,$VK_60_79);
@X=("%f0", "%f1", "%f2", "%f3", "%f4", "%f5", "%f6", "%f7",
    "%f8", "%f9","%f10","%f11","%f12","%f13","%f14","%f15","%f16");

# This is reference 2x-parallelized VIS-powered Xupdate procedure. It
# covers even K_NN_MM addition...
sub Xupdate {
my ($i)=@_;
my $K=@VK[($i+16)/20];
my $j=($i+16)%16;

#	[ provided that GSR.alignaddr_offset is 5, $mul contains
#	  0x100ULL<<32|0x100 value and K_NN_MM are pre-loaded to
#	  chosen registers... ]
$code.=<<___;
	fxors		@X[($j+13)%16],@X[$j],@X[$j]	!-1/-1/-1:X[0]^=X[13]
	fxors		@X[($j+14)%16],@X[$j+1],@X[$j+1]! 0/ 0/ 0:X[1]^=X[14]
	fxor		@X[($j+2)%16],@X[($j+8)%16],%f18! 1/ 1/ 1:Tmp=X[2,3]^X[8,9]
	fxor		%f18,@X[$j],@X[$j]		! 2/ 4/ 3:X[0,1]^=X[2,3]^X[8,9]
	faligndata	@X[$j],@X[$j],%f18		! 3/ 7/ 5:Tmp=X[0,1]>>>24
	fpadd32		@X[$j],@X[$j],@X[$j]		! 4/ 8/ 6:X[0,1]<<=1
	fmul8ulx16	%f18,$fmul,%f18			! 5/10/ 7:Tmp>>=7, Tmp&=1
	![fxors		%f15,%f2,%f2]
	for		%f18,@X[$j],@X[$j]		! 8/14/10:X[0,1]|=Tmp
	![fxors		%f0,%f3,%f3]			!10/17/12:X[0] dependency
	fpadd32		$K,@X[$j],%f20
	std		%f20,[$Xfer+`4*$j`]
___
# The numbers delimited with slash are the earliest possible dispatch
# cycles for given instruction assuming 1 cycle latency for simple VIS
# instructions, such as on UltraSPARC-I&II, 3 cycles latency, such as
# on UltraSPARC-III&IV, and 2 cycles latency(*), respectively. Being
# 2x-parallelized the procedure is "worth" 5, 8.5 or 6 ticks per SHA1
# round. As [long as] FPU/VIS instructions are perfectly pairable with
# IALU ones, the round timing is defined by the maximum between VIS
# and IALU timings. The latter varies from round to round and averages
# out at 6.25 ticks. This means that USI&II should operate at IALU
# rate, while USIII&IV - at VIS rate. This explains why performance
# improvement varies among processors. Well, given that pure IALU
# sha1-sparcv9.pl module exhibits virtually uniform performance of
# ~9.3 cycles per SHA1 round. Timings mentioned above are theoretical
# lower limits. Real-life performance was measured to be 6.6 cycles
# per SHA1 round on USIIi and 8.3 on USIII. The latter is lower than
# half-round VIS timing, because there are 16 Xupdate-free rounds,
# which "push down" average theoretical timing to 8 cycles...

# (*)	SPARC64-V[II] was originally believed to have 2 cycles VIS
#	latency. Well, it might have, but it doesn't have dedicated
#	VIS-unit. Instead, VIS instructions are executed by other
#	functional units, ones used here - by IALU. This doesn't
#	improve effective ILP...
}

# The reference Xupdate procedure is then "strained" over *pairs* of
# BODY_NN_MM and kind of modulo-scheduled in respect to X[n]^=X[n+13]
# and K_NN_MM addition. It's "running" 15 rounds ahead, which leaves
# plenty of room to amortize for read-after-write hazard, as well as
# to fetch and align input for the next spin. The VIS instructions are
# scheduled for latency of 2 cycles, because there are not enough IALU
# instructions to schedule for latency of 3, while scheduling for 1
# would give no gain on USI&II anyway.

sub BODY_00_19 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i&~1;
my $k=($j+16+2)%16;	# ahead reference
my $l=($j+16-2)%16;	# behind reference
my $K=@VK[($j+16-2)/20];

$j=($j+16)%16;

$code.=<<___ if (!($i&1));
	sll		$a,5,$tmp0			!! $i
	and		$c,$b,$tmp3
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fxors		@X[($j+14)%16],@X[$j+1],@X[$j+1]! 0/ 0/ 0:X[1]^=X[14]
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fxor		@X[($j+2)%16],@X[($j+8)%16],%f18! 1/ 1/ 1:Tmp=X[2,3]^X[8,9]
	sll		$b,30,$tmp2
	add		$tmp1,$e,$e
	andn		$d,$b,$tmp1
	add		$Xi,$e,$e
	 fxor		%f18,@X[$j],@X[$j]		! 2/ 4/ 3:X[0,1]^=X[2,3]^X[8,9]
	srl		$b,2,$b
	or		$tmp1,$tmp3,$tmp1
	or		$tmp2,$b,$b
	add		$tmp1,$e,$e
	 faligndata	@X[$j],@X[$j],%f18		! 3/ 7/ 5:Tmp=X[0,1]>>>24
___
$code.=<<___ if ($i&1);
	sll		$a,5,$tmp0			!! $i
	and		$c,$b,$tmp3
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fpadd32	@X[$j],@X[$j],@X[$j]		! 4/ 8/ 6:X[0,1]<<=1
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fmul8ulx16	%f18,$fmul,%f18			! 5/10/ 7:Tmp>>=7, Tmp&=1
	sll		$b,30,$tmp2
	add		$tmp1,$e,$e
	 fpadd32	$K,@X[$l],%f20			!
	andn		$d,$b,$tmp1
	add		$Xi,$e,$e
	 fxors		@X[($k+13)%16],@X[$k],@X[$k]	!-1/-1/-1:X[0]^=X[13]
	srl		$b,2,$b
	or		$tmp1,$tmp3,$tmp1
	 fxor		%f18,@X[$j],@X[$j]		! 8/14/10:X[0,1]|=Tmp
	or		$tmp2,$b,$b
	add		$tmp1,$e,$e
___
$code.=<<___ if ($i&1 && $i>=2);
	 std		%f20,[$Xfer+`4*$l`]		!
___
}

sub BODY_20_39 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i&~1;
my $k=($j+16+2)%16;	# ahead reference
my $l=($j+16-2)%16;	# behind reference
my $K=@VK[($j+16-2)/20];

$j=($j+16)%16;

$code.=<<___ if (!($i&1) && $i<64);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fxors		@X[($j+14)%16],@X[$j+1],@X[$j+1]! 0/ 0/ 0:X[1]^=X[14]
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fxor		@X[($j+2)%16],@X[($j+8)%16],%f18! 1/ 1/ 1:Tmp=X[2,3]^X[8,9]
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	 fxor		%f18,@X[$j],@X[$j]		! 2/ 4/ 3:X[0,1]^=X[2,3]^X[8,9]
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
	 faligndata	@X[$j],@X[$j],%f18		! 3/ 7/ 5:Tmp=X[0,1]>>>24
___
$code.=<<___ if ($i&1 && $i<64);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fpadd32	@X[$j],@X[$j],@X[$j]		! 4/ 8/ 6:X[0,1]<<=1
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fmul8ulx16	%f18,$fmul,%f18			! 5/10/ 7:Tmp>>=7, Tmp&=1
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	 fpadd32	$K,@X[$l],%f20			!
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	 fxors		@X[($k+13)%16],@X[$k],@X[$k]	!-1/-1/-1:X[0]^=X[13]
	srl		$b,2,$b
	add		$tmp1,$e,$e
	 fxor		%f18,@X[$j],@X[$j]		! 8/14/10:X[0,1]|=Tmp
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
	 std		%f20,[$Xfer+`4*$l`]		!
___
$code.=<<___ if ($i==64);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fpadd32	$K,@X[$l],%f20
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	 std		%f20,[$Xfer+`4*$l`]
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
___
$code.=<<___ if ($i>64);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
___
}

sub BODY_40_59 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i&~1;
my $k=($j+16+2)%16;	# ahead reference
my $l=($j+16-2)%16;	# behind reference
my $K=@VK[($j+16-2)/20];

$j=($j+16)%16;

$code.=<<___ if (!($i&1));
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	 fxors		@X[($j+14)%16],@X[$j+1],@X[$j+1]! 0/ 0/ 0:X[1]^=X[14]
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fxor		@X[($j+2)%16],@X[($j+8)%16],%f18! 1/ 1/ 1:Tmp=X[2,3]^X[8,9]
	and		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	or		$c,$b,$tmp1
	 fxor		%f18,@X[$j],@X[$j]		! 2/ 4/ 3:X[0,1]^=X[2,3]^X[8,9]
	srl		$b,2,$b
	and		$d,$tmp1,$tmp1
	add		$Xi,$e,$e
	or		$tmp1,$tmp0,$tmp1
	 faligndata	@X[$j],@X[$j],%f18		! 3/ 7/ 5:Tmp=X[0,1]>>>24
	or		$tmp2,$b,$b
	add		$tmp1,$e,$e
	 fpadd32	@X[$j],@X[$j],@X[$j]		! 4/ 8/ 6:X[0,1]<<=1
___
$code.=<<___ if ($i&1);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 fmul8ulx16	%f18,$fmul,%f18			! 5/10/ 7:Tmp>>=7, Tmp&=1
	and		$c,$b,$tmp0
	add		$tmp1,$e,$e
	 fpadd32	$K,@X[$l],%f20			!
	sll		$b,30,$tmp2
	or		$c,$b,$tmp1
	 fxors		@X[($k+13)%16],@X[$k],@X[$k]	!-1/-1/-1:X[0]^=X[13]
	srl		$b,2,$b
	and		$d,$tmp1,$tmp1
	 fxor		%f18,@X[$j],@X[$j]		! 8/14/10:X[0,1]|=Tmp
	add		$Xi,$e,$e
	or		$tmp1,$tmp0,$tmp1
	or		$tmp2,$b,$b
	add		$tmp1,$e,$e
	 std		%f20,[$Xfer+`4*$l`]		!
___
}

# If there is more data to process, then we pre-fetch the data for
# next iteration in last ten rounds...
sub BODY_70_79 {
my ($i,$a,$b,$c,$d,$e)=@_;
my $j=$i&~1;
my $m=($i%8)*2;

$j=($j+16)%16;

$code.=<<___ if ($i==70);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	 ldd		[$inp+64],@X[0]
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e

	and		$inp,-64,$nXfer
	inc		64,$inp
	and		$nXfer,255,$nXfer
	alignaddr	%g0,$align,%g0
	add		$base,$nXfer,$nXfer
___
$code.=<<___ if ($i==71);
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
___
$code.=<<___ if ($i>=72);
	 faligndata	@X[$m],@X[$m+2],@X[$m]
	sll		$a,5,$tmp0			!! $i
	ld		[$Xfer+`4*($i%16)`],$Xi
	srl		$a,27,$tmp1
	add		$tmp0,$e,$e
	xor		$c,$b,$tmp0
	add		$tmp1,$e,$e
	 fpadd32	$VK_00_19,@X[$m],%f20
	sll		$b,30,$tmp2
	xor		$d,$tmp0,$tmp1
	srl		$b,2,$b
	add		$tmp1,$e,$e
	or		$tmp2,$b,$b
	add		$Xi,$e,$e
___
$code.=<<___ if ($i<77);
	 ldd		[$inp+`8*($i+1-70)`],@X[2*($i+1-70)]
___
$code.=<<___ if ($i==77);	# redundant if $inp was aligned
	 add		$align,63,$tmp0
	 and		$tmp0,-8,$tmp0
	 ldd		[$inp+$tmp0],@X[16]
___
$code.=<<___ if ($i>=72);
	 std		%f20,[$nXfer+`4*$m`]
___
}

$code.=<<___;
.section	".text",#alloc,#execinstr

.align	64
vis_const:
.long	0x5a827999,0x5a827999	! K_00_19
.long	0x6ed9eba1,0x6ed9eba1	! K_20_39
.long	0x8f1bbcdc,0x8f1bbcdc	! K_40_59
.long	0xca62c1d6,0xca62c1d6	! K_60_79
.long	0x00000100,0x00000100
.align	64
.type	vis_const,#object
.size	vis_const,(.-vis_const)

.globl	sha1_block_data_order
sha1_block_data_order:
	save	%sp,-$frame,%sp
	add	%fp,$bias-256,$base

1:	call	.+8
	add	%o7,vis_const-1b,$tmp0

	ldd	[$tmp0+0],$VK_00_19
	ldd	[$tmp0+8],$VK_20_39
	ldd	[$tmp0+16],$VK_40_59
	ldd	[$tmp0+24],$VK_60_79
	ldd	[$tmp0+32],$fmul

	ld	[$ctx+0],$Actx
	and	$base,-256,$base
	ld	[$ctx+4],$Bctx
	sub	$base,$bias+$frame,%sp
	ld	[$ctx+8],$Cctx
	and	$inp,7,$align
	ld	[$ctx+12],$Dctx
	and	$inp,-8,$inp
	ld	[$ctx+16],$Ectx

	! X[16] is maintained in FP register bank
	alignaddr	%g0,$align,%g0
	ldd		[$inp+0],@X[0]
	sub		$inp,-64,$Xfer
	ldd		[$inp+8],@X[2]
	and		$Xfer,-64,$Xfer
	ldd		[$inp+16],@X[4]
	and		$Xfer,255,$Xfer
	ldd		[$inp+24],@X[6]
	add		$base,$Xfer,$Xfer
	ldd		[$inp+32],@X[8]
	ldd		[$inp+40],@X[10]
	ldd		[$inp+48],@X[12]
	brz,pt		$align,.Laligned
	ldd		[$inp+56],@X[14]

	ldd		[$inp+64],@X[16]
	faligndata	@X[0],@X[2],@X[0]
	faligndata	@X[2],@X[4],@X[2]
	faligndata	@X[4],@X[6],@X[4]
	faligndata	@X[6],@X[8],@X[6]
	faligndata	@X[8],@X[10],@X[8]
	faligndata	@X[10],@X[12],@X[10]
	faligndata	@X[12],@X[14],@X[12]
	faligndata	@X[14],@X[16],@X[14]

.Laligned:
	mov		5,$tmp0
	dec		1,$len
	alignaddr	%g0,$tmp0,%g0
	fpadd32		$VK_00_19,@X[0],%f16
	fpadd32		$VK_00_19,@X[2],%f18
	fpadd32		$VK_00_19,@X[4],%f20
	fpadd32		$VK_00_19,@X[6],%f22
	fpadd32		$VK_00_19,@X[8],%f24
	fpadd32		$VK_00_19,@X[10],%f26
	fpadd32		$VK_00_19,@X[12],%f28
	fpadd32		$VK_00_19,@X[14],%f30
	std		%f16,[$Xfer+0]
	mov		$Actx,$A
	std		%f18,[$Xfer+8]
	mov		$Bctx,$B
	std		%f20,[$Xfer+16]
	mov		$Cctx,$C
	std		%f22,[$Xfer+24]
	mov		$Dctx,$D
	std		%f24,[$Xfer+32]
	mov		$Ectx,$E
	std		%f26,[$Xfer+40]
	fxors		@X[13],@X[0],@X[0]
	std		%f28,[$Xfer+48]
	ba		.Loop
	std		%f30,[$Xfer+56]
.align	32
.Loop:
___
for ($i=0;$i<20;$i++)	{ &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
for (;$i<40;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
for (;$i<60;$i++)	{ &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
for (;$i<70;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	tst		$len
	bz,pn		`$bits==32?"%icc":"%xcc"`,.Ltail
	nop
___
for (;$i<80;$i++)	{ &BODY_70_79($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	add		$A,$Actx,$Actx
	add		$B,$Bctx,$Bctx
	add		$C,$Cctx,$Cctx
	add		$D,$Dctx,$Dctx
	add		$E,$Ectx,$Ectx
	mov		5,$tmp0
	fxors		@X[13],@X[0],@X[0]
	mov		$Actx,$A
	mov		$Bctx,$B
	mov		$Cctx,$C
	mov		$Dctx,$D
	mov		$Ectx,$E
	alignaddr	%g0,$tmp0,%g0
	dec		1,$len
	ba		.Loop
	mov		$nXfer,$Xfer

.align	32
.Ltail:
___
for($i=70;$i<80;$i++)	{ &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
$code.=<<___;
	add	$A,$Actx,$Actx
	add	$B,$Bctx,$Bctx
	add	$C,$Cctx,$Cctx
	add	$D,$Dctx,$Dctx
	add	$E,$Ectx,$Ectx

	st	$Actx,[$ctx+0]
	st	$Bctx,[$ctx+4]
	st	$Cctx,[$ctx+8]
	st	$Dctx,[$ctx+12]
	st	$Ectx,[$ctx+16]

	ret
	restore
.type	sha1_block_data_order,#function
.size	sha1_block_data_order,(.-sha1_block_data_order)
.asciz	"SHA1 block transform for SPARCv9a, CRYPTOGAMS by <appro\@openssl.org>"
.align	4
___

# Purpose of these subroutines is to explicitly encode VIS instructions,
# so that one can compile the module without having to specify VIS
# extensions on compiler command line, e.g. -xarch=v9 vs. -xarch=v9a.
# Idea is to reserve for option to produce "universal" binary and let
# programmer detect if current CPU is VIS capable at run-time.
sub unvis {
my ($mnemonic,$rs1,$rs2,$rd)=@_;
my ($ref,$opf);
my %visopf = (	"fmul8ulx16"	=> 0x037,
		"faligndata"	=> 0x048,
		"fpadd32"	=> 0x052,
		"fxor"		=> 0x06c,
		"fxors"		=> 0x06d	);

    $ref = "$mnemonic\t$rs1,$rs2,$rd";

    if ($opf=$visopf{$mnemonic}) {
	foreach ($rs1,$rs2,$rd) {
	    return $ref if (!/%f([0-9]{1,2})/);
	    $_=$1;
	    if ($1>=32) {
		return $ref if ($1&1);
		# re-encode for upper double register addressing
		$_=($1|$1>>5)&31;
	    }
	}

	return	sprintf ".word\t0x%08x !%s",
			0x81b00000|$rd<<25|$rs1<<14|$opf<<5|$rs2,
			$ref;
    } else {
	return $ref;
    }
}
sub unalignaddr {
my ($mnemonic,$rs1,$rs2,$rd)=@_;
my %bias = ( "g" => 0, "o" => 8, "l" => 16, "i" => 24 );
my $ref="$mnemonic\t$rs1,$rs2,$rd";

    foreach ($rs1,$rs2,$rd) {
	if (/%([goli])([0-7])/)	{ $_=$bias{$1}+$2; }
	else			{ return $ref; }
    }
    return  sprintf ".word\t0x%08x !%s",
		    0x81b00300|$rd<<25|$rs1<<14|$rs2,
		    $ref;
}

$code =~ s/\`([^\`]*)\`/eval $1/gem;
$code =~ s/\b(f[^\s]*)\s+(%f[0-9]{1,2}),(%f[0-9]{1,2}),(%f[0-9]{1,2})/
		&unvis($1,$2,$3,$4)
	  /gem;
$code =~ s/\b(alignaddr)\s+(%[goli][0-7]),(%[goli][0-7]),(%[goli][0-7])/
		&unalignaddr($1,$2,$3,$4)
	  /gem;
print $code;
close STDOUT or die "error closing STDOUT: $!";


#! /usr/bin/env perl
# Copyright 2007-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License").  You may not use
# this file except in compliance with the License.  You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html

# ====================================================================
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
# project. The module is, however, dual licensed under OpenSSL and
# CRYPTOGAMS licenses depending on where you obtain it. For further
# details see http://www.openssl.org/~appro/cryptogams/.
# ====================================================================

# sha1_block for Thumb.
#
# January 2007.
#
# The code does not present direct interest to OpenSSL, because of low
# performance. Its purpose is to establish _size_ benchmark. Pretty
# useless one I must say, because 30% or 88 bytes larger ARMv4 code
# [available on demand] is almost _twice_ as fast. It should also be
# noted that in-lining of .Lcommon and .Lrotate improves performance
# by over 40%, while code increases by only 10% or 32 bytes. But once
# again, the goal was to establish _size_ benchmark, not performance.

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

$inline=0;
#$cheat_on_binutils=1;

$t0="r0";
$t1="r1";
$t2="r2";
$a="r3";
$b="r4";
$c="r5";
$d="r6";
$e="r7";
$K="r8";	# "upper" registers can be used in add/sub and mov insns
$ctx="r9";
$inp="r10";
$len="r11";
$Xi="r12";

sub common {
<<___;
	sub	$t0,#4
	ldr	$t1,[$t0]
	add	$e,$K			@ E+=K_xx_xx
	lsl	$t2,$a,#5
	add	$t2,$e
	lsr	$e,$a,#27
	add	$t2,$e			@ E+=ROR(A,27)
	add	$t2,$t1			@ E+=X[i]
___
}
sub rotate {
<<___;
	mov	$e,$d			@ E=D
	mov	$d,$c			@ D=C
	lsl	$c,$b,#30
	lsr	$b,$b,#2
	orr	$c,$b			@ C=ROR(B,2)
	mov	$b,$a			@ B=A
	add	$a,$t2,$t1		@ A=E+F_xx_xx(B,C,D)
___
}

sub BODY_00_19 {
$code.=$inline?&common():"\tbl	.Lcommon\n";
$code.=<<___;
	mov	$t1,$c
	eor	$t1,$d
	and	$t1,$b
	eor	$t1,$d			@ F_00_19(B,C,D)
___
$code.=$inline?&rotate():"\tbl	.Lrotate\n";
}

sub BODY_20_39 {
$code.=$inline?&common():"\tbl	.Lcommon\n";
$code.=<<___;
	mov	$t1,$b
	eor	$t1,$c
	eor	$t1,$d			@ F_20_39(B,C,D)
___
$code.=$inline?&rotate():"\tbl	.Lrotate\n";
}

sub BODY_40_59 {
$code.=$inline?&common():"\tbl	.Lcommon\n";
$code.=<<___;
	mov	$t1,$b
	and	$t1,$c
	mov	$e,$b
	orr	$e,$c
	and	$e,$d
	orr	$t1,$e			@ F_40_59(B,C,D)
___
$code.=$inline?&rotate():"\tbl	.Lrotate\n";
}

$code=<<___;
.text
.code	16

.global	sha1_block_data_order
.type	sha1_block_data_order,%function

.align	2
sha1_block_data_order:
___
if ($cheat_on_binutils) {
$code.=<<___;
.code	32
	add	r3,pc,#1
	bx	r3			@ switch to Thumb ISA
.code	16
___
}
$code.=<<___;
	push	{r4-r7}
	mov	r3,r8
	mov	r4,r9
	mov	r5,r10
	mov	r6,r11
	mov	r7,r12
	push	{r3-r7,lr}
	lsl	r2,#6
	mov	$ctx,r0			@ save context
	mov	$inp,r1			@ save inp
	mov	$len,r2			@ save len
	add	$len,$inp		@ $len to point at inp end

.Lloop:
	mov	$Xi,sp
	mov	$t2,sp
	sub	$t2,#16*4		@ [3]
.LXload:
	ldrb	$a,[$t1,#0]		@ $t1 is r1 and holds inp
	ldrb	$b,[$t1,#1]
	ldrb	$c,[$t1,#2]
	ldrb	$d,[$t1,#3]
	lsl	$a,#24
	lsl	$b,#16
	lsl	$c,#8
	orr	$a,$b
	orr	$a,$c
	orr	$a,$d
	add	$t1,#4
	push	{$a}
	cmp	sp,$t2
	bne	.LXload			@ [+14*16]

	mov	$inp,$t1		@ update $inp
	sub	$t2,#32*4
	sub	$t2,#32*4
	mov	$e,#31			@ [+4]
.LXupdate:
	ldr	$a,[sp,#15*4]
	ldr	$b,[sp,#13*4]
	ldr	$c,[sp,#7*4]
	ldr	$d,[sp,#2*4]
	eor	$a,$b
	eor	$a,$c
	eor	$a,$d
	ror	$a,$e
	push	{$a}
	cmp	sp,$t2
	bne	.LXupdate		@ [+(11+1)*64]

	ldmia	$t0!,{$a,$b,$c,$d,$e}	@ $t0 is r0 and holds ctx
	mov	$t0,$Xi

	ldr	$t2,.LK_00_19
	mov	$t1,$t0
	sub	$t1,#20*4
	mov	$Xi,$t1
	mov	$K,$t2			@ [+7+4]
.L_00_19:
___
	&BODY_00_19();
$code.=<<___;
	cmp	$Xi,$t0
	bne	.L_00_19		@ [+(2+9+4+2+8+2)*20]

	ldr	$t2,.LK_20_39
	mov	$t1,$t0
	sub	$t1,#20*4
	mov	$Xi,$t1
	mov	$K,$t2			@ [+5]
.L_20_39_or_60_79:
___
	&BODY_20_39();
$code.=<<___;
	cmp	$Xi,$t0
	bne	.L_20_39_or_60_79	@ [+(2+9+3+2+8+2)*20*2]
	cmp	sp,$t0
	beq	.Ldone			@ [+2]

	ldr	$t2,.LK_40_59
	mov	$t1,$t0
	sub	$t1,#20*4
	mov	$Xi,$t1
	mov	$K,$t2			@ [+5]
.L_40_59:
___
	&BODY_40_59();
$code.=<<___;
	cmp	$Xi,$t0
	bne	.L_40_59		@ [+(2+9+6+2+8+2)*20]

	ldr	$t2,.LK_60_79
	mov	$Xi,sp
	mov	$K,$t2
	b	.L_20_39_or_60_79	@ [+4]
.Ldone:
	mov	$t0,$ctx
	ldr	$t1,[$t0,#0]
	ldr	$t2,[$t0,#4]
	add	$a,$t1
	ldr	$t1,[$t0,#8]
	add	$b,$t2
	ldr	$t2,[$t0,#12]
	add	$c,$t1
	ldr	$t1,[$t0,#16]
	add	$d,$t2
	add	$e,$t1
	stmia	$t0!,{$a,$b,$c,$d,$e}	@ [+20]

	add	sp,#80*4		@ deallocate stack frame
	mov	$t0,$ctx		@ restore ctx
	mov	$t1,$inp		@ restore inp
	cmp	$t1,$len
	beq	.Lexit
	b	.Lloop			@ [+6] total 3212 cycles
.Lexit:
	pop	{r2-r7}
	mov	r8,r2
	mov	r9,r3
	mov	r10,r4
	mov	r11,r5
	mov	r12,r6
	mov	lr,r7
	pop	{r4-r7}
	bx	lr
.align	2
___
$code.=".Lcommon:\n".&common()."\tmov	pc,lr\n" if (!$inline);
$code.=".Lrotate:\n".&rotate()."\tmov	pc,lr\n" if (!$inline);
$code.=<<___;
.align	2
.LK_00_19:	.word	0x5a827999
.LK_20_39:	.word	0x6ed9eba1
.LK_40_59:	.word	0x8f1bbcdc
.LK_60_79:	.word	0xca62c1d6
.size	sha1_block_data_order,.-sha1_block_data_order
.asciz	"SHA1 block transform for Thumb, CRYPTOGAMS by <appro\@openssl.org>"
___

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