#! /usr/bin/env perl
# Copyright 2005-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. Rights for redistribution and usage in source and binary
# forms are granted according to the OpenSSL license.
# ====================================================================
#
# whirlpool_block for x86_64.
#
# 2500 cycles per 64-byte input block on AMD64, which is *identical*
# to 32-bit MMX version executed on same CPU. So why did I bother?
# Well, it's faster than gcc 3.3.2 generated code by over 50%, and
# over 80% faster than PathScale 1.4, an "ambitious" commercial
# compiler. Furthermore it surpasses gcc 3.4.3 by 170% and Sun Studio
# 10 - by 360%[!]... What is it with x86_64 compilers? It's not the
# first example when they fail to generate more optimal code, when
# I believe they had *all* chances to...
#
# Note that register and stack frame layout are virtually identical
# to 32-bit MMX version, except that %r8-15 are used instead of
# %mm0-8. You can even notice that K[i] and S[i] are loaded to
# %eax:%ebx as pair of 32-bit values and not as single 64-bit one.
# This is done in order to avoid 64-bit shift penalties on Intel
# EM64T core. Speaking of which! I bet it's possible to improve
# Opteron performance by compressing the table to 2KB and replacing
# unaligned references with complementary rotations [which would
# incidentally replace lea instructions], but it would definitely
# just "kill" EM64T, because it has only 1 shifter/rotator [against
# 3 on Opteron] and which is *unacceptably* slow with 64-bit
# operand.

$flavour = shift;
$output  = shift;
if ($flavour =~ /\./) { $output = $flavour; undef $flavour; }

$win64=0; $win64=1 if ($flavour =~ /[nm]asm|mingw64/ || $output =~ /\.asm$/);

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

open OUT,"| \"$^X\" \"$xlate\" $flavour \"$output\"";
*STDOUT=*OUT;

sub L() { $code.=".byte	".join(',',@_)."\n"; }
sub LL(){ $code.=".byte	".join(',',@_).",".join(',',@_)."\n"; }

@mm=("%r8","%r9","%r10","%r11","%r12","%r13","%r14","%r15");

$func="whirlpool_block";
$table=".Ltable";

$code=<<___;
.text

.globl	$func
.type	$func,\@function,3
.align	16
$func:
.cfi_startproc
	mov	%rsp,%rax
.cfi_def_cfa_register	%rax
	push	%rbx
.cfi_push	%rbx
	push	%rbp
.cfi_push	%rbp
	push	%r12
.cfi_push	%r12
	push	%r13
.cfi_push	%r13
	push	%r14
.cfi_push	%r14
	push	%r15
.cfi_push	%r15

	sub	\$128+40,%rsp
	and	\$-64,%rsp

	lea	128(%rsp),%r10
	mov	%rdi,0(%r10)		# save parameter block
	mov	%rsi,8(%r10)
	mov	%rdx,16(%r10)
	mov	%rax,32(%r10)		# saved stack pointer
.cfi_cfa_expression	%rsp+`128+32`,deref,+8
.Lprologue:

	mov	%r10,%rbx
	lea	$table(%rip),%rbp

	xor	%rcx,%rcx
	xor	%rdx,%rdx
___
for($i=0;$i<8;$i++) { $code.="mov $i*8(%rdi),@mm[$i]\n"; }	# L=H
$code.=".Louterloop:\n";
for($i=0;$i<8;$i++) { $code.="mov @mm[$i],$i*8(%rsp)\n"; }	# K=L
for($i=0;$i<8;$i++) { $code.="xor $i*8(%rsi),@mm[$i]\n"; }	# L^=inp
for($i=0;$i<8;$i++) { $code.="mov @mm[$i],64+$i*8(%rsp)\n"; }	# S=L
$code.=<<___;
	xor	%rsi,%rsi
	mov	%rsi,24(%rbx)		# zero round counter
	jmp	.Lround
.align	16
.Lround:
	mov	4096(%rbp,%rsi,8),@mm[0]	# rc[r]
	mov	0(%rsp),%eax
	mov	4(%rsp),%ebx
	movz	%al,%ecx
	movz	%ah,%edx
___
for($i=0;$i<8;$i++) {
    my $func = ($i==0)? "mov" : "xor";
    $code.=<<___;
	shr	\$16,%eax
	lea	(%rcx,%rcx),%rsi
	movz	%al,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%ah,%edx
	xor	0(%rbp,%rsi,8),@mm[0]
	$func	7(%rbp,%rdi,8),@mm[1]
	mov	$i*8+8(%rsp),%eax		# ($i+1)*8
	lea	(%rcx,%rcx),%rsi
	movz	%bl,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%bh,%edx
	$func	6(%rbp,%rsi,8),@mm[2]
	$func	5(%rbp,%rdi,8),@mm[3]
	shr	\$16,%ebx
	lea	(%rcx,%rcx),%rsi
	movz	%bl,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%bh,%edx
	$func	4(%rbp,%rsi,8),@mm[4]
	$func	3(%rbp,%rdi,8),@mm[5]
	mov	$i*8+8+4(%rsp),%ebx		# ($i+1)*8+4
	lea	(%rcx,%rcx),%rsi
	movz	%al,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%ah,%edx
	$func	2(%rbp,%rsi,8),@mm[6]
	$func	1(%rbp,%rdi,8),@mm[7]
___
    push(@mm,shift(@mm));
}
for($i=0;$i<8;$i++) { $code.="mov @mm[$i],$i*8(%rsp)\n"; }	# K=L
for($i=0;$i<8;$i++) {
    $code.=<<___;
	shr	\$16,%eax
	lea	(%rcx,%rcx),%rsi
	movz	%al,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%ah,%edx
	xor	0(%rbp,%rsi,8),@mm[0]
	xor	7(%rbp,%rdi,8),@mm[1]
	`"mov	64+$i*8+8(%rsp),%eax"	if($i<7);`	# 64+($i+1)*8
	lea	(%rcx,%rcx),%rsi
	movz	%bl,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%bh,%edx
	xor	6(%rbp,%rsi,8),@mm[2]
	xor	5(%rbp,%rdi,8),@mm[3]
	shr	\$16,%ebx
	lea	(%rcx,%rcx),%rsi
	movz	%bl,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%bh,%edx
	xor	4(%rbp,%rsi,8),@mm[4]
	xor	3(%rbp,%rdi,8),@mm[5]
	`"mov	64+$i*8+8+4(%rsp),%ebx"	if($i<7);`	# 64+($i+1)*8+4
	lea	(%rcx,%rcx),%rsi
	movz	%al,%ecx
	lea	(%rdx,%rdx),%rdi
	movz	%ah,%edx
	xor	2(%rbp,%rsi,8),@mm[6]
	xor	1(%rbp,%rdi,8),@mm[7]
___
    push(@mm,shift(@mm));
}
$code.=<<___;
	lea	128(%rsp),%rbx
	mov	24(%rbx),%rsi		# pull round counter
	add	\$1,%rsi
	cmp	\$10,%rsi
	je	.Lroundsdone

	mov	%rsi,24(%rbx)		# update round counter
___
for($i=0;$i<8;$i++) { $code.="mov @mm[$i],64+$i*8(%rsp)\n"; }	# S=L
$code.=<<___;
	jmp	.Lround
.align	16
.Lroundsdone:
	mov	0(%rbx),%rdi		# reload argument block
	mov	8(%rbx),%rsi
	mov	16(%rbx),%rax
___
for($i=0;$i<8;$i++) { $code.="xor $i*8(%rsi),@mm[$i]\n"; }	# L^=inp
for($i=0;$i<8;$i++) { $code.="xor $i*8(%rdi),@mm[$i]\n"; }	# L^=H
for($i=0;$i<8;$i++) { $code.="mov @mm[$i],$i*8(%rdi)\n"; }	# H=L
$code.=<<___;
	lea	64(%rsi),%rsi		# inp+=64
	sub	\$1,%rax		# num--
	jz	.Lalldone
	mov	%rsi,8(%rbx)		# update parameter block
	mov	%rax,16(%rbx)
	jmp	.Louterloop
.Lalldone:
	mov	32(%rbx),%rsi		# restore saved pointer
.cfi_def_cfa	%rsi,8
	mov	-48(%rsi),%r15
.cfi_restore	%r15
	mov	-40(%rsi),%r14
.cfi_restore	%r14
	mov	-32(%rsi),%r13
.cfi_restore	%r13
	mov	-24(%rsi),%r12
.cfi_restore	%r12
	mov	-16(%rsi),%rbp
.cfi_restore	%rbp
	mov	-8(%rsi),%rbx
.cfi_restore	%rbx
	lea	(%rsi),%rsp
.cfi_def_cfa_register	%rsp
.Lepilogue:
	ret
.cfi_endproc
.size	$func,.-$func

.align	64
.type	$table,\@object
$table:
___
	&LL(0x18,0x18,0x60,0x18,0xc0,0x78,0x30,0xd8);
	&LL(0x23,0x23,0x8c,0x23,0x05,0xaf,0x46,0x26);
	&LL(0xc6,0xc6,0x3f,0xc6,0x7e,0xf9,0x91,0xb8);
	&LL(0xe8,0xe8,0x87,0xe8,0x13,0x6f,0xcd,0xfb);
	&LL(0x87,0x87,0x26,0x87,0x4c,0xa1,0x13,0xcb);
	&LL(0xb8,0xb8,0xda,0xb8,0xa9,0x62,0x6d,0x11);
	&LL(0x01,0x01,0x04,0x01,0x08,0x05,0x02,0x09);
	&LL(0x4f,0x4f,0x21,0x4f,0x42,0x6e,0x9e,0x0d);
	&LL(0x36,0x36,0xd8,0x36,0xad,0xee,0x6c,0x9b);
	&LL(0xa6,0xa6,0xa2,0xa6,0x59,0x04,0x51,0xff);
	&LL(0xd2,0xd2,0x6f,0xd2,0xde,0xbd,0xb9,0x0c);
	&LL(0xf5,0xf5,0xf3,0xf5,0xfb,0x06,0xf7,0x0e);
	&LL(0x79,0x79,0xf9,0x79,0xef,0x80,0xf2,0x96);
	&LL(0x6f,0x6f,0xa1,0x6f,0x5f,0xce,0xde,0x30);
	&LL(0x91,0x91,0x7e,0x91,0xfc,0xef,0x3f,0x6d);
	&LL(0x52,0x52,0x55,0x52,0xaa,0x07,0xa4,0xf8);
	&LL(0x60,0x60,0x9d,0x60,0x27,0xfd,0xc0,0x47);
	&LL(0xbc,0xbc,0xca,0xbc,0x89,0x76,0x65,0x35);
	&LL(0x9b,0x9b,0x56,0x9b,0xac,0xcd,0x2b,0x37);
	&LL(0x8e,0x8e,0x02,0x8e,0x04,0x8c,0x01,0x8a);
	&LL(0xa3,0xa3,0xb6,0xa3,0x71,0x15,0x5b,0xd2);
	&LL(0x0c,0x0c,0x30,0x0c,0x60,0x3c,0x18,0x6c);
	&LL(0x7b,0x7b,0xf1,0x7b,0xff,0x8a,0xf6,0x84);
	&LL(0x35,0x35,0xd4,0x35,0xb5,0xe1,0x6a,0x80);
	&LL(0x1d,0x1d,0x74,0x1d,0xe8,0x69,0x3a,0xf5);
	&LL(0xe0,0xe0,0xa7,0xe0,0x53,0x47,0xdd,0xb3);
	&LL(0xd7,0xd7,0x7b,0xd7,0xf6,0xac,0xb3,0x21);
	&LL(0xc2,0xc2,0x2f,0xc2,0x5e,0xed,0x99,0x9c);
	&LL(0x2e,0x2e,0xb8,0x2e,0x6d,0x96,0x5c,0x43);
	&LL(0x4b,0x4b,0x31,0x4b,0x62,0x7a,0x96,0x29);
	&LL(0xfe,0xfe,0xdf,0xfe,0xa3,0x21,0xe1,0x5d);
	&LL(0x57,0x57,0x41,0x57,0x82,0x16,0xae,0xd5);
	&LL(0x15,0x15,0x54,0x15,0xa8,0x41,0x2a,0xbd);
	&LL(0x77,0x77,0xc1,0x77,0x9f,0xb6,0xee,0xe8);
	&LL(0x37,0x37,0xdc,0x37,0xa5,0xeb,0x6e,0x92);
	&LL(0xe5,0xe5,0xb3,0xe5,0x7b,0x56,0xd7,0x9e);
	&LL(0x9f,0x9f,0x46,0x9f,0x8c,0xd9,0x23,0x13);
	&LL(0xf0,0xf0,0xe7,0xf0,0xd3,0x17,0xfd,0x23);
	&LL(0x4a,0x4a,0x35,0x4a,0x6a,0x7f,0x94,0x20);
	&LL(0xda,0xda,0x4f,0xda,0x9e,0x95,0xa9,0x44);
	&LL(0x58,0x58,0x7d,0x58,0xfa,0x25,0xb0,0xa2);
	&LL(0xc9,0xc9,0x03,0xc9,0x06,0xca,0x8f,0xcf);
	&LL(0x29,0x29,0xa4,0x29,0x55,0x8d,0x52,0x7c);
	&LL(0x0a,0x0a,0x28,0x0a,0x50,0x22,0x14,0x5a);
	&LL(0xb1,0xb1,0xfe,0xb1,0xe1,0x4f,0x7f,0x50);
	&LL(0xa0,0xa0,0xba,0xa0,0x69,0x1a,0x5d,0xc9);
	&LL(0x6b,0x6b,0xb1,0x6b,0x7f,0xda,0xd6,0x14);
	&LL(0x85,0x85,0x2e,0x85,0x5c,0xab,0x17,0xd9);
	&LL(0xbd,0xbd,0xce,0xbd,0x81,0x73,0x67,0x3c);
	&LL(0x5d,0x5d,0x69,0x5d,0xd2,0x34,0xba,0x8f);
	&LL(0x10,0x10,0x40,0x10,0x80,0x50,0x20,0x90);
	&LL(0xf4,0xf4,0xf7,0xf4,0xf3,0x03,0xf5,0x07);
	&LL(0xcb,0xcb,0x0b,0xcb,0x16,0xc0,0x8b,0xdd);
	&LL(0x3e,0x3e,0xf8,0x3e,0xed,0xc6,0x7c,0xd3);
	&LL(0x05,0x05,0x14,0x05,0x28,0x11,0x0a,0x2d);
	&LL(0x67,0x67,0x81,0x67,0x1f,0xe6,0xce,0x78);
	&LL(0xe4,0xe4,0xb7,0xe4,0x73,0x53,0xd5,0x97);
	&LL(0x27,0x27,0x9c,0x27,0x25,0xbb,0x4e,0x02);
	&LL(0x41,0x41,0x19,0x41,0x32,0x58,0x82,0x73);
	&LL(0x8b,0x8b,0x16,0x8b,0x2c,0x9d,0x0b,0xa7);
	&LL(0xa7,0xa7,0xa6,0xa7,0x51,0x01,0x53,0xf6);
	&LL(0x7d,0x7d,0xe9,0x7d,0xcf,0x94,0xfa,0xb2);
	&LL(0x95,0x95,0x6e,0x95,0xdc,0xfb,0x37,0x49);
	&LL(0xd8,0xd8,0x47,0xd8,0x8e,0x9f,0xad,0x56);
	&LL(0xfb,0xfb,0xcb,0xfb,0x8b,0x30,0xeb,0x70);
	&LL(0xee,0xee,0x9f,0xee,0x23,0x71,0xc1,0xcd);
	&LL(0x7c,0x7c,0xed,0x7c,0xc7,0x91,0xf8,0xbb);
	&LL(0x66,0x66,0x85,0x66,0x17,0xe3,0xcc,0x71);
	&LL(0xdd,0xdd,0x53,0xdd,0xa6,0x8e,0xa7,0x7b);
	&LL(0x17,0x17,0x5c,0x17,0xb8,0x4b,0x2e,0xaf);
	&LL(0x47,0x47,0x01,0x47,0x02,0x46,0x8e,0x45);
	&LL(0x9e,0x9e,0x42,0x9e,0x84,0xdc,0x21,0x1a);
	&LL(0xca,0xca,0x0f,0xca,0x1e,0xc5,0x89,0xd4);
	&LL(0x2d,0x2d,0xb4,0x2d,0x75,0x99,0x5a,0x58);
	&LL(0xbf,0xbf,0xc6,0xbf,0x91,0x79,0x63,0x2e);
	&LL(0x07,0x07,0x1c,0x07,0x38,0x1b,0x0e,0x3f);
	&LL(0xad,0xad,0x8e,0xad,0x01,0x23,0x47,0xac);
	&LL(0x5a,0x5a,0x75,0x5a,0xea,0x2f,0xb4,0xb0);
	&LL(0x83,0x83,0x36,0x83,0x6c,0xb5,0x1b,0xef);
	&LL(0x33,0x33,0xcc,0x33,0x85,0xff,0x66,0xb6);
	&LL(0x63,0x63,0x91,0x63,0x3f,0xf2,0xc6,0x5c);
	&LL(0x02,0x02,0x08,0x02,0x10,0x0a,0x04,0x12);
	&LL(0xaa,0xaa,0x92,0xaa,0x39,0x38,0x49,0x93);
	&LL(0x71,0x71,0xd9,0x71,0xaf,0xa8,0xe2,0xde);
	&LL(0xc8,0xc8,0x07,0xc8,0x0e,0xcf,0x8d,0xc6);
	&LL(0x19,0x19,0x64,0x19,0xc8,0x7d,0x32,0xd1);
	&LL(0x49,0x49,0x39,0x49,0x72,0x70,0x92,0x3b);
	&LL(0xd9,0xd9,0x43,0xd9,0x86,0x9a,0xaf,0x5f);
	&LL(0xf2,0xf2,0xef,0xf2,0xc3,0x1d,0xf9,0x31);
	&LL(0xe3,0xe3,0xab,0xe3,0x4b,0x48,0xdb,0xa8);
	&LL(0x5b,0x5b,0x71,0x5b,0xe2,0x2a,0xb6,0xb9);
	&LL(0x88,0x88,0x1a,0x88,0x34,0x92,0x0d,0xbc);
	&LL(0x9a,0x9a,0x52,0x9a,0xa4,0xc8,0x29,0x3e);
	&LL(0x26,0x26,0x98,0x26,0x2d,0xbe,0x4c,0x0b);
	&LL(0x32,0x32,0xc8,0x32,0x8d,0xfa,0x64,0xbf);
	&LL(0xb0,0xb0,0xfa,0xb0,0xe9,0x4a,0x7d,0x59);
	&LL(0xe9,0xe9,0x83,0xe9,0x1b,0x6a,0xcf,0xf2);
	&LL(0x0f,0x0f,0x3c,0x0f,0x78,0x33,0x1e,0x77);
	&LL(0xd5,0xd5,0x73,0xd5,0xe6,0xa6,0xb7,0x33);
	&LL(0x80,0x80,0x3a,0x80,0x74,0xba,0x1d,0xf4);
	&LL(0xbe,0xbe,0xc2,0xbe,0x99,0x7c,0x61,0x27);
	&LL(0xcd,0xcd,0x13,0xcd,0x26,0xde,0x87,0xeb);
	&LL(0x34,0x34,0xd0,0x34,0xbd,0xe4,0x68,0x89);
	&LL(0x48,0x48,0x3d,0x48,0x7a,0x75,0x90,0x32);
	&LL(0xff,0xff,0xdb,0xff,0xab,0x24,0xe3,0x54);
	&LL(0x7a,0x7a,0xf5,0x7a,0xf7,0x8f,0xf4,0x8d);
	&LL(0x90,0x90,0x7a,0x90,0xf4,0xea,0x3d,0x64);
	&LL(0x5f,0x5f,0x61,0x5f,0xc2,0x3e,0xbe,0x9d);
	&LL(0x20,0x20,0x80,0x20,0x1d,0xa0,0x40,0x3d);
	&LL(0x68,0x68,0xbd,0x68,0x67,0xd5,0xd0,0x0f);
	&LL(0x1a,0x1a,0x68,0x1a,0xd0,0x72,0x34,0xca);
	&LL(0xae,0xae,0x82,0xae,0x19,0x2c,0x41,0xb7);
	&LL(0xb4,0xb4,0xea,0xb4,0xc9,0x5e,0x75,0x7d);
	&LL(0x54,0x54,0x4d,0x54,0x9a,0x19,0xa8,0xce);
	&LL(0x93,0x93,0x76,0x93,0xec,0xe5,0x3b,0x7f);
	&LL(0x22,0x22,0x88,0x22,0x0d,0xaa,0x44,0x2f);
	&LL(0x64,0x64,0x8d,0x64,0x07,0xe9,0xc8,0x63);
	&LL(0xf1,0xf1,0xe3,0xf1,0xdb,0x12,0xff,0x2a);
	&LL(0x73,0x73,0xd1,0x73,0xbf,0xa2,0xe6,0xcc);
	&LL(0x12,0x12,0x48,0x12,0x90,0x5a,0x24,0x82);
	&LL(0x40,0x40,0x1d,0x40,0x3a,0x5d,0x80,0x7a);
	&LL(0x08,0x08,0x20,0x08,0x40,0x28,0x10,0x48);
	&LL(0xc3,0xc3,0x2b,0xc3,0x56,0xe8,0x9b,0x95);
	&LL(0xec,0xec,0x97,0xec,0x33,0x7b,0xc5,0xdf);
	&LL(0xdb,0xdb,0x4b,0xdb,0x96,0x90,0xab,0x4d);
	&LL(0xa1,0xa1,0xbe,0xa1,0x61,0x1f,0x5f,0xc0);
	&LL(0x8d,0x8d,0x0e,0x8d,0x1c,0x83,0x07,0x91);
	&LL(0x3d,0x3d,0xf4,0x3d,0xf5,0xc9,0x7a,0xc8);
	&LL(0x97,0x97,0x66,0x97,0xcc,0xf1,0x33,0x5b);
	&LL(0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00);
	&LL(0xcf,0xcf,0x1b,0xcf,0x36,0xd4,0x83,0xf9);
	&LL(0x2b,0x2b,0xac,0x2b,0x45,0x87,0x56,0x6e);
	&LL(0x76,0x76,0xc5,0x76,0x97,0xb3,0xec,0xe1);
	&LL(0x82,0x82,0x32,0x82,0x64,0xb0,0x19,0xe6);
	&LL(0xd6,0xd6,0x7f,0xd6,0xfe,0xa9,0xb1,0x28);
	&LL(0x1b,0x1b,0x6c,0x1b,0xd8,0x77,0x36,0xc3);
	&LL(0xb5,0xb5,0xee,0xb5,0xc1,0x5b,0x77,0x74);
	&LL(0xaf,0xaf,0x86,0xaf,0x11,0x29,0x43,0xbe);
	&LL(0x6a,0x6a,0xb5,0x6a,0x77,0xdf,0xd4,0x1d);
	&LL(0x50,0x50,0x5d,0x50,0xba,0x0d,0xa0,0xea);
	&LL(0x45,0x45,0x09,0x45,0x12,0x4c,0x8a,0x57);
	&LL(0xf3,0xf3,0xeb,0xf3,0xcb,0x18,0xfb,0x38);
	&LL(0x30,0x30,0xc0,0x30,0x9d,0xf0,0x60,0xad);
	&LL(0xef,0xef,0x9b,0xef,0x2b,0x74,0xc3,0xc4);
	&LL(0x3f,0x3f,0xfc,0x3f,0xe5,0xc3,0x7e,0xda);
	&LL(0x55,0x55,0x49,0x55,0x92,0x1c,0xaa,0xc7);
	&LL(0xa2,0xa2,0xb2,0xa2,0x79,0x10,0x59,0xdb);
	&LL(0xea,0xea,0x8f,0xea,0x03,0x65,0xc9,0xe9);
	&LL(0x65,0x65,0x89,0x65,0x0f,0xec,0xca,0x6a);
	&LL(0xba,0xba,0xd2,0xba,0xb9,0x68,0x69,0x03);
	&LL(0x2f,0x2f,0xbc,0x2f,0x65,0x93,0x5e,0x4a);
	&LL(0xc0,0xc0,0x27,0xc0,0x4e,0xe7,0x9d,0x8e);
	&LL(0xde,0xde,0x5f,0xde,0xbe,0x81,0xa1,0x60);
	&LL(0x1c,0x1c,0x70,0x1c,0xe0,0x6c,0x38,0xfc);
	&LL(0xfd,0xfd,0xd3,0xfd,0xbb,0x2e,0xe7,0x46);
	&LL(0x4d,0x4d,0x29,0x4d,0x52,0x64,0x9a,0x1f);
	&LL(0x92,0x92,0x72,0x92,0xe4,0xe0,0x39,0x76);
	&LL(0x75,0x75,0xc9,0x75,0x8f,0xbc,0xea,0xfa);
	&LL(0x06,0x06,0x18,0x06,0x30,0x1e,0x0c,0x36);
	&LL(0x8a,0x8a,0x12,0x8a,0x24,0x98,0x09,0xae);
	&LL(0xb2,0xb2,0xf2,0xb2,0xf9,0x40,0x79,0x4b);
	&LL(0xe6,0xe6,0xbf,0xe6,0x63,0x59,0xd1,0x85);
	&LL(0x0e,0x0e,0x38,0x0e,0x70,0x36,0x1c,0x7e);
	&LL(0x1f,0x1f,0x7c,0x1f,0xf8,0x63,0x3e,0xe7);
	&LL(0x62,0x62,0x95,0x62,0x37,0xf7,0xc4,0x55);
	&LL(0xd4,0xd4,0x77,0xd4,0xee,0xa3,0xb5,0x3a);
	&LL(0xa8,0xa8,0x9a,0xa8,0x29,0x32,0x4d,0x81);
	&LL(0x96,0x96,0x62,0x96,0xc4,0xf4,0x31,0x52);
	&LL(0xf9,0xf9,0xc3,0xf9,0x9b,0x3a,0xef,0x62);
	&LL(0xc5,0xc5,0x33,0xc5,0x66,0xf6,0x97,0xa3);
	&LL(0x25,0x25,0x94,0x25,0x35,0xb1,0x4a,0x10);
	&LL(0x59,0x59,0x79,0x59,0xf2,0x20,0xb2,0xab);
	&LL(0x84,0x84,0x2a,0x84,0x54,0xae,0x15,0xd0);
	&LL(0x72,0x72,0xd5,0x72,0xb7,0xa7,0xe4,0xc5);
	&LL(0x39,0x39,0xe4,0x39,0xd5,0xdd,0x72,0xec);
	&LL(0x4c,0x4c,0x2d,0x4c,0x5a,0x61,0x98,0x16);
	&LL(0x5e,0x5e,0x65,0x5e,0xca,0x3b,0xbc,0x94);
	&LL(0x78,0x78,0xfd,0x78,0xe7,0x85,0xf0,0x9f);
	&LL(0x38,0x38,0xe0,0x38,0xdd,0xd8,0x70,0xe5);
	&LL(0x8c,0x8c,0x0a,0x8c,0x14,0x86,0x05,0x98);
	&LL(0xd1,0xd1,0x63,0xd1,0xc6,0xb2,0xbf,0x17);
	&LL(0xa5,0xa5,0xae,0xa5,0x41,0x0b,0x57,0xe4);
	&LL(0xe2,0xe2,0xaf,0xe2,0x43,0x4d,0xd9,0xa1);
	&LL(0x61,0x61,0x99,0x61,0x2f,0xf8,0xc2,0x4e);
	&LL(0xb3,0xb3,0xf6,0xb3,0xf1,0x45,0x7b,0x42);
	&LL(0x21,0x21,0x84,0x21,0x15,0xa5,0x42,0x34);
	&LL(0x9c,0x9c,0x4a,0x9c,0x94,0xd6,0x25,0x08);
	&LL(0x1e,0x1e,0x78,0x1e,0xf0,0x66,0x3c,0xee);
	&LL(0x43,0x43,0x11,0x43,0x22,0x52,0x86,0x61);
	&LL(0xc7,0xc7,0x3b,0xc7,0x76,0xfc,0x93,0xb1);
	&LL(0xfc,0xfc,0xd7,0xfc,0xb3,0x2b,0xe5,0x4f);
	&LL(0x04,0x04,0x10,0x04,0x20,0x14,0x08,0x24);
	&LL(0x51,0x51,0x59,0x51,0xb2,0x08,0xa2,0xe3);
	&LL(0x99,0x99,0x5e,0x99,0xbc,0xc7,0x2f,0x25);
	&LL(0x6d,0x6d,0xa9,0x6d,0x4f,0xc4,0xda,0x22);
	&LL(0x0d,0x0d,0x34,0x0d,0x68,0x39,0x1a,0x65);
	&LL(0xfa,0xfa,0xcf,0xfa,0x83,0x35,0xe9,0x79);
	&LL(0xdf,0xdf,0x5b,0xdf,0xb6,0x84,0xa3,0x69);
	&LL(0x7e,0x7e,0xe5,0x7e,0xd7,0x9b,0xfc,0xa9);
	&LL(0x24,0x24,0x90,0x24,0x3d,0xb4,0x48,0x19);
	&LL(0x3b,0x3b,0xec,0x3b,0xc5,0xd7,0x76,0xfe);
	&LL(0xab,0xab,0x96,0xab,0x31,0x3d,0x4b,0x9a);
	&LL(0xce,0xce,0x1f,0xce,0x3e,0xd1,0x81,0xf0);
	&LL(0x11,0x11,0x44,0x11,0x88,0x55,0x22,0x99);
	&LL(0x8f,0x8f,0x06,0x8f,0x0c,0x89,0x03,0x83);
	&LL(0x4e,0x4e,0x25,0x4e,0x4a,0x6b,0x9c,0x04);
	&LL(0xb7,0xb7,0xe6,0xb7,0xd1,0x51,0x73,0x66);
	&LL(0xeb,0xeb,0x8b,0xeb,0x0b,0x60,0xcb,0xe0);
	&LL(0x3c,0x3c,0xf0,0x3c,0xfd,0xcc,0x78,0xc1);
	&LL(0x81,0x81,0x3e,0x81,0x7c,0xbf,0x1f,0xfd);
	&LL(0x94,0x94,0x6a,0x94,0xd4,0xfe,0x35,0x40);
	&LL(0xf7,0xf7,0xfb,0xf7,0xeb,0x0c,0xf3,0x1c);
	&LL(0xb9,0xb9,0xde,0xb9,0xa1,0x67,0x6f,0x18);
	&LL(0x13,0x13,0x4c,0x13,0x98,0x5f,0x26,0x8b);
	&LL(0x2c,0x2c,0xb0,0x2c,0x7d,0x9c,0x58,0x51);
	&LL(0xd3,0xd3,0x6b,0xd3,0xd6,0xb8,0xbb,0x05);
	&LL(0xe7,0xe7,0xbb,0xe7,0x6b,0x5c,0xd3,0x8c);
	&LL(0x6e,0x6e,0xa5,0x6e,0x57,0xcb,0xdc,0x39);
	&LL(0xc4,0xc4,0x37,0xc4,0x6e,0xf3,0x95,0xaa);
	&LL(0x03,0x03,0x0c,0x03,0x18,0x0f,0x06,0x1b);
	&LL(0x56,0x56,0x45,0x56,0x8a,0x13,0xac,0xdc);
	&LL(0x44,0x44,0x0d,0x44,0x1a,0x49,0x88,0x5e);
	&LL(0x7f,0x7f,0xe1,0x7f,0xdf,0x9e,0xfe,0xa0);
	&LL(0xa9,0xa9,0x9e,0xa9,0x21,0x37,0x4f,0x88);
	&LL(0x2a,0x2a,0xa8,0x2a,0x4d,0x82,0x54,0x67);
	&LL(0xbb,0xbb,0xd6,0xbb,0xb1,0x6d,0x6b,0x0a);
	&LL(0xc1,0xc1,0x23,0xc1,0x46,0xe2,0x9f,0x87);
	&LL(0x53,0x53,0x51,0x53,0xa2,0x02,0xa6,0xf1);
	&LL(0xdc,0xdc,0x57,0xdc,0xae,0x8b,0xa5,0x72);
	&LL(0x0b,0x0b,0x2c,0x0b,0x58,0x27,0x16,0x53);
	&LL(0x9d,0x9d,0x4e,0x9d,0x9c,0xd3,0x27,0x01);
	&LL(0x6c,0x6c,0xad,0x6c,0x47,0xc1,0xd8,0x2b);
	&LL(0x31,0x31,0xc4,0x31,0x95,0xf5,0x62,0xa4);
	&LL(0x74,0x74,0xcd,0x74,0x87,0xb9,0xe8,0xf3);
	&LL(0xf6,0xf6,0xff,0xf6,0xe3,0x09,0xf1,0x15);
	&LL(0x46,0x46,0x05,0x46,0x0a,0x43,0x8c,0x4c);
	&LL(0xac,0xac,0x8a,0xac,0x09,0x26,0x45,0xa5);
	&LL(0x89,0x89,0x1e,0x89,0x3c,0x97,0x0f,0xb5);
	&LL(0x14,0x14,0x50,0x14,0xa0,0x44,0x28,0xb4);
	&LL(0xe1,0xe1,0xa3,0xe1,0x5b,0x42,0xdf,0xba);
	&LL(0x16,0x16,0x58,0x16,0xb0,0x4e,0x2c,0xa6);
	&LL(0x3a,0x3a,0xe8,0x3a,0xcd,0xd2,0x74,0xf7);
	&LL(0x69,0x69,0xb9,0x69,0x6f,0xd0,0xd2,0x06);
	&LL(0x09,0x09,0x24,0x09,0x48,0x2d,0x12,0x41);
	&LL(0x70,0x70,0xdd,0x70,0xa7,0xad,0xe0,0xd7);
	&LL(0xb6,0xb6,0xe2,0xb6,0xd9,0x54,0x71,0x6f);
	&LL(0xd0,0xd0,0x67,0xd0,0xce,0xb7,0xbd,0x1e);
	&LL(0xed,0xed,0x93,0xed,0x3b,0x7e,0xc7,0xd6);
	&LL(0xcc,0xcc,0x17,0xcc,0x2e,0xdb,0x85,0xe2);
	&LL(0x42,0x42,0x15,0x42,0x2a,0x57,0x84,0x68);
	&LL(0x98,0x98,0x5a,0x98,0xb4,0xc2,0x2d,0x2c);
	&LL(0xa4,0xa4,0xaa,0xa4,0x49,0x0e,0x55,0xed);
	&LL(0x28,0x28,0xa0,0x28,0x5d,0x88,0x50,0x75);
	&LL(0x5c,0x5c,0x6d,0x5c,0xda,0x31,0xb8,0x86);
	&LL(0xf8,0xf8,0xc7,0xf8,0x93,0x3f,0xed,0x6b);
	&LL(0x86,0x86,0x22,0x86,0x44,0xa4,0x11,0xc2);

	&L(0x18,0x23,0xc6,0xe8,0x87,0xb8,0x01,0x4f);	# rc[ROUNDS]
	&L(0x36,0xa6,0xd2,0xf5,0x79,0x6f,0x91,0x52);
	&L(0x60,0xbc,0x9b,0x8e,0xa3,0x0c,0x7b,0x35);
	&L(0x1d,0xe0,0xd7,0xc2,0x2e,0x4b,0xfe,0x57);
	&L(0x15,0x77,0x37,0xe5,0x9f,0xf0,0x4a,0xda);
	&L(0x58,0xc9,0x29,0x0a,0xb1,0xa0,0x6b,0x85);
	&L(0xbd,0x5d,0x10,0xf4,0xcb,0x3e,0x05,0x67);
	&L(0xe4,0x27,0x41,0x8b,0xa7,0x7d,0x95,0xd8);
	&L(0xfb,0xee,0x7c,0x66,0xdd,0x17,0x47,0x9e);
	&L(0xca,0x2d,0xbf,0x07,0xad,0x5a,0x83,0x33);

# EXCEPTION_DISPOSITION handler (EXCEPTION_RECORD *rec,ULONG64 frame,
#		CONTEXT *context,DISPATCHER_CONTEXT *disp)
if ($win64) {
$rec="%rcx";
$frame="%rdx";
$context="%r8";
$disp="%r9";

$code.=<<___;
.extern	__imp_RtlVirtualUnwind
.type	se_handler,\@abi-omnipotent
.align	16
se_handler:
	push	%rsi
	push	%rdi
	push	%rbx
	push	%rbp
	push	%r12
	push	%r13
	push	%r14
	push	%r15
	pushfq
	sub	\$64,%rsp

	mov	120($context),%rax	# pull context->Rax
	mov	248($context),%rbx	# pull context->Rip

	lea	.Lprologue(%rip),%r10
	cmp	%r10,%rbx		# context->Rip<.Lprologue
	jb	.Lin_prologue

	mov	152($context),%rax	# pull context->Rsp

	lea	.Lepilogue(%rip),%r10
	cmp	%r10,%rbx		# context->Rip>=.Lepilogue
	jae	.Lin_prologue

	mov	128+32(%rax),%rax	# pull saved stack pointer

	mov	-8(%rax),%rbx
	mov	-16(%rax),%rbp
	mov	-24(%rax),%r12
	mov	-32(%rax),%r13
	mov	-40(%rax),%r14
	mov	-48(%rax),%r15
	mov	%rbx,144($context)	# restore context->Rbx
	mov	%rbp,160($context)	# restore context->Rbp
	mov	%r12,216($context)	# restore context->R12
	mov	%r13,224($context)	# restore context->R13
	mov	%r14,232($context)	# restore context->R14
	mov	%r15,240($context)	# restore context->R15

.Lin_prologue:
	mov	8(%rax),%rdi
	mov	16(%rax),%rsi
	mov	%rax,152($context)	# restore context->Rsp
	mov	%rsi,168($context)	# restore context->Rsi
	mov	%rdi,176($context)	# restore context->Rdi

	mov	40($disp),%rdi		# disp->ContextRecord
	mov	$context,%rsi		# context
	mov	\$154,%ecx		# sizeof(CONTEXT)
	.long	0xa548f3fc		# cld; rep movsq

	mov	$disp,%rsi
	xor	%rcx,%rcx		# arg1, UNW_FLAG_NHANDLER
	mov	8(%rsi),%rdx		# arg2, disp->ImageBase
	mov	0(%rsi),%r8		# arg3, disp->ControlPc
	mov	16(%rsi),%r9		# arg4, disp->FunctionEntry
	mov	40(%rsi),%r10		# disp->ContextRecord
	lea	56(%rsi),%r11		# &disp->HandlerData
	lea	24(%rsi),%r12		# &disp->EstablisherFrame
	mov	%r10,32(%rsp)		# arg5
	mov	%r11,40(%rsp)		# arg6
	mov	%r12,48(%rsp)		# arg7
	mov	%rcx,56(%rsp)		# arg8, (NULL)
	call	*__imp_RtlVirtualUnwind(%rip)

	mov	\$1,%eax		# ExceptionContinueSearch
	add	\$64,%rsp
	popfq
	pop	%r15
	pop	%r14
	pop	%r13
	pop	%r12
	pop	%rbp
	pop	%rbx
	pop	%rdi
	pop	%rsi
	ret
.size	se_handler,.-se_handler

.section	.pdata
.align	4
	.rva	.LSEH_begin_$func
	.rva	.LSEH_end_$func
	.rva	.LSEH_info_$func

.section	.xdata
.align	8
.LSEH_info_$func:
	.byte	9,0,0,0
	.rva	se_handler
___
}

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


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

# September 2011
#
# Assembler helpers for Padlock engine. Compared to original engine
# version relying on inline assembler and compiled with gcc 3.4.6 it
# was measured to provide ~100% improvement on misaligned data in ECB
# mode and ~75% in CBC mode. For aligned data improvement can be
# observed for short inputs only, e.g. 45% for 64-byte messages in
# ECB mode, 20% in CBC. Difference in performance for aligned vs.
# misaligned data depends on misalignment and is either ~1.8x or 2.9x.
# These are approximately same factors as for hardware support, so
# there is little reason to rely on the latter. On the contrary, it
# might actually hurt performance in mixture of aligned and misaligned
# buffers, because a) if you choose to flip 'align' flag in control
# word on per-buffer basis, then you'd have to reload key context,
# which incurs penalty; b) if you choose to set 'align' flag
# permanently, it limits performance even for aligned data to ~1/2.
# All above mentioned results were collected on 1.5GHz C7. Nano on the
# other hand handles unaligned data more gracefully. Depending on
# algorithm and how unaligned data is, hardware can be up to 70% more
# efficient than below software alignment procedures, nor does 'align'
# flag have affect on aligned performance [if has any meaning at all].
# Therefore suggestion is to unconditionally set 'align' flag on Nano
# for optimal performance.

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

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

&asm_init($ARGV[0]);

%PADLOCK_PREFETCH=(ecb=>128, cbc=>64);	# prefetch errata
$PADLOCK_CHUNK=512;	# Must be a power of 2 larger than 16

$ctx="edx";
$out="edi";
$inp="esi";
$len="ecx";
$chunk="ebx";

&function_begin_B("padlock_capability");
	&push	("ebx");
	&pushf	();
	&pop	("eax");
	&mov	("ecx","eax");
	&xor	("eax",1<<21);
	&push	("eax");
	&popf	();
	&pushf	();
	&pop	("eax");
	&xor	("ecx","eax");
	&xor	("eax","eax");
	&bt	("ecx",21);
	&jnc	(&label("noluck"));
	&cpuid	();
	&xor	("eax","eax");
	&cmp	("ebx","0x".unpack("H*",'tneC'));
	&jne	(&label("zhaoxin"));
	&cmp	("edx","0x".unpack("H*",'Hrua'));
	&jne	(&label("noluck"));
	&cmp	("ecx","0x".unpack("H*",'slua'));
	&jne	(&label("noluck"));
	&jmp	(&label("zhaoxinEnd"));
&set_label("zhaoxin");
	&cmp	("ebx","0x".unpack("H*",'hS  '));
	&jne	(&label("noluck"));
	&cmp	("edx","0x".unpack("H*",'hgna'));
	&jne	(&label("noluck"));
	&cmp	("ecx","0x".unpack("H*",'  ia'));
	&jne	(&label("noluck"));
&set_label("zhaoxinEnd");
	&mov	("eax",0xC0000000);
	&cpuid	();
	&mov	("edx","eax");
	&xor	("eax","eax");
	&cmp	("edx",0xC0000001);
	&jb	(&label("noluck"));
	&mov	("eax",1);
	&cpuid	();
	&or	("eax",0x0f);
	&xor	("ebx","ebx");
	&and	("eax",0x0fff);
	&cmp	("eax",0x06ff);		# check for Nano
	&sete	("bl");
	&mov	("eax",0xC0000001);
	&push	("ebx");
	&cpuid	();
	&pop	("ebx");
	&mov	("eax","edx");
	&shl	("ebx",4);		# bit#4 denotes Nano
	&and	("eax",0xffffffef);
	&or	("eax","ebx")
&set_label("noluck");
	&pop	("ebx");
	&ret	();
&function_end_B("padlock_capability")

&function_begin_B("padlock_key_bswap");
	&mov	("edx",&wparam(0));
	&mov	("ecx",&DWP(240,"edx"));
&set_label("bswap_loop");
	&mov	("eax",&DWP(0,"edx"));
	&bswap	("eax");
	&mov	(&DWP(0,"edx"),"eax");
	&lea	("edx",&DWP(4,"edx"));
	&sub	("ecx",1);
	&jnz	(&label("bswap_loop"));
	&ret	();
&function_end_B("padlock_key_bswap");

# This is heuristic key context tracing. At first one
# believes that one should use atomic swap instructions,
# but it's not actually necessary. Point is that if
# padlock_saved_context was changed by another thread
# after we've read it and before we compare it with ctx,
# our key *shall* be reloaded upon thread context switch
# and we are therefore set in either case...
&static_label("padlock_saved_context");

&function_begin_B("padlock_verify_context");
	&mov	($ctx,&wparam(0));
	&lea	("eax",($::win32 or $::coff) ? &DWP(&label("padlock_saved_context")) :
		       &DWP(&label("padlock_saved_context")."-".&label("verify_pic_point")));
	&pushf	();
	&call	("_padlock_verify_ctx");
&set_label("verify_pic_point");
	&lea	("esp",&DWP(4,"esp"));
	&ret	();
&function_end_B("padlock_verify_context");

&function_begin_B("_padlock_verify_ctx");
	&add	("eax",&DWP(0,"esp")) if(!($::win32 or $::coff));# &padlock_saved_context
	&bt	(&DWP(4,"esp"),30);		# eflags
	&jnc	(&label("verified"));
	&cmp	($ctx,&DWP(0,"eax"));
	&je	(&label("verified"));
	&pushf	();
	&popf	();
&set_label("verified");
	&mov	(&DWP(0,"eax"),$ctx);
	&ret	();
&function_end_B("_padlock_verify_ctx");

&function_begin_B("padlock_reload_key");
	&pushf	();
	&popf	();
	&ret	();
&function_end_B("padlock_reload_key");

&function_begin_B("padlock_aes_block");
	&push	("edi");
	&push	("esi");
	&push	("ebx");
	&mov	($out,&wparam(0));		# must be 16-byte aligned
	&mov	($inp,&wparam(1));		# must be 16-byte aligned
	&mov	($ctx,&wparam(2));
	&mov	($len,1);
	&lea	("ebx",&DWP(32,$ctx));		# key
	&lea	($ctx,&DWP(16,$ctx));		# control word
	&data_byte(0xf3,0x0f,0xa7,0xc8);	# rep xcryptecb
	&pop	("ebx");
	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_aes_block");

sub generate_mode {
my ($mode,$opcode) = @_;
# int padlock_$mode_encrypt(void *out, const void *inp,
#		struct padlock_cipher_data *ctx, size_t len);
&function_begin("padlock_${mode}_encrypt");
	&mov	($out,&wparam(0));
	&mov	($inp,&wparam(1));
	&mov	($ctx,&wparam(2));
	&mov	($len,&wparam(3));
	&test	($ctx,15);
	&jnz	(&label("${mode}_abort"));
	&test	($len,15);
	&jnz	(&label("${mode}_abort"));
	&lea	("eax",($::win32 or $::coff) ? &DWP(&label("padlock_saved_context")) :
		       &DWP(&label("padlock_saved_context")."-".&label("${mode}_pic_point")));
	&pushf	();
	&cld	();
	&call	("_padlock_verify_ctx");
&set_label("${mode}_pic_point");
	&lea	($ctx,&DWP(16,$ctx));	# control word
	&xor	("eax","eax");
					if ($mode eq "ctr32") {
	&movq	("mm0",&QWP(-16,$ctx));	# load [upper part of] counter
					} else {
	&xor	("ebx","ebx");
	&test	(&DWP(0,$ctx),1<<5);	# align bit in control word
	&jnz	(&label("${mode}_aligned"));
	&test	($out,0x0f);
	&setz	("al");			# !out_misaligned
	&test	($inp,0x0f);
	&setz	("bl");			# !inp_misaligned
	&test	("eax","ebx");
	&jnz	(&label("${mode}_aligned"));
	&neg	("eax");
					}
	&mov	($chunk,$PADLOCK_CHUNK);
	&not	("eax");		# out_misaligned?-1:0
	&lea	("ebp",&DWP(-24,"esp"));
	&cmp	($len,$chunk);
	&cmovc	($chunk,$len);		# chunk=len>PADLOCK_CHUNK?PADLOCK_CHUNK:len
	&and	("eax",$chunk);		# out_misaligned?chunk:0
	&mov	($chunk,$len);
	&neg	("eax");
	&and	($chunk,$PADLOCK_CHUNK-1);	# chunk=len%PADLOCK_CHUNK
	&lea	("esp",&DWP(0,"eax","ebp"));	# alloca
	&mov	("eax",$PADLOCK_CHUNK);
	&cmovz	($chunk,"eax");			# chunk=chunk?:PADLOCK_CHUNK
	&mov	("eax","ebp");
	&and	("ebp",-16);
	&and	("esp",-16);
	&mov	(&DWP(16,"ebp"),"eax");
    if ($PADLOCK_PREFETCH{$mode}) {
	&cmp	($len,$chunk);
	&ja	(&label("${mode}_loop"));
	&mov	("eax",$inp);		# check if prefetch crosses page
	&cmp	("ebp","esp");
	&cmove	("eax",$out);
	&add	("eax",$len);
	&neg	("eax");
	&and	("eax",0xfff);		# distance to page boundary
	&cmp	("eax",$PADLOCK_PREFETCH{$mode});
	&mov	("eax",-$PADLOCK_PREFETCH{$mode});
	&cmovae	("eax",$chunk);		# mask=distance<prefetch?-prefetch:-1
	&and	($chunk,"eax");
	&jz	(&label("${mode}_unaligned_tail"));
    }
	&jmp	(&label("${mode}_loop"));

&set_label("${mode}_loop",16);
	&mov	(&DWP(0,"ebp"),$out);		# save parameters
	&mov	(&DWP(4,"ebp"),$inp);
	&mov	(&DWP(8,"ebp"),$len);
	&mov	($len,$chunk);
	&mov	(&DWP(12,"ebp"),$chunk);	# chunk
						if ($mode eq "ctr32") {
	&mov	("ecx",&DWP(-4,$ctx));
	&xor	($out,$out);
	&mov	("eax",&DWP(-8,$ctx));		# borrow $len
&set_label("${mode}_prepare");
	&mov	(&DWP(12,"esp",$out),"ecx");
	&bswap	("ecx");
	&movq	(&QWP(0,"esp",$out),"mm0");
	&inc	("ecx");
	&mov	(&DWP(8,"esp",$out),"eax");
	&bswap	("ecx");
	&lea	($out,&DWP(16,$out));
	&cmp	($out,$chunk);
	&jb	(&label("${mode}_prepare"));

	&mov	(&DWP(-4,$ctx),"ecx");
	&lea	($inp,&DWP(0,"esp"));
	&lea	($out,&DWP(0,"esp"));
	&mov	($len,$chunk);
						} else {
	&test	($out,0x0f);			# out_misaligned
	&cmovnz	($out,"esp");
	&test	($inp,0x0f);			# inp_misaligned
	&jz	(&label("${mode}_inp_aligned"));
	&shr	($len,2);
	&data_byte(0xf3,0xa5);			# rep movsl
	&sub	($out,$chunk);
	&mov	($len,$chunk);
	&mov	($inp,$out);
&set_label("${mode}_inp_aligned");
						}
	&lea	("eax",&DWP(-16,$ctx));		# ivp
	&lea	("ebx",&DWP(16,$ctx));		# key
	&shr	($len,4);			# len/=AES_BLOCK_SIZE
	&data_byte(0xf3,0x0f,0xa7,$opcode);	# rep xcrypt*
						if ($mode !~ /ecb|ctr/) {
	&movaps	("xmm0",&QWP(0,"eax"));
	&movaps	(&QWP(-16,$ctx),"xmm0");	# copy [or refresh] iv
						}
	&mov	($out,&DWP(0,"ebp"));		# restore parameters
	&mov	($chunk,&DWP(12,"ebp"));
						if ($mode eq "ctr32") {
	&mov	($inp,&DWP(4,"ebp"));
	&xor	($len,$len);
&set_label("${mode}_xor");
	&movups	("xmm1",&QWP(0,$inp,$len));
	&lea	($len,&DWP(16,$len));
	&pxor	("xmm1",&QWP(-16,"esp",$len));
	&movups	(&QWP(-16,$out,$len),"xmm1");
	&cmp	($len,$chunk);
	&jb	(&label("${mode}_xor"));
						} else {
	&test	($out,0x0f);
	&jz	(&label("${mode}_out_aligned"));
	&mov	($len,$chunk);
	&lea	($inp,&DWP(0,"esp"));
	&shr	($len,2);
	&data_byte(0xf3,0xa5);			# rep movsl
	&sub	($out,$chunk);
&set_label("${mode}_out_aligned");
	&mov	($inp,&DWP(4,"ebp"));
						}
	&mov	($len,&DWP(8,"ebp"));
	&add	($out,$chunk);
	&add	($inp,$chunk);
	&sub	($len,$chunk);
	&mov	($chunk,$PADLOCK_CHUNK);
    if (!$PADLOCK_PREFETCH{$mode}) {
	&jnz	(&label("${mode}_loop"));
    } else {
	&jz	(&label("${mode}_break"));
	&cmp	($len,$chunk);
	&jae	(&label("${mode}_loop"));

&set_label("${mode}_unaligned_tail");
	&xor	("eax","eax");
	&cmp	("esp","ebp");
	&cmove	("eax",$len);
	&sub	("esp","eax");			# alloca
	&mov	("eax", $out);			# save parameters
	&mov	($chunk,$len);
	&shr	($len,2);
	&lea	($out,&DWP(0,"esp"));
	&data_byte(0xf3,0xa5);			# rep movsl
	&mov	($inp,"esp");
	&mov	($out,"eax");			# restore parameters
	&mov	($len,$chunk);
	&jmp	(&label("${mode}_loop"));

&set_label("${mode}_break",16);
    }
						if ($mode ne "ctr32") {
	&cmp	("esp","ebp");
	&je	(&label("${mode}_done"));
						}
	&pxor	("xmm0","xmm0");
	&lea	("eax",&DWP(0,"esp"));
&set_label("${mode}_bzero");
	&movaps	(&QWP(0,"eax"),"xmm0");
	&lea	("eax",&DWP(16,"eax"));
	&cmp	("ebp","eax");
	&ja	(&label("${mode}_bzero"));

&set_label("${mode}_done");
	&mov	("ebp",&DWP(16,"ebp"));
	&lea	("esp",&DWP(24,"ebp"));
						if ($mode ne "ctr32") {
	&jmp	(&label("${mode}_exit"));

&set_label("${mode}_aligned",16);
    if ($PADLOCK_PREFETCH{$mode}) {
	&lea	("ebp",&DWP(0,$inp,$len));
	&neg	("ebp");
	&and	("ebp",0xfff);			# distance to page boundary
	&xor	("eax","eax");
	&cmp	("ebp",$PADLOCK_PREFETCH{$mode});
	&mov	("ebp",$PADLOCK_PREFETCH{$mode}-1);
	&cmovae	("ebp","eax");
	&and	("ebp",$len);			# remainder
	&sub	($len,"ebp");
	&jz	(&label("${mode}_aligned_tail"));
    }
	&lea	("eax",&DWP(-16,$ctx));		# ivp
	&lea	("ebx",&DWP(16,$ctx));		# key
	&shr	($len,4);			# len/=AES_BLOCK_SIZE
	&data_byte(0xf3,0x0f,0xa7,$opcode);	# rep xcrypt*
						if ($mode ne "ecb") {
	&movaps	("xmm0",&QWP(0,"eax"));
	&movaps	(&QWP(-16,$ctx),"xmm0");	# copy [or refresh] iv
						}
    if ($PADLOCK_PREFETCH{$mode}) {
	&test	("ebp","ebp");
	&jz	(&label("${mode}_exit"));

&set_label("${mode}_aligned_tail");
	&mov	($len,"ebp");
	&lea	("ebp",&DWP(-24,"esp"));
	&mov	("esp","ebp");
	&mov	("eax","ebp");
	&sub	("esp",$len);
	&and	("ebp",-16);
	&and	("esp",-16);
	&mov	(&DWP(16,"ebp"),"eax");
	&mov	("eax", $out);			# save parameters
	&mov	($chunk,$len);
	&shr	($len,2);
	&lea	($out,&DWP(0,"esp"));
	&data_byte(0xf3,0xa5);			# rep movsl
	&mov	($inp,"esp");
	&mov	($out,"eax");			# restore parameters
	&mov	($len,$chunk);
	&jmp	(&label("${mode}_loop"));
    }
&set_label("${mode}_exit");			}
	&mov	("eax",1);
	&lea	("esp",&DWP(4,"esp"));		# popf
	&emms	()				if ($mode eq "ctr32");
&set_label("${mode}_abort");
&function_end("padlock_${mode}_encrypt");
}

&generate_mode("ecb",0xc8);
&generate_mode("cbc",0xd0);
&generate_mode("cfb",0xe0);
&generate_mode("ofb",0xe8);
&generate_mode("ctr32",0xc8);	# yes, it implements own CTR with ECB opcode,
				# because hardware CTR was introduced later
				# and even has errata on certain C7 stepping.
				# own implementation *always* works, though
				# ~15% slower than dedicated hardware...

&function_begin_B("padlock_xstore");
	&push	("edi");
	&mov	("edi",&wparam(0));
	&mov	("edx",&wparam(1));
	&data_byte(0x0f,0xa7,0xc0);		# xstore
	&pop	("edi");
	&ret	();
&function_end_B("padlock_xstore");

&function_begin_B("_win32_segv_handler");
	&mov	("eax",1);			# ExceptionContinueSearch
	&mov	("edx",&wparam(0));		# *ExceptionRecord
	&mov	("ecx",&wparam(2));		# *ContextRecord
	&cmp	(&DWP(0,"edx"),0xC0000005)	# ExceptionRecord->ExceptionCode == STATUS_ACCESS_VIOLATION
	&jne	(&label("ret"));
	&add	(&DWP(184,"ecx"),4);		# skip over rep sha*
	&mov	("eax",0);			# ExceptionContinueExecution
&set_label("ret");
	&ret	();
&function_end_B("_win32_segv_handler");
&safeseh("_win32_segv_handler")			if ($::win32);

&function_begin_B("padlock_sha1_oneshot");
	&push	("edi");
	&push	("esi");
	&xor	("eax","eax");
	&mov	("edi",&wparam(0));
	&mov	("esi",&wparam(1));
	&mov	("ecx",&wparam(2));
    if ($::win32 or $::coff) {
    	&push	(&::islabel("_win32_segv_handler"));
	&data_byte(0x64,0xff,0x30);		# push	%fs:(%eax)
	&data_byte(0x64,0x89,0x20);		# mov	%esp,%fs:(%eax)
    }
	&mov	("edx","esp");			# put aside %esp
	&add	("esp",-128);			# 32 is enough but spec says 128
	&movups	("xmm0",&QWP(0,"edi"));		# copy-in context
	&and	("esp",-16);
	&mov	("eax",&DWP(16,"edi"));
	&movaps	(&QWP(0,"esp"),"xmm0");
	&mov	("edi","esp");
	&mov	(&DWP(16,"esp"),"eax");
	&xor	("eax","eax");
	&data_byte(0xf3,0x0f,0xa6,0xc8);	# rep xsha1
	&movaps	("xmm0",&QWP(0,"esp"));
	&mov	("eax",&DWP(16,"esp"));
	&mov	("esp","edx");			# restore %esp
    if ($::win32 or $::coff) {
	&data_byte(0x64,0x8f,0x05,0,0,0,0);	# pop	%fs:0
	&lea	("esp",&DWP(4,"esp"));
    }
	&mov	("edi",&wparam(0));
	&movups	(&QWP(0,"edi"),"xmm0");		# copy-out context
	&mov	(&DWP(16,"edi"),"eax");
	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_sha1_oneshot");

&function_begin_B("padlock_sha1_blocks");
	&push	("edi");
	&push	("esi");
	&mov	("edi",&wparam(0));
	&mov	("esi",&wparam(1));
	&mov	("edx","esp");			# put aside %esp
	&mov	("ecx",&wparam(2));
	&add	("esp",-128);
	&movups	("xmm0",&QWP(0,"edi"));		# copy-in context
	&and	("esp",-16);
	&mov	("eax",&DWP(16,"edi"));
	&movaps	(&QWP(0,"esp"),"xmm0");
	&mov	("edi","esp");
	&mov	(&DWP(16,"esp"),"eax");
	&mov	("eax",-1);
	&data_byte(0xf3,0x0f,0xa6,0xc8);	# rep xsha1
	&movaps	("xmm0",&QWP(0,"esp"));
	&mov	("eax",&DWP(16,"esp"));
	&mov	("esp","edx");			# restore %esp
	&mov	("edi",&wparam(0));
	&movups	(&QWP(0,"edi"),"xmm0");		# copy-out context
	&mov	(&DWP(16,"edi"),"eax");
 	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_sha1_blocks");

&function_begin_B("padlock_sha256_oneshot");
	&push	("edi");
	&push	("esi");
	&xor	("eax","eax");
	&mov	("edi",&wparam(0));
	&mov	("esi",&wparam(1));
	&mov	("ecx",&wparam(2));
    if ($::win32 or $::coff) {
    	&push	(&::islabel("_win32_segv_handler"));
	&data_byte(0x64,0xff,0x30);		# push	%fs:(%eax)
	&data_byte(0x64,0x89,0x20);		# mov	%esp,%fs:(%eax)
    }
	&mov	("edx","esp");			# put aside %esp
	&add	("esp",-128);
	&movups	("xmm0",&QWP(0,"edi"));		# copy-in context
	&and	("esp",-16);
	&movups	("xmm1",&QWP(16,"edi"));
	&movaps	(&QWP(0,"esp"),"xmm0");
	&mov	("edi","esp");
	&movaps	(&QWP(16,"esp"),"xmm1");
	&xor	("eax","eax");
	&data_byte(0xf3,0x0f,0xa6,0xd0);	# rep xsha256
	&movaps	("xmm0",&QWP(0,"esp"));
	&movaps	("xmm1",&QWP(16,"esp"));
	&mov	("esp","edx");			# restore %esp
    if ($::win32 or $::coff) {
	&data_byte(0x64,0x8f,0x05,0,0,0,0);	# pop	%fs:0
	&lea	("esp",&DWP(4,"esp"));
    }
	&mov	("edi",&wparam(0));
	&movups	(&QWP(0,"edi"),"xmm0");		# copy-out context
	&movups	(&QWP(16,"edi"),"xmm1");
	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_sha256_oneshot");

&function_begin_B("padlock_sha256_blocks");
	&push	("edi");
	&push	("esi");
	&mov	("edi",&wparam(0));
	&mov	("esi",&wparam(1));
	&mov	("ecx",&wparam(2));
	&mov	("edx","esp");			# put aside %esp
	&add	("esp",-128);
	&movups	("xmm0",&QWP(0,"edi"));		# copy-in context
	&and	("esp",-16);
	&movups	("xmm1",&QWP(16,"edi"));
	&movaps	(&QWP(0,"esp"),"xmm0");
	&mov	("edi","esp");
	&movaps	(&QWP(16,"esp"),"xmm1");
	&mov	("eax",-1);
	&data_byte(0xf3,0x0f,0xa6,0xd0);	# rep xsha256
	&movaps	("xmm0",&QWP(0,"esp"));
	&movaps	("xmm1",&QWP(16,"esp"));
	&mov	("esp","edx");			# restore %esp
	&mov	("edi",&wparam(0));
	&movups	(&QWP(0,"edi"),"xmm0");		# copy-out context
	&movups	(&QWP(16,"edi"),"xmm1");
	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_sha256_blocks");

&function_begin_B("padlock_sha512_blocks");
	&push	("edi");
	&push	("esi");
	&mov	("edi",&wparam(0));
	&mov	("esi",&wparam(1));
	&mov	("ecx",&wparam(2));
	&mov	("edx","esp");			# put aside %esp
	&add	("esp",-128);
	&movups	("xmm0",&QWP(0,"edi"));		# copy-in context
	&and	("esp",-16);
	&movups	("xmm1",&QWP(16,"edi"));
	&movups	("xmm2",&QWP(32,"edi"));
	&movups	("xmm3",&QWP(48,"edi"));
	&movaps	(&QWP(0,"esp"),"xmm0");
	&mov	("edi","esp");
	&movaps	(&QWP(16,"esp"),"xmm1");
	&movaps	(&QWP(32,"esp"),"xmm2");
	&movaps	(&QWP(48,"esp"),"xmm3");
	&data_byte(0xf3,0x0f,0xa6,0xe0);	# rep xsha512
	&movaps	("xmm0",&QWP(0,"esp"));
	&movaps	("xmm1",&QWP(16,"esp"));
	&movaps	("xmm2",&QWP(32,"esp"));
	&movaps	("xmm3",&QWP(48,"esp"));
	&mov	("esp","edx");			# restore %esp
	&mov	("edi",&wparam(0));
	&movups	(&QWP(0,"edi"),"xmm0");		# copy-out context
	&movups	(&QWP(16,"edi"),"xmm1");
	&movups	(&QWP(32,"edi"),"xmm2");
	&movups	(&QWP(48,"edi"),"xmm3");
	&pop	("esi");
	&pop	("edi");
	&ret	();
&function_end_B("padlock_sha512_blocks");

&asciz	("VIA Padlock x86 module, CRYPTOGAMS by <appro\@openssl.org>");
&align	(16);

&dataseg();
# Essentially this variable belongs in thread local storage.
# Having this variable global on the other hand can only cause
# few bogus key reloads [if any at all on signle-CPU system],
# so we accept the penalty...
&set_label("padlock_saved_context",4);
&data_word(0);

&asm_finish();

close STDOUT;


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

# September 2011
#
# Assembler helpers for Padlock engine. See even e_padlock-x86.pl for
# details.

$flavour = shift;
$output  = shift;
if ($flavour =~ /\./) { $output = $flavour; undef $flavour; }

$win64=0; $win64=1 if ($flavour =~ /[nm]asm|mingw64/ || $output =~ /\.asm$/);

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

open OUT,"| \"$^X\" \"$xlate\" $flavour \"$output\"";
*STDOUT=*OUT;

$code=".text\n";

%PADLOCK_PREFETCH=(ecb=>128, cbc=>64, ctr32=>32);	# prefetch errata
$PADLOCK_CHUNK=512;	# Must be a power of 2 between 32 and 2^20

$ctx="%rdx";
$out="%rdi";
$inp="%rsi";
$len="%rcx";
$chunk="%rbx";

($arg1,$arg2,$arg3,$arg4)=$win64?("%rcx","%rdx","%r8", "%r9") : # Win64 order
                                 ("%rdi","%rsi","%rdx","%rcx"); # Unix order

$code.=<<___;
.globl	padlock_capability
.type	padlock_capability,\@abi-omnipotent
.align	16
padlock_capability:
	mov	%rbx,%r8
	xor	%eax,%eax
	cpuid
	xor	%eax,%eax
	cmp	\$`"0x".unpack("H*",'tneC')`,%ebx
	jne	.Lzhaoxin
	cmp	\$`"0x".unpack("H*",'Hrua')`,%edx
	jne	.Lnoluck
	cmp	\$`"0x".unpack("H*",'slua')`,%ecx
	jne	.Lnoluck
	jmp	.LzhaoxinEnd
.Lzhaoxin:
	cmp	\$`"0x".unpack("H*",'hS  ')`,%ebx
	jne	.Lnoluck
	cmp	\$`"0x".unpack("H*",'hgna')`,%edx
	jne	.Lnoluck
	cmp	\$`"0x".unpack("H*",'  ia')`,%ecx
	jne	.Lnoluck
.LzhaoxinEnd:
	mov	\$0xC0000000,%eax
	cpuid
	mov	%eax,%edx
	xor	%eax,%eax
	cmp	\$0xC0000001,%edx
	jb	.Lnoluck
	mov	\$0xC0000001,%eax
	cpuid
	mov	%edx,%eax
	and	\$0xffffffef,%eax
	or	\$0x10,%eax		# set Nano bit#4
.Lnoluck:
	mov	%r8,%rbx
	ret
.size	padlock_capability,.-padlock_capability

.globl	padlock_key_bswap
.type	padlock_key_bswap,\@abi-omnipotent,0
.align	16
padlock_key_bswap:
	mov	240($arg1),%edx
.Lbswap_loop:
	mov	($arg1),%eax
	bswap	%eax
	mov	%eax,($arg1)
	lea	4($arg1),$arg1
	sub	\$1,%edx
	jnz	.Lbswap_loop
	ret
.size	padlock_key_bswap,.-padlock_key_bswap

.globl	padlock_verify_context
.type	padlock_verify_context,\@abi-omnipotent
.align	16
padlock_verify_context:
	mov	$arg1,$ctx
	pushf
	lea	.Lpadlock_saved_context(%rip),%rax
	call	_padlock_verify_ctx
	lea	8(%rsp),%rsp
	ret
.size	padlock_verify_context,.-padlock_verify_context

.type	_padlock_verify_ctx,\@abi-omnipotent
.align	16
_padlock_verify_ctx:
	mov	8(%rsp),%r8
	bt	\$30,%r8
	jnc	.Lverified
	cmp	(%rax),$ctx
	je	.Lverified
	pushf
	popf
.Lverified:
	mov	$ctx,(%rax)
	ret
.size	_padlock_verify_ctx,.-_padlock_verify_ctx

.globl	padlock_reload_key
.type	padlock_reload_key,\@abi-omnipotent
.align	16
padlock_reload_key:
	pushf
	popf
	ret
.size	padlock_reload_key,.-padlock_reload_key

.globl	padlock_aes_block
.type	padlock_aes_block,\@function,3
.align	16
padlock_aes_block:
	mov	%rbx,%r8
	mov	\$1,$len
	lea	32($ctx),%rbx		# key
	lea	16($ctx),$ctx		# control word
	.byte	0xf3,0x0f,0xa7,0xc8	# rep xcryptecb
	mov	%r8,%rbx
	ret
.size	padlock_aes_block,.-padlock_aes_block

.globl	padlock_xstore
.type	padlock_xstore,\@function,2
.align	16
padlock_xstore:
	mov	%esi,%edx
	.byte	0x0f,0xa7,0xc0		# xstore
	ret
.size	padlock_xstore,.-padlock_xstore

.globl	padlock_sha1_oneshot
.type	padlock_sha1_oneshot,\@function,3
.align	16
padlock_sha1_oneshot:
	mov	%rdx,%rcx
	mov	%rdi,%rdx		# put aside %rdi
	movups	(%rdi),%xmm0		# copy-in context
	sub	\$128+8,%rsp
	mov	16(%rdi),%eax
	movaps	%xmm0,(%rsp)
	mov	%rsp,%rdi
	mov	%eax,16(%rsp)
	xor	%rax,%rax
	.byte	0xf3,0x0f,0xa6,0xc8	# rep xsha1
	movaps	(%rsp),%xmm0
	mov	16(%rsp),%eax
	add	\$128+8,%rsp
	movups	%xmm0,(%rdx)		# copy-out context
	mov	%eax,16(%rdx)
	ret
.size	padlock_sha1_oneshot,.-padlock_sha1_oneshot

.globl	padlock_sha1_blocks
.type	padlock_sha1_blocks,\@function,3
.align	16
padlock_sha1_blocks:
	mov	%rdx,%rcx
	mov	%rdi,%rdx		# put aside %rdi
	movups	(%rdi),%xmm0		# copy-in context
	sub	\$128+8,%rsp
	mov	16(%rdi),%eax
	movaps	%xmm0,(%rsp)
	mov	%rsp,%rdi
	mov	%eax,16(%rsp)
	mov	\$-1,%rax
	.byte	0xf3,0x0f,0xa6,0xc8	# rep xsha1
	movaps	(%rsp),%xmm0
	mov	16(%rsp),%eax
	add	\$128+8,%rsp
	movups	%xmm0,(%rdx)		# copy-out context
	mov	%eax,16(%rdx)
	ret
.size	padlock_sha1_blocks,.-padlock_sha1_blocks

.globl	padlock_sha256_oneshot
.type	padlock_sha256_oneshot,\@function,3
.align	16
padlock_sha256_oneshot:
	mov	%rdx,%rcx
	mov	%rdi,%rdx		# put aside %rdi
	movups	(%rdi),%xmm0		# copy-in context
	sub	\$128+8,%rsp
	movups	16(%rdi),%xmm1
	movaps	%xmm0,(%rsp)
	mov	%rsp,%rdi
	movaps	%xmm1,16(%rsp)
	xor	%rax,%rax
	.byte	0xf3,0x0f,0xa6,0xd0	# rep xsha256
	movaps	(%rsp),%xmm0
	movaps	16(%rsp),%xmm1
	add	\$128+8,%rsp
	movups	%xmm0,(%rdx)		# copy-out context
	movups	%xmm1,16(%rdx)
	ret
.size	padlock_sha256_oneshot,.-padlock_sha256_oneshot

.globl	padlock_sha256_blocks
.type	padlock_sha256_blocks,\@function,3
.align	16
padlock_sha256_blocks:
	mov	%rdx,%rcx
	mov	%rdi,%rdx		# put aside %rdi
	movups	(%rdi),%xmm0		# copy-in context
	sub	\$128+8,%rsp
	movups	16(%rdi),%xmm1
	movaps	%xmm0,(%rsp)
	mov	%rsp,%rdi
	movaps	%xmm1,16(%rsp)
	mov	\$-1,%rax
	.byte	0xf3,0x0f,0xa6,0xd0	# rep xsha256
	movaps	(%rsp),%xmm0
	movaps	16(%rsp),%xmm1
	add	\$128+8,%rsp
	movups	%xmm0,(%rdx)		# copy-out context
	movups	%xmm1,16(%rdx)
	ret
.size	padlock_sha256_blocks,.-padlock_sha256_blocks

.globl	padlock_sha512_blocks
.type	padlock_sha512_blocks,\@function,3
.align	16
padlock_sha512_blocks:
	mov	%rdx,%rcx
	mov	%rdi,%rdx		# put aside %rdi
	movups	(%rdi),%xmm0		# copy-in context
	sub	\$128+8,%rsp
	movups	16(%rdi),%xmm1
	movups	32(%rdi),%xmm2
	movups	48(%rdi),%xmm3
	movaps	%xmm0,(%rsp)
	mov	%rsp,%rdi
	movaps	%xmm1,16(%rsp)
	movaps	%xmm2,32(%rsp)
	movaps	%xmm3,48(%rsp)
	.byte	0xf3,0x0f,0xa6,0xe0	# rep xha512
	movaps	(%rsp),%xmm0
	movaps	16(%rsp),%xmm1
	movaps	32(%rsp),%xmm2
	movaps	48(%rsp),%xmm3
	add	\$128+8,%rsp
	movups	%xmm0,(%rdx)		# copy-out context
	movups	%xmm1,16(%rdx)
	movups	%xmm2,32(%rdx)
	movups	%xmm3,48(%rdx)
	ret
.size	padlock_sha512_blocks,.-padlock_sha512_blocks
___

sub generate_mode {
my ($mode,$opcode) = @_;
# int padlock_$mode_encrypt(void *out, const void *inp,
#		struct padlock_cipher_data *ctx, size_t len);
$code.=<<___;
.globl	padlock_${mode}_encrypt
.type	padlock_${mode}_encrypt,\@function,4
.align	16
padlock_${mode}_encrypt:
	push	%rbp
	push	%rbx

	xor	%eax,%eax
	test	\$15,$ctx
	jnz	.L${mode}_abort
	test	\$15,$len
	jnz	.L${mode}_abort
	lea	.Lpadlock_saved_context(%rip),%rax
	pushf
	cld
	call	_padlock_verify_ctx
	lea	16($ctx),$ctx		# control word
	xor	%eax,%eax
	xor	%ebx,%ebx
	testl	\$`1<<5`,($ctx)		# align bit in control word
	jnz	.L${mode}_aligned
	test	\$0x0f,$out
	setz	%al			# !out_misaligned
	test	\$0x0f,$inp
	setz	%bl			# !inp_misaligned
	test	%ebx,%eax
	jnz	.L${mode}_aligned
	neg	%rax
	mov	\$$PADLOCK_CHUNK,$chunk
	not	%rax			# out_misaligned?-1:0
	lea	(%rsp),%rbp
	cmp	$chunk,$len
	cmovc	$len,$chunk		# chunk=len>PADLOCK_CHUNK?PADLOCK_CHUNK:len
	and	$chunk,%rax		# out_misaligned?chunk:0
	mov	$len,$chunk
	neg	%rax
	and	\$$PADLOCK_CHUNK-1,$chunk	# chunk%=PADLOCK_CHUNK
	lea	(%rax,%rbp),%rsp
	mov	\$$PADLOCK_CHUNK,%rax
	cmovz	%rax,$chunk			# chunk=chunk?:PADLOCK_CHUNK
___
$code.=<<___				if ($mode eq "ctr32");
.L${mode}_reenter:
	mov	-4($ctx),%eax		# pull 32-bit counter
	bswap	%eax
	neg	%eax
	and	\$`$PADLOCK_CHUNK/16-1`,%eax
	mov	\$$PADLOCK_CHUNK,$chunk
	shl	\$4,%eax
	cmovz	$chunk,%rax
	cmp	%rax,$len
	cmova	%rax,$chunk		# don't let counter cross PADLOCK_CHUNK
	cmovbe	$len,$chunk
___
$code.=<<___				if ($PADLOCK_PREFETCH{$mode});
	cmp	$chunk,$len
	ja	.L${mode}_loop
	mov	$inp,%rax		# check if prefetch crosses page
	cmp	%rsp,%rbp
	cmove	$out,%rax
	add	$len,%rax
	neg	%rax
	and	\$0xfff,%rax		# distance to page boundary
	cmp	\$$PADLOCK_PREFETCH{$mode},%rax
	mov	\$-$PADLOCK_PREFETCH{$mode},%rax
	cmovae	$chunk,%rax		# mask=distance<prefetch?-prefetch:-1
	and	%rax,$chunk
	jz	.L${mode}_unaligned_tail
___
$code.=<<___;
	jmp	.L${mode}_loop
.align	16
.L${mode}_loop:
	cmp	$len,$chunk		# ctr32 artefact
	cmova	$len,$chunk		# ctr32 artefact
	mov	$out,%r8		# save parameters
	mov	$inp,%r9
	mov	$len,%r10
	mov	$chunk,$len
	mov	$chunk,%r11
	test	\$0x0f,$out		# out_misaligned
	cmovnz	%rsp,$out
	test	\$0x0f,$inp		# inp_misaligned
	jz	.L${mode}_inp_aligned
	shr	\$3,$len
	.byte	0xf3,0x48,0xa5		# rep movsq
	sub	$chunk,$out
	mov	$chunk,$len
	mov	$out,$inp
.L${mode}_inp_aligned:
	lea	-16($ctx),%rax		# ivp
	lea	16($ctx),%rbx		# key
	shr	\$4,$len
	.byte	0xf3,0x0f,0xa7,$opcode	# rep xcrypt*
___
$code.=<<___				if ($mode !~ /ecb|ctr/);
	movdqa	(%rax),%xmm0
	movdqa	%xmm0,-16($ctx)		# copy [or refresh] iv
___
$code.=<<___				if ($mode eq "ctr32");
	mov	-4($ctx),%eax		# pull 32-bit counter
	test	\$0xffff0000,%eax
	jnz	.L${mode}_no_carry
	bswap	%eax
	add	\$0x10000,%eax
	bswap	%eax
	mov	%eax,-4($ctx)
.L${mode}_no_carry:
___
$code.=<<___;
	mov	%r8,$out		# restore parameters
	mov	%r11,$chunk
	test	\$0x0f,$out
	jz	.L${mode}_out_aligned
	mov	$chunk,$len
	lea	(%rsp),$inp
	shr	\$3,$len
	.byte	0xf3,0x48,0xa5		# rep movsq
	sub	$chunk,$out
.L${mode}_out_aligned:
	mov	%r9,$inp
	mov	%r10,$len
	add	$chunk,$out
	add	$chunk,$inp
	sub	$chunk,$len
	mov	\$$PADLOCK_CHUNK,$chunk
___
					if (!$PADLOCK_PREFETCH{$mode}) {
$code.=<<___;
	jnz	.L${mode}_loop
___
					} else {
$code.=<<___;
	jz	.L${mode}_break
	cmp	$chunk,$len
	jae	.L${mode}_loop
___
$code.=<<___				if ($mode eq "ctr32");
	mov	$len,$chunk
	mov	$inp,%rax		# check if prefetch crosses page
	cmp	%rsp,%rbp
	cmove	$out,%rax
	add	$len,%rax
	neg	%rax
	and	\$0xfff,%rax		# distance to page boundary
	cmp	\$$PADLOCK_PREFETCH{$mode},%rax
	mov	\$-$PADLOCK_PREFETCH{$mode},%rax
	cmovae	$chunk,%rax
	and	%rax,$chunk
	jnz	.L${mode}_loop
___
$code.=<<___;
.L${mode}_unaligned_tail:
	xor	%eax,%eax
	cmp	%rsp,%rbp
	cmove	$len,%rax
	mov	$out,%r8		# save parameters
	mov	$len,$chunk
	sub	%rax,%rsp		# alloca
	shr	\$3,$len
	lea	(%rsp),$out
	.byte	0xf3,0x48,0xa5		# rep movsq
	mov	%rsp,$inp
	mov	%r8, $out		# restore parameters
	mov	$chunk,$len
	jmp	.L${mode}_loop
.align	16
.L${mode}_break:
___
					}
$code.=<<___;
	cmp	%rbp,%rsp
	je	.L${mode}_done

	pxor	%xmm0,%xmm0
	lea	(%rsp),%rax
.L${mode}_bzero:
	movaps	%xmm0,(%rax)
	lea	16(%rax),%rax
	cmp	%rax,%rbp
	ja	.L${mode}_bzero

.L${mode}_done:
	lea	(%rbp),%rsp
	jmp	.L${mode}_exit

.align	16
.L${mode}_aligned:
___
$code.=<<___				if ($mode eq "ctr32");
	mov	-4($ctx),%eax		# pull 32-bit counter
	bswap	%eax
	neg	%eax
	and	\$0xffff,%eax
	mov	\$`16*0x10000`,$chunk
	shl	\$4,%eax
	cmovz	$chunk,%rax
	cmp	%rax,$len
	cmova	%rax,$chunk		# don't let counter cross 2^16
	cmovbe	$len,$chunk
	jbe	.L${mode}_aligned_skip

.L${mode}_aligned_loop:
	mov	$len,%r10		# save parameters
	mov	$chunk,$len
	mov	$chunk,%r11

	lea	-16($ctx),%rax		# ivp
	lea	16($ctx),%rbx		# key
	shr	\$4,$len		# len/=AES_BLOCK_SIZE
	.byte	0xf3,0x0f,0xa7,$opcode	# rep xcrypt*

	mov	-4($ctx),%eax		# pull 32-bit counter
	bswap	%eax
	add	\$0x10000,%eax
	bswap	%eax
	mov	%eax,-4($ctx)

	mov	%r10,$len		# restore parameters
	sub	%r11,$len
	mov	\$`16*0x10000`,$chunk
	jz	.L${mode}_exit
	cmp	$chunk,$len
	jae	.L${mode}_aligned_loop

.L${mode}_aligned_skip:
___
$code.=<<___				if ($PADLOCK_PREFETCH{$mode});
	lea	($inp,$len),%rbp
	neg	%rbp
	and	\$0xfff,%rbp		# distance to page boundary
	xor	%eax,%eax
	cmp	\$$PADLOCK_PREFETCH{$mode},%rbp
	mov	\$$PADLOCK_PREFETCH{$mode}-1,%rbp
	cmovae	%rax,%rbp
	and	$len,%rbp		# remainder
	sub	%rbp,$len
	jz	.L${mode}_aligned_tail
___
$code.=<<___;
	lea	-16($ctx),%rax		# ivp
	lea	16($ctx),%rbx		# key
	shr	\$4,$len		# len/=AES_BLOCK_SIZE
	.byte	0xf3,0x0f,0xa7,$opcode	# rep xcrypt*
___
$code.=<<___				if ($mode !~ /ecb|ctr/);
	movdqa	(%rax),%xmm0
	movdqa	%xmm0,-16($ctx)		# copy [or refresh] iv
___
$code.=<<___				if ($PADLOCK_PREFETCH{$mode});
	test	%rbp,%rbp		# check remainder
	jz	.L${mode}_exit

.L${mode}_aligned_tail:
	mov	$out,%r8
	mov	%rbp,$chunk
	mov	%rbp,$len
	lea	(%rsp),%rbp
	sub	$len,%rsp
	shr	\$3,$len
	lea	(%rsp),$out
	.byte	0xf3,0x48,0xa5		# rep movsq
	lea	(%r8),$out
	lea	(%rsp),$inp
	mov	$chunk,$len
	jmp	.L${mode}_loop
___
$code.=<<___;
.L${mode}_exit:
	mov	\$1,%eax
	lea	8(%rsp),%rsp
.L${mode}_abort:
	pop	%rbx
	pop	%rbp
	ret
.size	padlock_${mode}_encrypt,.-padlock_${mode}_encrypt
___
}

&generate_mode("ecb",0xc8);
&generate_mode("cbc",0xd0);
&generate_mode("cfb",0xe0);
&generate_mode("ofb",0xe8);
&generate_mode("ctr32",0xd8);	# all 64-bit CPUs have working CTR...

$code.=<<___;
.asciz	"VIA Padlock x86_64 module, CRYPTOGAMS by <appro\@openssl.org>"
.align	16
.data
.align	8
.Lpadlock_saved_context:
	.quad	0
___
$code =~ s/\`([^\`]*)\`/eval($1)/gem;

print $code;

close STDOUT;


#! /usr/bin/env perl
# Copyright 1995-2018 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

my $obj_dat_h = $ARGV[0];

# Output year depends on the date on the input file and the script.
my $YEAR = [localtime([stat($0)]->[9])]->[5] + 1900;
my $iYEAR = [localtime([stat($obj_dat_h)]->[9])]->[5] + 1900;
$YEAR = $iYEAR if $iYEAR > $YEAR;

open IN, '<', $obj_dat_h
    || die "Couldn't open $obj_dat_h : $!\n";

while(<IN>) {
    s|\R$||;                    # Better chomp

    next unless m|^\s+((0x[0-9A-F][0-9A-F],)*)\s+/\*\s\[\s*\d+\]\s(OBJ_\w+)\s\*/$|;

    my $OID = $1;
    my $OBJname = $3;

    $OID =~ s|0x|\\x|g;
    $OID =~ s|,||g;

    print "$OBJname=\"$OID\"\n";
}
close IN;


#! /usr/bin/env perl
# Copyright 1995-2016 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

($#ARGV == 1) || die "usage: cmp.pl <file1> <file2>\n";

open(IN0,"<$ARGV[0]") || die "unable to open $ARGV[0]\n";
open(IN1,"<$ARGV[1]") || die "unable to open $ARGV[1]\n";
binmode IN0;
binmode IN1;

$tot=0;
$ret=1;
for (;;)
{
    $n1=sysread(IN0,$b1,4096);
    $n2=sysread(IN1,$b2,4096);

    last if ($n1 != $n2);
    last if ($b1 ne $b2);
    last if ($n1 < 0);
    if ($n1 == 0)
    {
        $ret=0;
        last;
    }
    $tot+=$n1;
}

close(IN0);
close(IN1);
if ($ret)
{
    printf STDERR "$ARGV[0] and $ARGV[1] are different\n";
    @a1=unpack("C*",$b1);
    @a2=unpack("C*",$b2);
    for ($i=0; $i<=$#a1; $i++)
    {
        if ($a1[$i] ne $a2[$i])
        {
            printf "%02X %02X <<\n",$a1[$i],$a2[$i];
            last;
        }
    }
    $nm=$tot+$n1;
    $tot+=$i+1;
    printf STDERR "diff at char $tot of $nm\n";
}
exit($ret);


#! /usr/bin/env perl
# Copyright 2008-2016 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

# pull APPLINK_MAX value from applink.c...
$applink_c=$0;
$applink_c=~s|[^/\\]+$||g;
$applink_c.="applink.c";
open(INPUT,$applink_c) || die "can't open $applink_c: $!";
@max=grep {/APPLINK_MAX\s+(\d+)/} <INPUT>;
close(INPUT);
($#max==0) or die "can't find APPLINK_MAX in $applink_c";

$max[0]=~/APPLINK_MAX\s+(\d+)/;
$N=$1;	# number of entries in OPENSSL_UplinkTable not including
	# OPENSSL_UplinkTable[0], which contains this value...

1;

# Idea is to fill the OPENSSL_UplinkTable with pointers to stubs
# which invoke 'void OPENSSL_Uplink (ULONG_PTR *table,int index)';
# and then dereference themselves. Latter shall result in endless
# loop *unless* OPENSSL_Uplink does not replace 'table[index]' with
# something else, e.g. as 'table[index]=unimplemented;'...


#! /usr/bin/env perl
# Copyright 2008-2016 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

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

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

require "uplink-common.pl";

local $V=8;	# max number of args uplink functions may accept...
my $loc0 = "r".(32+$V);
print <<___;
.text
.global	OPENSSL_Uplink#
.type	OPENSSL_Uplink#,\@function

___
for ($i=1;$i<=$N;$i++) {
print <<___;
.proc	lazy$i#
lazy$i:
	.prologue
{ .mii;	.save	ar.pfs,$loc0
	alloc	loc0=ar.pfs,$V,3,2,0
	.save	b0,loc1
	mov	loc1=b0
	addl	loc2=\@ltoff(OPENSSL_UplinkTable#),gp	};;
	.body
{ .mmi;	ld8	out0=[loc2]
	mov	out1=$i					};;
{ .mib;	add	loc2=8*$i,out0
	br.call.sptk.many	b0=OPENSSL_Uplink#	};;
{ .mmi;	ld8	r31=[loc2];;
	ld8	r30=[r31],8				};;
{ .mii;	ld8	gp=[r31]
	mov	b6=r30
	mov	b0=loc1					};;
{ .mib;	mov	ar.pfs=loc0
	br.many	b6					};;
.endp	lazy$i#

___
}
print <<___;
.data
.global OPENSSL_UplinkTable#
OPENSSL_UplinkTable:    data8   $N      // amount of following entries
___
for ($i=1;$i<=$N;$i++) {   print "      data8   \@fptr(lazy$i#)\n";   }
print <<___;
.size   OPENSSL_UplinkTable,.-OPENSSL_UplinkTable#
___

close STDOUT;


#! /usr/bin/env perl
# Copyright 2008-2018 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

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

require "uplink-common.pl";

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

&asm_init($ARGV[0]);

&external_label("OPENSSL_Uplink");
&public_label("OPENSSL_UplinkTable");

for ($i=1;$i<=$N;$i++) {
&function_begin_B("_\$lazy${i}");
	&lea	("eax",&DWP(&label("OPENSSL_UplinkTable")));
	&push	($i);
	&push	("eax");
	&call	(&label("OPENSSL_Uplink"));
	&pop	("eax");
	&add	("esp",4);
	&jmp_ptr(&DWP(4*$i,"eax"));
&function_end_B("_\$lazy${i}");
}

&dataseg();
&align(4);
&set_label("OPENSSL_UplinkTable");
&data_word($N);
for ($i=1;$i<=$N;$i++) {
&data_word(&label("_\$lazy${i}"));
}
&asm_finish();

close STDOUT;


#! /usr/bin/env perl
# Copyright 2008-2016 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

$output=pop;
$0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1;
open OUT,"| \"$^X\" \"${dir}../crypto/perlasm/x86_64-xlate.pl\" \"$output\"";
*STDOUT=*OUT;
push(@INC,"${dir}.");

require "uplink-common.pl";

$prefix="_lazy";

print <<___;
.text
.extern	OPENSSL_Uplink
.globl	OPENSSL_UplinkTable
___
for ($i=1;$i<=$N;$i++) {
print <<___;
.type	$prefix${i},\@abi-omnipotent
.align	16
$prefix${i}:
	.byte	0x48,0x83,0xEC,0x28	# sub rsp,40
	mov	%rcx,48(%rsp)
	mov	%rdx,56(%rsp)
	mov	%r8,64(%rsp)
	mov	%r9,72(%rsp)
	lea	OPENSSL_UplinkTable(%rip),%rcx
	mov	\$$i,%rdx
	call	OPENSSL_Uplink
	mov	48(%rsp),%rcx
	mov	56(%rsp),%rdx
	mov	64(%rsp),%r8
	mov	72(%rsp),%r9
	lea	OPENSSL_UplinkTable(%rip),%rax
	add	\$40,%rsp
	jmp	*8*$i(%rax)
$prefix${i}_end:
.size	$prefix${i},.-$prefix${i}
___
}
print <<___;
.data
OPENSSL_UplinkTable:
        .quad   $N
___
for ($i=1;$i<=$N;$i++) {   print "      .quad   $prefix$i\n";   }
print <<___;
.section	.pdata,"r"
.align		4
___
for ($i=1;$i<=$N;$i++) {
print <<___;
	.rva	$prefix${i},$prefix${i}_end,${prefix}_unwind_info
___
}
print <<___;
.section	.xdata,"r"
.align		8
${prefix}_unwind_info:
	.byte	0x01,0x04,0x01,0x00
	.byte	0x04,0x42,0x00,0x00
___

close STDOUT;


#! /usr/bin/env perl
# Copyright 2008-2016 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

# Run the tests specified in bntests.txt, as a check against OpenSSL.
use strict;
use warnings;
use Math::BigInt;

my $EXPECTED_FAILURES = 0;
my $failures = 0;

sub bn
{
    my $x = shift;
    my ($sign, $hex) = ($x =~ /^([+\-]?)(.*)$/);

    $hex = '0x' . $hex if $hex !~ /^0x/;
    return Math::BigInt->from_hex($sign.$hex);
}

sub evaluate
{
    my $lineno = shift;
    my %s = @_;

    if ( defined $s{'Sum'} ) {
        # Sum = A + B
        my $sum = bn($s{'Sum'});
        my $a = bn($s{'A'});
        my $b = bn($s{'B'});
        return if $sum == $a + $b;
    } elsif ( defined $s{'LShift1'} ) {
        # LShift1 = A * 2
        my $lshift1 = bn($s{'LShift1'});
        my $a = bn($s{'A'});
        return if $lshift1 == $a->bmul(2);
    } elsif ( defined $s{'LShift'} ) {
        # LShift = A * 2**N
        my $lshift = bn($s{'LShift'});
        my $a = bn($s{'A'});
        my $n = bn($s{'N'});
        return if $lshift == $a->blsft($n);
    } elsif ( defined $s{'RShift'} ) {
        # RShift = A / 2**N
        my $rshift = bn($s{'RShift'});
        my $a = bn($s{'A'});
        my $n = bn($s{'N'});
        return if $rshift == $a->brsft($n);
    } elsif ( defined $s{'Square'} ) {
        # Square = A * A
        my $square = bn($s{'Square'});
        my $a = bn($s{'A'});
        return if $square == $a->bmul($a);
    } elsif ( defined $s{'Product'} ) {
        # Product = A * B
        my $product = bn($s{'Product'});
        my $a = bn($s{'A'});
        my $b = bn($s{'B'});
        return if $product == $a->bmul($b);
    } elsif ( defined $s{'Quotient'} ) {
        # Quotient = A / B
        # Remainder = A - B * Quotient
        my $quotient = bn($s{'Quotient'});
        my $remainder = bn($s{'Remainder'});
        my $a = bn($s{'A'});
        my $b = bn($s{'B'});

        # First the remainder test.
        $b->bmul($quotient);
        my $rempassed = $remainder == $a->bsub($b) ? 1 : 0;

        # Math::BigInt->bdiv() is documented to do floored division,
        # i.e. 1 / -4 = -1, while OpenSSL BN_div does truncated
        # division, i.e. 1 / -4 = 0.  We need to make the operation
        # work like OpenSSL's BN_div to be able to verify.
        $a = bn($s{'A'});
        $b = bn($s{'B'});
        my $neg = $a->is_neg() ? !$b->is_neg() : $b->is_neg();
        $a->babs();
        $b->babs();
        $a->bdiv($b);
        $a->bneg() if $neg;
        return if $rempassed && $quotient == $a;
    } elsif ( defined $s{'ModMul'} ) {
        # ModMul = (A * B) mod M
        my $modmul = bn($s{'ModMul'});
        my $a = bn($s{'A'});
        my $b = bn($s{'B'});
        my $m = bn($s{'M'});
        $a->bmul($b);
        return if $modmul == $a->bmod($m);
    } elsif ( defined $s{'ModExp'} ) {
        # ModExp = (A ** E) mod M
        my $modexp = bn($s{'ModExp'});
        my $a = bn($s{'A'});
        my $e = bn($s{'E'});
        my $m = bn($s{'M'});
        return if $modexp == $a->bmodpow($e, $m);
    } elsif ( defined $s{'Exp'} ) {
        my $exp = bn($s{'Exp'});
        my $a = bn($s{'A'});
        my $e = bn($s{'E'});
        return if $exp == $a ** $e;
    } elsif ( defined $s{'ModSqrt'} ) {
        # (ModSqrt * ModSqrt) mod P = A mod P
        my $modsqrt = bn($s{'ModSqrt'});
        my $a = bn($s{'A'});
        my $p = bn($s{'P'});
        $modsqrt->bmul($modsqrt);
        $modsqrt->bmod($p);
        $a->bmod($p);
        return if $modsqrt == $a;
    } else {
        print "# Unknown test: ";
    }
    $failures++;
    print "# #$failures Test (before line $lineno) failed\n";
    foreach ( keys %s ) {
        print "$_ = $s{$_}\n";
    }
    print "\n";
}

my $infile = shift || 'bntests.txt';
die "No such file, $infile" unless -f $infile;
open my $IN, $infile || die "Can't read $infile, $!\n";

my %stanza = ();
my $l = 0;
while ( <$IN> ) {
    $l++;
    s|\R$||;
    next if /^#/;
    if ( /^$/ ) {
        if ( keys %stanza ) {
            evaluate($l, %stanza);
            %stanza = ();
        }
        next;
    }
    # Parse 'key = value'
    if ( ! /\s*([^\s]*)\s*=\s*(.*)\s*/ ) {
        print "Skipping $_\n";
        next;
    }
    $stanza{$1} = $2;
};
evaluate($l, %stanza) if keys %stanza;
die "Got $failures, expected $EXPECTED_FAILURES"
    if $infile eq 'bntests.txt' and $failures != $EXPECTED_FAILURES;
close($IN)


#! /usr/bin/env perl
# Copyright 2008-2016 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

# Perl script to run tests against S/MIME examples in RFC4134
# Assumes RFC is in current directory and called "rfc4134.txt"

use MIME::Base64;

my $badttest = 0;
my $verbose  = 1;

my $cmscmd;
my $exdir  = "./";
my $exfile = "./rfc4134.txt";

if (-f "../apps/openssl")
	{
	$cmscmd = "../util/shlib_wrap.sh ../apps/openssl cms";
	}
elsif (-f "..\\out32dll\\openssl.exe")
	{
	$cmscmd = "..\\out32dll\\openssl.exe cms";
	}
elsif (-f "..\\out32\\openssl.exe")
	{
	$cmscmd = "..\\out32\\openssl.exe cms";
	}

my @test_list = (
    [ "3.1.bin"  => "dataout" ],
    [ "3.2.bin"  => "encode, dataout" ],
    [ "4.1.bin"  => "encode, verifyder, cont, dss" ],
    [ "4.2.bin"  => "encode, verifyder, cont, rsa" ],
    [ "4.3.bin"  => "encode, verifyder, cont_extern, dss" ],
    [ "4.4.bin"  => "encode, verifyder, cont, dss" ],
    [ "4.5.bin"  => "verifyder, cont, rsa" ],
    [ "4.6.bin"  => "encode, verifyder, cont, dss" ],
    [ "4.7.bin"  => "encode, verifyder, cont, dss" ],
    [ "4.8.eml"  => "verifymime, dss" ],
    [ "4.9.eml"  => "verifymime, dss" ],
    [ "4.10.bin" => "encode, verifyder, cont, dss" ],
    [ "4.11.bin" => "encode, certsout" ],
    [ "5.1.bin"  => "encode, envelopeder, cont" ],
    [ "5.2.bin"  => "encode, envelopeder, cont" ],
    [ "5.3.eml"  => "envelopemime, cont" ],
    [ "6.0.bin"  => "encode, digest, cont" ],
    [ "7.1.bin"  => "encode, encrypted, cont" ],
    [ "7.2.bin"  => "encode, encrypted, cont" ]
);

# Extract examples from RFC4134 text.
# Base64 decode all examples, certificates and
# private keys are converted to PEM format.

my ( $filename, $data );

my @cleanup = ( "cms.out", "cms.err", "tmp.der", "tmp.txt" );

$data = "";

open( IN, $exfile ) || die "Can't Open RFC examples file $exfile";

while (<IN>) {
    next unless (/^\|/);
    s/^\|//;
    next if (/^\*/);
    if (/^>(.*)$/) {
        $filename = $1;
        next;
    }
    if (/^</) {
        $filename = "$exdir/$filename";
        if ( $filename =~ /\.bin$/ || $filename =~ /\.eml$/ ) {
            $data = decode_base64($data);
            open OUT, ">$filename";
            binmode OUT;
            print OUT $data;
            close OUT;
            push @cleanup, $filename;
        }
        elsif ( $filename =~ /\.cer$/ ) {
            write_pem( $filename, "CERTIFICATE", $data );
        }
        elsif ( $filename =~ /\.pri$/ ) {
            write_pem( $filename, "PRIVATE KEY", $data );
        }
        $data     = "";
        $filename = "";
    }
    else {
        $data .= $_;
    }

}

my $secretkey =
  "73:7c:79:1f:25:ea:d0:e0:46:29:25:43:52:f7:dc:62:91:e5:cb:26:91:7a:da:32";

foreach (@test_list) {
    my ( $file, $tlist ) = @$_;
    print "Example file $file:\n";
    if ( $tlist =~ /encode/ ) {
        run_reencode_test( $exdir, $file );
    }
    if ( $tlist =~ /certsout/ ) {
        run_certsout_test( $exdir, $file );
    }
    if ( $tlist =~ /dataout/ ) {
        run_dataout_test( $exdir, $file );
    }
    if ( $tlist =~ /verify/ ) {
        run_verify_test( $exdir, $tlist, $file );
    }
    if ( $tlist =~ /digest/ ) {
        run_digest_test( $exdir, $tlist, $file );
    }
    if ( $tlist =~ /encrypted/ ) {
        run_encrypted_test( $exdir, $tlist, $file, $secretkey );
    }
    if ( $tlist =~ /envelope/ ) {
        run_envelope_test( $exdir, $tlist, $file );
    }

}

foreach (@cleanup) {
    unlink $_;
}

if ($badtest) {
    print "\n$badtest TESTS FAILED!!\n";
}
else {
    print "\n***All tests successful***\n";
}

sub write_pem {
    my ( $filename, $str, $data ) = @_;

    $filename =~ s/\.[^.]*$/.pem/;

    push @cleanup, $filename;

    open OUT, ">$filename";

    print OUT "-----BEGIN $str-----\n";
    print OUT $data;
    print OUT "-----END $str-----\n";

    close OUT;
}

sub run_reencode_test {
    my ( $cmsdir, $tfile ) = @_;
    unlink "tmp.der";

    system( "$cmscmd -cmsout -inform DER -outform DER"
          . " -in $cmsdir/$tfile -out tmp.der" );

    if ($?) {
        print "\tReencode command FAILED!!\n";
        $badtest++;
    }
    elsif ( !cmp_files( "$cmsdir/$tfile", "tmp.der" ) ) {
        print "\tReencode FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tReencode passed\n" if $verbose;
    }
}

sub run_certsout_test {
    my ( $cmsdir, $tfile ) = @_;
    unlink "tmp.der";
    unlink "tmp.pem";

    system( "$cmscmd -cmsout -inform DER -certsout tmp.pem"
          . " -in $cmsdir/$tfile -out tmp.der" );

    if ($?) {
        print "\tCertificate output command FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tCertificate output passed\n" if $verbose;
    }
}

sub run_dataout_test {
    my ( $cmsdir, $tfile ) = @_;
    unlink "tmp.txt";

    system(
        "$cmscmd -data_out -inform DER" . " -in $cmsdir/$tfile -out tmp.txt" );

    if ($?) {
        print "\tDataout command FAILED!!\n";
        $badtest++;
    }
    elsif ( !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) {
        print "\tDataout compare FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tDataout passed\n" if $verbose;
    }
}

sub run_verify_test {
    my ( $cmsdir, $tlist, $tfile ) = @_;
    unlink "tmp.txt";

    $form   = "DER"                     if $tlist =~ /verifyder/;
    $form   = "SMIME"                   if $tlist =~ /verifymime/;
    $cafile = "$cmsdir/CarlDSSSelf.pem" if $tlist =~ /dss/;
    $cafile = "$cmsdir/CarlRSASelf.pem" if $tlist =~ /rsa/;

    $cmd =
        "$cmscmd -verify -inform $form"
      . " -CAfile $cafile"
      . " -in $cmsdir/$tfile -out tmp.txt";

    $cmd .= " -content $cmsdir/ExContent.bin" if $tlist =~ /cont_extern/;

    system("$cmd 2>cms.err 1>cms.out");

    if ($?) {
        print "\tVerify command FAILED!!\n";
        $badtest++;
    }
    elsif ( $tlist =~ /cont/
        && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) )
    {
        print "\tVerify content compare FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tVerify passed\n" if $verbose;
    }
}

sub run_envelope_test {
    my ( $cmsdir, $tlist, $tfile ) = @_;
    unlink "tmp.txt";

    $form = "DER"   if $tlist =~ /envelopeder/;
    $form = "SMIME" if $tlist =~ /envelopemime/;

    $cmd =
        "$cmscmd -decrypt -inform $form"
      . " -recip $cmsdir/BobRSASignByCarl.pem"
      . " -inkey $cmsdir/BobPrivRSAEncrypt.pem"
      . " -in $cmsdir/$tfile -out tmp.txt";

    system("$cmd 2>cms.err 1>cms.out");

    if ($?) {
        print "\tDecrypt command FAILED!!\n";
        $badtest++;
    }
    elsif ( $tlist =~ /cont/
        && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) )
    {
        print "\tDecrypt content compare FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tDecrypt passed\n" if $verbose;
    }
}

sub run_digest_test {
    my ( $cmsdir, $tlist, $tfile ) = @_;
    unlink "tmp.txt";

    my $cmd =
      "$cmscmd -digest_verify -inform DER" . " -in $cmsdir/$tfile -out tmp.txt";

    system("$cmd 2>cms.err 1>cms.out");

    if ($?) {
        print "\tDigest verify command FAILED!!\n";
        $badtest++;
    }
    elsif ( $tlist =~ /cont/
        && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) )
    {
        print "\tDigest verify content compare FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tDigest verify passed\n" if $verbose;
    }
}

sub run_encrypted_test {
    my ( $cmsdir, $tlist, $tfile, $key ) = @_;
    unlink "tmp.txt";

    system( "$cmscmd -EncryptedData_decrypt -inform DER"
          . " -secretkey $key"
          . " -in $cmsdir/$tfile -out tmp.txt" );

    if ($?) {
        print "\tEncrypted Data command FAILED!!\n";
        $badtest++;
    }
    elsif ( $tlist =~ /cont/
        && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) )
    {
        print "\tEncrypted Data content compare FAILED!!\n";
        $badtest++;
    }
    else {
        print "\tEncryptedData verify passed\n" if $verbose;
    }
}

sub cmp_files {
    my ( $f1, $f2 ) = @_;
    my ( $fp1, $fp2 );

    my ( $rd1, $rd2 );

    if ( !open( $fp1, "<$f1" ) ) {
        print STDERR "Can't Open file $f1\n";
        return 0;
    }

    if ( !open( $fp2, "<$f2" ) ) {
        print STDERR "Can't Open file $f2\n";
        return 0;
    }

    binmode $fp1;
    binmode $fp2;

    my $ret = 0;

    for ( ; ; ) {
        $n1 = sysread $fp1, $rd1, 4096;
        $n2 = sysread $fp2, $rd2, 4096;
        last if ( $n1 != $n2 );
        last if ( $rd1 ne $rd2 );

        if ( $n1 == 0 ) {
            $ret = 1;
            last;
        }

    }

    close $fp1;
    close $fp2;

    return $ret;

}


#! /usr/bin/env perl
# Copyright 2016-2018 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

use strict;
use warnings;

# First argument is name;
my $name = shift @ARGV;
my $name_uc = uc $name;
# All other arguments are ignored for now

print <<"_____";
/*
 * Generated with test/generate_buildtest.pl, to check that such a simple
 * program builds.
 */
#include <openssl/opensslconf.h>
#ifndef OPENSSL_NO_STDIO
# include <stdio.h>
#endif
#ifndef OPENSSL_NO_${name_uc}
# include <openssl/$name.h>
#endif

int main(void)
{
    return 0;
}
_____


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

## SSL testcase generator

use strict;
use warnings;

use File::Basename;
use File::Spec::Functions;

use OpenSSL::Test qw/srctop_dir srctop_file/;
use OpenSSL::Test::Utils;

# This block needs to run before 'use lib srctop_dir' directives.
BEGIN {
    OpenSSL::Test::setup("no_test_here");
}

use lib srctop_dir("util", "perl");  # for with_fallback
use lib srctop_dir("test", "ssl-tests");  # for ssltests_base

use with_fallback qw(Text::Template);

use vars qw/@ISA/;
push (@ISA, qw/Text::Template/);

use ssltests_base;

sub print_templates {
    my $source = srctop_file("test", "ssl_test.tmpl");
    my $template = Text::Template->new(TYPE => 'FILE', SOURCE => $source);

    print "# Generated with generate_ssl_tests.pl\n\n";

    my $num = scalar @ssltests::tests;

    # Add the implicit base configuration.
    foreach my $test (@ssltests::tests) {
        $test->{"server"} = { (%ssltests::base_server, %{$test->{"server"}}) };
        if (defined $test->{"server2"}) {
            $test->{"server2"} = { (%ssltests::base_server, %{$test->{"server2"}}) };
        } else {
            if ($test->{"server"}->{"extra"} &&
                defined $test->{"server"}->{"extra"}->{"ServerNameCallback"}) {
                # Default is the same as server.
                $test->{"reuse_server2"} = 1;
            }
            # Do not emit an empty/duplicate "server2" section.
            $test->{"server2"} = { };
        }
        if (defined $test->{"resume_server"}) {
            $test->{"resume_server"} = { (%ssltests::base_server, %{$test->{"resume_server"}}) };
        } else {
            if (defined $test->{"test"}->{"HandshakeMode"} &&
                 $test->{"test"}->{"HandshakeMode"} eq "Resume") {
                # Default is the same as server.
                $test->{"reuse_resume_server"} = 1;
            }
            # Do not emit an empty/duplicate "resume-server" section.
            $test->{"resume_server"} = { };
        }
        $test->{"client"} = { (%ssltests::base_client, %{$test->{"client"}}) };
        if (defined $test->{"resume_client"}) {
            $test->{"resume_client"} = { (%ssltests::base_client, %{$test->{"resume_client"}}) };
        } else {
            if (defined $test->{"test"}->{"HandshakeMode"} &&
                 $test->{"test"}->{"HandshakeMode"} eq "Resume") {
                # Default is the same as client.
                $test->{"reuse_resume_client"} = 1;
            }
            # Do not emit an empty/duplicate "resume-client" section.
            $test->{"resume_client"} = { };
        }
    }

    # ssl_test expects to find a
    #
    # num_tests = n
    #
    # directive in the file. It'll then look for configuration directives
    # for n tests, that each look like this:
    #
    # test-n = test-section
    #
    # [test-section]
    # (SSL modules for client and server configuration go here.)
    #
    # [test-n]
    # (Test configuration goes here.)
    print "num_tests = $num\n\n";

    # The conf module locations must come before everything else, because
    # they look like
    #
    # test-n = test-section
    #
    # and you can't mix and match them with sections.
    my $idx = 0;

    foreach my $test (@ssltests::tests) {
        my $testname = "${idx}-" . $test->{'name'};
        print "test-$idx = $testname\n";
        $idx++;
    }

    $idx = 0;

    foreach my $test (@ssltests::tests) {
        my $testname = "${idx}-" . $test->{'name'};
        my $text = $template->fill_in(
            HASH => [{ idx => $idx, testname => $testname } , $test],
            DELIMITERS => [ "{-", "-}" ]);
        print "# ===========================================================\n\n";
        print "$text\n";
        $idx++;
    }
}

# Shamelessly copied from Configure.
sub read_config {
    my $fname = shift;
    open(INPUT, "< $fname") or die "Can't open input file '$fname'!\n";
    local $/ = undef;
    my $content = <INPUT>;
    close(INPUT);
    eval $content;
    warn $@ if $@;
}

my $input_file = shift;
# Reads the tests into ssltests::tests.
read_config($input_file);
print_templates();

1;