#! /usr/bin/env perl
# Copyright 2011-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/.
# ====================================================================
#
# May 2011
#
# The module implements bn_GF2m_mul_2x2 polynomial multiplication used
# in bn_gf2m.c. It's kind of low-hanging mechanical port from C for
# the time being... gcc 4.3 appeared to generate poor code, therefore
# the effort. And indeed, the module delivers 55%-90%(*) improvement
# on heaviest ECDSA verify and ECDH benchmarks for 163- and 571-bit
# key lengths on z990, 30%-55%(*) - on z10, and 70%-110%(*) - on z196.
# This is for 64-bit build. In 32-bit "highgprs" case improvement is
# even higher, for example on z990 it was measured 80%-150%. ECDSA
# sign is modest 9%-12% faster. Keep in mind that these coefficients
# are not ones for bn_GF2m_mul_2x2 itself, as not all CPU time is
# burnt in it...
#
# (*)	gcc 4.1 was observed to deliver better results than gcc 4.3,
#	so that improvement coefficients can vary from one specific
#	setup to another.

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

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

$rp="%r2";
$a1="%r3";
$a0="%r4";
$b1="%r5";
$b0="%r6";

$ra="%r14";
$sp="%r15";

@T=("%r0","%r1");
@i=("%r12","%r13");

($a1,$a2,$a4,$a8,$a12,$a48)=map("%r$_",(6..11));
($lo,$hi,$b)=map("%r$_",(3..5)); $a=$lo; $mask=$a8;

$code.=<<___;
.text

.type	_mul_1x1,\@function
.align	16
_mul_1x1:
	lgr	$a1,$a
	sllg	$a2,$a,1
	sllg	$a4,$a,2
	sllg	$a8,$a,3

	srag	$lo,$a1,63			# broadcast 63rd bit
	nihh	$a1,0x1fff
	srag	@i[0],$a2,63			# broadcast 62nd bit
	nihh	$a2,0x3fff
	srag	@i[1],$a4,63			# broadcast 61st bit
	nihh	$a4,0x7fff
	ngr	$lo,$b
	ngr	@i[0],$b
	ngr	@i[1],$b

	lghi	@T[0],0
	lgr	$a12,$a1
	stg	@T[0],`$stdframe+0*8`($sp)	# tab[0]=0
	xgr	$a12,$a2
	stg	$a1,`$stdframe+1*8`($sp)	# tab[1]=a1
	 lgr	$a48,$a4
	stg	$a2,`$stdframe+2*8`($sp)	# tab[2]=a2
	 xgr	$a48,$a8
	stg	$a12,`$stdframe+3*8`($sp)	# tab[3]=a1^a2
	 xgr	$a1,$a4

	stg	$a4,`$stdframe+4*8`($sp)	# tab[4]=a4
	xgr	$a2,$a4
	stg	$a1,`$stdframe+5*8`($sp)	# tab[5]=a1^a4
	xgr	$a12,$a4
	stg	$a2,`$stdframe+6*8`($sp)	# tab[6]=a2^a4
	 xgr	$a1,$a48
	stg	$a12,`$stdframe+7*8`($sp)	# tab[7]=a1^a2^a4
	 xgr	$a2,$a48

	stg	$a8,`$stdframe+8*8`($sp)	# tab[8]=a8
	xgr	$a12,$a48
	stg	$a1,`$stdframe+9*8`($sp)	# tab[9]=a1^a8
	 xgr	$a1,$a4
	stg	$a2,`$stdframe+10*8`($sp)	# tab[10]=a2^a8
	 xgr	$a2,$a4
	stg	$a12,`$stdframe+11*8`($sp)	# tab[11]=a1^a2^a8

	xgr	$a12,$a4
	stg	$a48,`$stdframe+12*8`($sp)	# tab[12]=a4^a8
	 srlg	$hi,$lo,1
	stg	$a1,`$stdframe+13*8`($sp)	# tab[13]=a1^a4^a8
	 sllg	$lo,$lo,63
	stg	$a2,`$stdframe+14*8`($sp)	# tab[14]=a2^a4^a8
	 srlg	@T[0],@i[0],2
	stg	$a12,`$stdframe+15*8`($sp)	# tab[15]=a1^a2^a4^a8

	lghi	$mask,`0xf<<3`
	sllg	$a1,@i[0],62
	 sllg	@i[0],$b,3
	srlg	@T[1],@i[1],3
	 ngr	@i[0],$mask
	sllg	$a2,@i[1],61
	 srlg	@i[1],$b,4-3
	xgr	$hi,@T[0]
	 ngr	@i[1],$mask
	xgr	$lo,$a1
	xgr	$hi,@T[1]
	xgr	$lo,$a2

	xg	$lo,$stdframe(@i[0],$sp)
	srlg	@i[0],$b,8-3
	ngr	@i[0],$mask
___
for($n=1;$n<14;$n++) {
$code.=<<___;
	lg	@T[1],$stdframe(@i[1],$sp)
	srlg	@i[1],$b,`($n+2)*4`-3
	sllg	@T[0],@T[1],`$n*4`
	ngr	@i[1],$mask
	srlg	@T[1],@T[1],`64-$n*4`
	xgr	$lo,@T[0]
	xgr	$hi,@T[1]
___
	push(@i,shift(@i)); push(@T,shift(@T));
}
$code.=<<___;
	lg	@T[1],$stdframe(@i[1],$sp)
	sllg	@T[0],@T[1],`$n*4`
	srlg	@T[1],@T[1],`64-$n*4`
	xgr	$lo,@T[0]
	xgr	$hi,@T[1]

	lg	@T[0],$stdframe(@i[0],$sp)
	sllg	@T[1],@T[0],`($n+1)*4`
	srlg	@T[0],@T[0],`64-($n+1)*4`
	xgr	$lo,@T[1]
	xgr	$hi,@T[0]

	br	$ra
.size	_mul_1x1,.-_mul_1x1

.globl	bn_GF2m_mul_2x2
.type	bn_GF2m_mul_2x2,\@function
.align	16
bn_GF2m_mul_2x2:
	stm${g}	%r3,%r15,3*$SIZE_T($sp)

	lghi	%r1,-$stdframe-128
	la	%r0,0($sp)
	la	$sp,0(%r1,$sp)			# alloca
	st${g}	%r0,0($sp)			# back chain
___
if ($SIZE_T==8) {
my @r=map("%r$_",(6..9));
$code.=<<___;
	bras	$ra,_mul_1x1			# a1Â·b1
	stmg	$lo,$hi,16($rp)

	lg	$a,`$stdframe+128+4*$SIZE_T`($sp)
	lg	$b,`$stdframe+128+6*$SIZE_T`($sp)
	bras	$ra,_mul_1x1			# a0Â·b0
	stmg	$lo,$hi,0($rp)

	lg	$a,`$stdframe+128+3*$SIZE_T`($sp)
	lg	$b,`$stdframe+128+5*$SIZE_T`($sp)
	xg	$a,`$stdframe+128+4*$SIZE_T`($sp)
	xg	$b,`$stdframe+128+6*$SIZE_T`($sp)
	bras	$ra,_mul_1x1			# (a0+a1)Â·(b0+b1)
	lmg	@r[0],@r[3],0($rp)

	xgr	$lo,$hi
	xgr	$hi,@r[1]
	xgr	$lo,@r[0]
	xgr	$hi,@r[2]
	xgr	$lo,@r[3]
	xgr	$hi,@r[3]
	xgr	$lo,$hi
	stg	$hi,16($rp)
	stg	$lo,8($rp)
___
} else {
$code.=<<___;
	sllg	%r3,%r3,32
	sllg	%r5,%r5,32
	or	%r3,%r4
	or	%r5,%r6
	bras	$ra,_mul_1x1
	rllg	$lo,$lo,32
	rllg	$hi,$hi,32
	stmg	$lo,$hi,0($rp)
___
}
$code.=<<___;
	lm${g}	%r6,%r15,`$stdframe+128+6*$SIZE_T`($sp)
	br	$ra
.size	bn_GF2m_mul_2x2,.-bn_GF2m_mul_2x2
.string	"GF(2^m) Multiplication 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/.
# ====================================================================

# April 2007.
#
# Performance improvement over vanilla C code varies from 85% to 45%
# depending on key length and benchmark. Unfortunately in this context
# these are not very impressive results [for code that utilizes "wide"
# 64x64=128-bit multiplication, which is not commonly available to C
# programmers], at least hand-coded bn_asm.c replacement is known to
# provide 30-40% better results for longest keys. Well, on a second
# thought it's not very surprising, because z-CPUs are single-issue
# and _strictly_ in-order execution, while bn_mul_mont is more or less
# dependent on CPU ability to pipe-line instructions and have several
# of them "in-flight" at the same time. I mean while other methods,
# for example Karatsuba, aim to minimize amount of multiplications at
# the cost of other operations increase, bn_mul_mont aim to neatly
# "overlap" multiplications and the other operations [and on most
# platforms even minimize the amount of the other operations, in
# particular references to memory]. But it's possible to improve this
# module performance by implementing dedicated squaring code-path and
# possibly by unrolling loops...

# January 2009.
#
# Reschedule to minimize/avoid Address Generation Interlock hazard,
# make inner loops counter-based.

# 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. Compatibility with 32-bit BN_ULONG
# is achieved by swapping words after 64-bit loads, follow _dswap-s.
# On z990 it was measured to perform 2.6-2.2 times better than
# compiler-generated code, less for longer keys...

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

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

$mn0="%r0";
$num="%r1";

# int bn_mul_mont(
$rp="%r2";		# BN_ULONG *rp,
$ap="%r3";		# const BN_ULONG *ap,
$bp="%r4";		# const BN_ULONG *bp,
$np="%r5";		# const BN_ULONG *np,
$n0="%r6";		# const BN_ULONG *n0,
#$num="160(%r15)"	# int num);

$bi="%r2";	# zaps rp
$j="%r7";

$ahi="%r8";
$alo="%r9";
$nhi="%r10";
$nlo="%r11";
$AHI="%r12";
$NHI="%r13";
$count="%r14";
$sp="%r15";

$code.=<<___;
.text
.globl	bn_mul_mont
.type	bn_mul_mont,\@function
bn_mul_mont:
	lgf	$num,`$stdframe+$SIZE_T-4`($sp)	# pull $num
	sla	$num,`log($SIZE_T)/log(2)`	# $num to enumerate bytes
	la	$bp,0($num,$bp)

	st${g}	%r2,2*$SIZE_T($sp)

	cghi	$num,16		#
	lghi	%r2,0		#
	blr	%r14		# if($num<16) return 0;
___
$code.=<<___ if ($flavour =~ /3[12]/);
	tmll	$num,4
	bnzr	%r14		# if ($num&1) return 0;
___
$code.=<<___ if ($flavour !~ /3[12]/);
	cghi	$num,96		#
	bhr	%r14		# if($num>96) return 0;
___
$code.=<<___;
	stm${g}	%r3,%r15,3*$SIZE_T($sp)

	lghi	$rp,-$stdframe-8	# leave room for carry bit
	lcgr	$j,$num		# -$num
	lgr	%r0,$sp
	la	$rp,0($rp,$sp)
	la	$sp,0($j,$rp)	# alloca
	st${g}	%r0,0($sp)	# back chain

	sra	$num,3		# restore $num
	la	$bp,0($j,$bp)	# restore $bp
	ahi	$num,-1		# adjust $num for inner loop
	lg	$n0,0($n0)	# pull n0
	_dswap	$n0

	lg	$bi,0($bp)
	_dswap	$bi
	lg	$alo,0($ap)
	_dswap	$alo
	mlgr	$ahi,$bi	# ap[0]*bp[0]
	lgr	$AHI,$ahi

	lgr	$mn0,$alo	# "tp[0]"*n0
	msgr	$mn0,$n0

	lg	$nlo,0($np)	#
	_dswap	$nlo
	mlgr	$nhi,$mn0	# np[0]*m1
	algr	$nlo,$alo	# +="tp[0]"
	lghi	$NHI,0
	alcgr	$NHI,$nhi

	la	$j,8		# j=1
	lr	$count,$num

.align	16
.L1st:
	lg	$alo,0($j,$ap)
	_dswap	$alo
	mlgr	$ahi,$bi	# ap[j]*bp[0]
	algr	$alo,$AHI
	lghi	$AHI,0
	alcgr	$AHI,$ahi

	lg	$nlo,0($j,$np)
	_dswap	$nlo
	mlgr	$nhi,$mn0	# np[j]*m1
	algr	$nlo,$NHI
	lghi	$NHI,0
	alcgr	$nhi,$NHI	# +="tp[j]"
	algr	$nlo,$alo
	alcgr	$NHI,$nhi

	stg	$nlo,$stdframe-8($j,$sp)	# tp[j-1]=
	la	$j,8($j)	# j++
	brct	$count,.L1st

	algr	$NHI,$AHI
	lghi	$AHI,0
	alcgr	$AHI,$AHI	# upmost overflow bit
	stg	$NHI,$stdframe-8($j,$sp)
	stg	$AHI,$stdframe($j,$sp)
	la	$bp,8($bp)	# bp++

.Louter:
	lg	$bi,0($bp)	# bp[i]
	_dswap	$bi
	lg	$alo,0($ap)
	_dswap	$alo
	mlgr	$ahi,$bi	# ap[0]*bp[i]
	alg	$alo,$stdframe($sp)	# +=tp[0]
	lghi	$AHI,0
	alcgr	$AHI,$ahi

	lgr	$mn0,$alo
	msgr	$mn0,$n0	# tp[0]*n0

	lg	$nlo,0($np)	# np[0]
	_dswap	$nlo
	mlgr	$nhi,$mn0	# np[0]*m1
	algr	$nlo,$alo	# +="tp[0]"
	lghi	$NHI,0
	alcgr	$NHI,$nhi

	la	$j,8		# j=1
	lr	$count,$num

.align	16
.Linner:
	lg	$alo,0($j,$ap)
	_dswap	$alo
	mlgr	$ahi,$bi	# ap[j]*bp[i]
	algr	$alo,$AHI
	lghi	$AHI,0
	alcgr	$ahi,$AHI
	alg	$alo,$stdframe($j,$sp)# +=tp[j]
	alcgr	$AHI,$ahi

	lg	$nlo,0($j,$np)
	_dswap	$nlo
	mlgr	$nhi,$mn0	# np[j]*m1
	algr	$nlo,$NHI
	lghi	$NHI,0
	alcgr	$nhi,$NHI
	algr	$nlo,$alo	# +="tp[j]"
	alcgr	$NHI,$nhi

	stg	$nlo,$stdframe-8($j,$sp)	# tp[j-1]=
	la	$j,8($j)	# j++
	brct	$count,.Linner

	algr	$NHI,$AHI
	lghi	$AHI,0
	alcgr	$AHI,$AHI
	alg	$NHI,$stdframe($j,$sp)# accumulate previous upmost overflow bit
	lghi	$ahi,0
	alcgr	$AHI,$ahi	# new upmost overflow bit
	stg	$NHI,$stdframe-8($j,$sp)
	stg	$AHI,$stdframe($j,$sp)

	la	$bp,8($bp)	# bp++
	cl${g}	$bp,`$stdframe+8+4*$SIZE_T`($j,$sp)	# compare to &bp[num]
	jne	.Louter

	l${g}	$rp,`$stdframe+8+2*$SIZE_T`($j,$sp)	# reincarnate rp
	la	$ap,$stdframe($sp)
	ahi	$num,1		# restore $num, incidentally clears "borrow"

	la	$j,0
	lr	$count,$num
.Lsub:	lg	$alo,0($j,$ap)
	lg	$nlo,0($j,$np)
	_dswap	$nlo
	slbgr	$alo,$nlo
	stg	$alo,0($j,$rp)
	la	$j,8($j)
	brct	$count,.Lsub
	lghi	$ahi,0
	slbgr	$AHI,$ahi	# handle upmost carry
	lghi	$NHI,-1
	xgr	$NHI,$AHI

	la	$j,0
	lgr	$count,$num
.Lcopy:	lg	$ahi,$stdframe($j,$sp)	# conditional copy
	lg	$alo,0($j,$rp)
	ngr	$ahi,$AHI
	ngr	$alo,$NHI
	ogr	$alo,$ahi
	_dswap	$alo
	stg	$j,$stdframe($j,$sp)	# zap tp
	stg	$alo,0($j,$rp)
	la	$j,8($j)
	brct	$count,.Lcopy

	la	%r1,`$stdframe+8+6*$SIZE_T`($j,$sp)
	lm${g}	%r6,%r15,0(%r1)
	lghi	%r2,1		# signal "processed"
	br	%r14
.size	bn_mul_mont,.-bn_mul_mont
.string	"Montgomery Multiplication for s390x, CRYPTOGAMS by <appro\@openssl.org>"
___

foreach (split("\n",$code)) {
	s/\`([^\`]*)\`/eval $1/ge;
	s/_dswap\s+(%r[0-9]+)/sprintf("rllg\t%s,%s,32",$1,$1) if($SIZE_T==4)/e;
	print $_,"\n";
}
close STDOUT or die "error closing STDOUT: $!";


#! /usr/bin/env perl
# Copyright 2012-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 David S. Miller and Andy Polyakov
# The module is licensed under 2-clause BSD license.
# November 2012. All rights reserved.
# ====================================================================

######################################################################
# Montgomery squaring-n-multiplication module for SPARC T4.
#
# The module consists of three parts:
#
# 1) collection of "single-op" subroutines that perform single
#    operation, Montgomery squaring or multiplication, on 512-,
#    1024-, 1536- and 2048-bit operands;
# 2) collection of "multi-op" subroutines that perform 5 squaring and
#    1 multiplication operations on operands of above lengths;
# 3) fall-back and helper VIS3 subroutines.
#
# RSA sign is dominated by multi-op subroutine, while RSA verify and
# DSA - by single-op. Special note about 4096-bit RSA verify result.
# Operands are too long for dedicated hardware and it's handled by
# VIS3 code, which is why you don't see any improvement. It's surely
# possible to improve it [by deploying 'mpmul' instruction], maybe in
# the future...
#
# Performance improvement.
#
# 64-bit process, VIS3:
#                   sign    verify    sign/s verify/s
# rsa 1024 bits 0.000628s 0.000028s   1592.4  35434.4
# rsa 2048 bits 0.003282s 0.000106s    304.7   9438.3
# rsa 4096 bits 0.025866s 0.000340s     38.7   2940.9
# dsa 1024 bits 0.000301s 0.000332s   3323.7   3013.9
# dsa 2048 bits 0.001056s 0.001233s    946.9    810.8
#
# 64-bit process, this module:
#                   sign    verify    sign/s verify/s
# rsa 1024 bits 0.000256s 0.000016s   3904.4  61411.9
# rsa 2048 bits 0.000946s 0.000029s   1056.8  34292.7
# rsa 4096 bits 0.005061s 0.000340s    197.6   2940.5
# dsa 1024 bits 0.000176s 0.000195s   5674.7   5130.5
# dsa 2048 bits 0.000296s 0.000354s   3383.2   2827.6
#
######################################################################
# 32-bit process, VIS3:
#                   sign    verify    sign/s verify/s
# rsa 1024 bits 0.000665s 0.000028s   1504.8  35233.3
# rsa 2048 bits 0.003349s 0.000106s    298.6   9433.4
# rsa 4096 bits 0.025959s 0.000341s     38.5   2934.8
# dsa 1024 bits 0.000320s 0.000341s   3123.3   2929.6
# dsa 2048 bits 0.001101s 0.001260s    908.2    793.4
#
# 32-bit process, this module:
#                   sign    verify    sign/s verify/s
# rsa 1024 bits 0.000301s 0.000017s   3317.1  60240.0
# rsa 2048 bits 0.001034s 0.000030s    966.9  33812.7
# rsa 4096 bits 0.005244s 0.000341s    190.7   2935.4
# dsa 1024 bits 0.000201s 0.000205s   4976.1   4879.2
# dsa 2048 bits 0.000328s 0.000360s   3051.1   2774.2
#
# 32-bit code is prone to performance degradation as interrupt rate
# dispatched to CPU executing the code grows. This is because in
# standard process of handling interrupt in 32-bit process context
# upper halves of most integer registers used as input or output are
# zeroed. This renders result invalid, and operation has to be re-run.
# If CPU is "bothered" with timer interrupts only, the penalty is
# hardly measurable. But in order to mitigate this problem for higher
# interrupt rates contemporary Linux kernel recognizes biased stack
# even in 32-bit process context and preserves full register contents.
# See http://git.kernel.org/cgit/linux/kernel/git/torvalds/linux.git/commit/?id=517ffce4e1a03aea979fe3a18a3dd1761a24fafb
# for details.

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

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

$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
___

########################################################################
# Register layout for mont[mul|sqr] instructions.
# For details see "Oracle SPARC Architecture 2011" manual at
# http://www.oracle.com/technetwork/server-storage/sun-sparc-enterprise/documentation/.
#
my @R=map("%f".2*$_,(0..11,30,31,12..29));
my @N=(map("%l$_",(0..7)),map("%o$_",(0..5))); @N=(@N,@N,@N[0..3]);
my @A=(@N[0..13],@R[14..31]);
my @B=(map("%i$_",(0..5)),map("%l$_",(0..7))); @B=(@B,@B,map("%o$_",(0..3)));

########################################################################
# int bn_mul_mont_t4_$NUM(u64 *rp,const u64 *ap,const u64 *bp,
#			  const u64 *np,const BN_ULONG *n0);
#
sub generate_bn_mul_mont_t4() {
my $NUM=shift;
my ($rp,$ap,$bp,$np,$sentinel)=map("%g$_",(1..5));

$code.=<<___;
.globl	bn_mul_mont_t4_$NUM
.align	32
bn_mul_mont_t4_$NUM:
#ifdef	__arch64__
	mov	0,$sentinel
	mov	-128,%g4
#elif defined(SPARCV9_64BIT_STACK)
	SPARC_LOAD_ADDRESS_LEAF(OPENSSL_sparcv9cap_P,%g1,%g5)
	ld	[%g1+0],%g1	! OPENSSL_sparcv9_P[0]
	mov	-2047,%g4
	and	%g1,SPARCV9_64BIT_STACK,%g1
	movrz	%g1,0,%g4
	mov	-1,$sentinel
	add	%g4,-128,%g4
#else
	mov	-1,$sentinel
	mov	-128,%g4
#endif
	sllx	$sentinel,32,$sentinel
	save	%sp,%g4,%sp
#ifndef	__arch64__
	save	%sp,-128,%sp	! warm it up
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	restore
	restore
	restore
	restore
	restore
	restore
#endif
	and	%sp,1,%g4
	or	$sentinel,%fp,%fp
	or	%g4,$sentinel,$sentinel

	! copy arguments to global registers
	mov	%i0,$rp
	mov	%i1,$ap
	mov	%i2,$bp
	mov	%i3,$np
	ld	[%i4+0],%f1	! load *n0
	ld	[%i4+4],%f0
	fsrc2	%f0,%f60
___

# load ap[$NUM] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for($i=0; $i<14 && $i<$NUM; $i++) {
my $lo=$i<13?@A[$i+1]:"%o7";
$code.=<<___;
	ld	[$ap+$i*8+0],$lo
	ld	[$ap+$i*8+4],@A[$i]
	sllx	@A[$i],32,@A[$i]
	or	$lo,@A[$i],@A[$i]
___
}
for(; $i<$NUM; $i++) {
my ($hi,$lo)=("%f".2*($i%4),"%f".(2*($i%4)+1));
$code.=<<___;
	ld	[$ap+$i*8+0],$lo
	ld	[$ap+$i*8+4],$hi
	fsrc2	$hi,@A[$i]
___
}
# load np[$NUM] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for($i=0; $i<14 && $i<$NUM; $i++) {
my $lo=$i<13?@N[$i+1]:"%o7";
$code.=<<___;
	ld	[$np+$i*8+0],$lo
	ld	[$np+$i*8+4],@N[$i]
	sllx	@N[$i],32,@N[$i]
	or	$lo,@N[$i],@N[$i]
___
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<28 && $i<$NUM; $i++) {
my $lo=$i<27?@N[$i+1]:"%o7";
$code.=<<___;
	ld	[$np+$i*8+0],$lo
	ld	[$np+$i*8+4],@N[$i]
	sllx	@N[$i],32,@N[$i]
	or	$lo,@N[$i],@N[$i]
___
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<$NUM; $i++) {
my $lo=($i<$NUM-1)?@N[$i+1]:"%o7";
$code.=<<___;
	ld	[$np+$i*8+0],$lo
	ld	[$np+$i*8+4],@N[$i]
	sllx	@N[$i],32,@N[$i]
	or	$lo,@N[$i],@N[$i]
___
}
$code.=<<___;
	cmp	$ap,$bp
	be	SIZE_T_CC,.Lmsquare_$NUM
	nop
___

# load bp[$NUM] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for($i=0; $i<14 && $i<$NUM; $i++) {
my $lo=$i<13?@B[$i+1]:"%o7";
$code.=<<___;
	ld	[$bp+$i*8+0],$lo
	ld	[$bp+$i*8+4],@B[$i]
	sllx	@B[$i],32,@B[$i]
	or	$lo,@B[$i],@B[$i]
___
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<$NUM; $i++) {
my $lo=($i<$NUM-1)?@B[$i+1]:"%o7";
$code.=<<___;
	ld	[$bp+$i*8+0],$lo
	ld	[$bp+$i*8+4],@B[$i]
	sllx	@B[$i],32,@B[$i]
	or	$lo,@B[$i],@B[$i]
___
}
# magic ################################################################
$code.=<<___;
	.word	0x81b02920+$NUM-1	! montmul	$NUM-1
.Lmresume_$NUM:
	fbu,pn	%fcc3,.Lmabort_$NUM
#ifndef	__arch64__
	and	%fp,$sentinel,$sentinel
	brz,pn	$sentinel,.Lmabort_$NUM
#endif
	nop
#ifdef	__arch64__
	restore
	restore
	restore
	restore
	restore
#else
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	 brz,pn	$sentinel,.Lmabort1_$NUM
	restore
#endif
___

# save tp[$NUM] ########################################################
for($i=0; $i<14 && $i<$NUM; $i++) {
$code.=<<___;
	movxtod	@A[$i],@R[$i]
___
}
$code.=<<___;
#ifdef	__arch64__
	restore
#else
	 and	%fp,$sentinel,$sentinel
	restore
	 and	$sentinel,1,%o7
	 and	%fp,$sentinel,$sentinel
	 srl	%fp,0,%fp		! just in case?
	 or	%o7,$sentinel,$sentinel
	brz,a,pn $sentinel,.Lmdone_$NUM
	mov	0,%i0		! return failure
#endif
___
for($i=0; $i<12 && $i<$NUM; $i++) {
@R[$i] =~ /%f([0-9]+)/;
my $lo = "%f".($1+1);
$code.=<<___;
	st	$lo,[$rp+$i*8+0]
	st	@R[$i],[$rp+$i*8+4]
___
}
for(; $i<$NUM; $i++) {
my ($hi,$lo)=("%f".2*($i%4),"%f".(2*($i%4)+1));
$code.=<<___;
	fsrc2	@R[$i],$hi
	st	$lo,[$rp+$i*8+0]
	st	$hi,[$rp+$i*8+4]
___
}
$code.=<<___;
	mov	1,%i0		! return success
.Lmdone_$NUM:
	ret
	restore

.Lmabort_$NUM:
	restore
	restore
	restore
	restore
	restore
.Lmabort1_$NUM:
	restore

	mov	0,%i0		! return failure
	ret
	restore

.align	32
.Lmsquare_$NUM:
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
	.word   0x81b02940+$NUM-1	! montsqr	$NUM-1
	ba	.Lmresume_$NUM
	nop
.type	bn_mul_mont_t4_$NUM, #function
.size	bn_mul_mont_t4_$NUM, .-bn_mul_mont_t4_$NUM
___
}

for ($i=8;$i<=32;$i+=8) {
	&generate_bn_mul_mont_t4($i);
}

########################################################################
#
sub load_ccr {
my ($ptbl,$pwr,$ccr,$skip_wr)=@_;
$code.=<<___;
	srl	$pwr,	2,	%o4
	and	$pwr,	3,	%o5
	and	%o4,	7,	%o4
	sll	%o5,	3,	%o5	! offset within first cache line
	add	%o5,	$ptbl,	$ptbl	! of the pwrtbl
	or	%g0,	1,	%o5
	sll	%o5,	%o4,	$ccr
___
$code.=<<___	if (!$skip_wr);
	wr	$ccr,	%g0,	%ccr
___
}
sub load_b_pair {
my ($pwrtbl,$B0,$B1)=@_;

$code.=<<___;
	ldx	[$pwrtbl+0*32],	$B0
	ldx	[$pwrtbl+8*32],	$B1
	ldx	[$pwrtbl+1*32],	%o4
	ldx	[$pwrtbl+9*32],	%o5
	movvs	%icc,	%o4,	$B0
	ldx	[$pwrtbl+2*32],	%o4
	movvs	%icc,	%o5,	$B1
	ldx	[$pwrtbl+10*32],%o5
	move	%icc,	%o4,	$B0
	ldx	[$pwrtbl+3*32],	%o4
	move	%icc,	%o5,	$B1
	ldx	[$pwrtbl+11*32],%o5
	movneg	%icc,	%o4,	$B0
	ldx	[$pwrtbl+4*32],	%o4
	movneg	%icc,	%o5,	$B1
	ldx	[$pwrtbl+12*32],%o5
	movcs	%xcc,	%o4,	$B0
	ldx	[$pwrtbl+5*32],%o4
	movcs	%xcc,	%o5,	$B1
	ldx	[$pwrtbl+13*32],%o5
	movvs	%xcc,	%o4,	$B0
	ldx	[$pwrtbl+6*32],	%o4
	movvs	%xcc,	%o5,	$B1
	ldx	[$pwrtbl+14*32],%o5
	move	%xcc,	%o4,	$B0
	ldx	[$pwrtbl+7*32],	%o4
	move	%xcc,	%o5,	$B1
	ldx	[$pwrtbl+15*32],%o5
	movneg	%xcc,	%o4,	$B0
	add	$pwrtbl,16*32,	$pwrtbl
	movneg	%xcc,	%o5,	$B1
___
}
sub load_b {
my ($pwrtbl,$Bi)=@_;

$code.=<<___;
	ldx	[$pwrtbl+0*32],	$Bi
	ldx	[$pwrtbl+1*32],	%o4
	ldx	[$pwrtbl+2*32],	%o5
	movvs	%icc,	%o4,	$Bi
	ldx	[$pwrtbl+3*32],	%o4
	move	%icc,	%o5,	$Bi
	ldx	[$pwrtbl+4*32],	%o5
	movneg	%icc,	%o4,	$Bi
	ldx	[$pwrtbl+5*32],	%o4
	movcs	%xcc,	%o5,	$Bi
	ldx	[$pwrtbl+6*32],	%o5
	movvs	%xcc,	%o4,	$Bi
	ldx	[$pwrtbl+7*32],	%o4
	move	%xcc,	%o5,	$Bi
	add	$pwrtbl,8*32,	$pwrtbl
	movneg	%xcc,	%o4,	$Bi
___
}

########################################################################
# int bn_pwr5_mont_t4_$NUM(u64 *tp,const u64 *np,const BN_ULONG *n0,
#			   const u64 *pwrtbl,int pwr,int stride);
#
sub generate_bn_pwr5_mont_t4() {
my $NUM=shift;
my ($tp,$np,$pwrtbl,$pwr,$sentinel)=map("%g$_",(1..5));

$code.=<<___;
.globl	bn_pwr5_mont_t4_$NUM
.align	32
bn_pwr5_mont_t4_$NUM:
#ifdef	__arch64__
	mov	0,$sentinel
	mov	-128,%g4
#elif defined(SPARCV9_64BIT_STACK)
	SPARC_LOAD_ADDRESS_LEAF(OPENSSL_sparcv9cap_P,%g1,%g5)
	ld	[%g1+0],%g1	! OPENSSL_sparcv9_P[0]
	mov	-2047,%g4
	and	%g1,SPARCV9_64BIT_STACK,%g1
	movrz	%g1,0,%g4
	mov	-1,$sentinel
	add	%g4,-128,%g4
#else
	mov	-1,$sentinel
	mov	-128,%g4
#endif
	sllx	$sentinel,32,$sentinel
	save	%sp,%g4,%sp
#ifndef	__arch64__
	save	%sp,-128,%sp	! warm it up
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	save	%sp,-128,%sp
	restore
	restore
	restore
	restore
	restore
	restore
#endif
	and	%sp,1,%g4
	or	$sentinel,%fp,%fp
	or	%g4,$sentinel,$sentinel

	! copy arguments to global registers
	mov	%i0,$tp
	mov	%i1,$np
	ld	[%i2+0],%f1	! load *n0
	ld	[%i2+4],%f0
	mov	%i3,$pwrtbl
	srl	%i4,%g0,%i4	! pack last arguments
	sllx	%i5,32,$pwr
	or	%i4,$pwr,$pwr
	fsrc2	%f0,%f60
___

# load tp[$NUM] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for($i=0; $i<14 && $i<$NUM; $i++) {
$code.=<<___;
	ldx	[$tp+$i*8],@A[$i]
___
}
for(; $i<$NUM; $i++) {
$code.=<<___;
	ldd	[$tp+$i*8],@A[$i]
___
}
# load np[$NUM] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for($i=0; $i<14 && $i<$NUM; $i++) {
$code.=<<___;
	ldx	[$np+$i*8],@N[$i]
___
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<28 && $i<$NUM; $i++) {
$code.=<<___;
	ldx	[$np+$i*8],@N[$i]
___
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<$NUM; $i++) {
$code.=<<___;
	ldx	[$np+$i*8],@N[$i]
___
}
# load pwrtbl[pwr] ########################################################
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp

	srlx	$pwr,	32,	%o4		! unpack $pwr
	srl	$pwr,	%g0,	%o5
	sub	%o4,	5,	%o4
	mov	$pwrtbl,	%o7
	sllx	%o4,	32,	$pwr		! re-pack $pwr
	or	%o5,	$pwr,	$pwr
	srl	%o5,	%o4,	%o5
___
	&load_ccr("%o7","%o5","%o4");
$code.=<<___;
	b	.Lstride_$NUM
	nop
.align	16
.Lstride_$NUM:
___
for($i=0; $i<14 && $i<$NUM; $i+=2) {
	&load_b_pair("%o7",@B[$i],@B[$i+1]);
}
$code.=<<___;
	save	%sp,-128,%sp;		or	$sentinel,%fp,%fp
___
for(; $i<$NUM; $i+=2) {
	&load_b_pair("%i7",@B[$i],@B[$i+1]);
}
$code.=<<___;
	srax	$pwr,	32,	%o4		! unpack $pwr
	srl	$pwr,	%g0,	%o5
	sub	%o4,	5,	%o4
	mov	$pwrtbl,	%i7
	sllx	%o4,	32,	$pwr		! re-pack $pwr
	or	%o5,	$pwr,	$pwr
	srl	%o5,	%o4,	%o5
___
	&load_ccr("%i7","%o5","%o4",1);

# magic ################################################################
for($i=0; $i<5; $i++) {
$code.=<<___;
	.word	0x81b02940+$NUM-1	! montsqr	$NUM-1
	fbu,pn	%fcc3,.Labort_$NUM
#ifndef	__arch64__
	and	%fp,$sentinel,$sentinel
	brz,pn	$sentinel,.Labort_$NUM
#endif
	nop
___
}
$code.=<<___;
	wr	%o4,	%g0,	%ccr
	.word	0x81b02920+$NUM-1	! montmul	$NUM-1
	fbu,pn	%fcc3,.Labort_$NUM
#ifndef	__arch64__
	and	%fp,$sentinel,$sentinel
	brz,pn	$sentinel,.Labort_$NUM
#endif

	srax	$pwr,	32,	%o4
#ifdef	__arch64__
	brgez	%o4,.Lstride_$NUM
	restore
	restore
	restore
	restore
	restore
#else
	brgez	%o4,.Lstride_$NUM
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	restore;		and	%fp,$sentinel,$sentinel
	 brz,pn	$sentinel,.Labort1_$NUM
	restore
#endif
___

# save tp[$NUM] ########################################################
for($i=0; $i<14 && $i<$NUM; $i++) {
$code.=<<___;
	movxtod	@A[$i],@R[$i]
___
}
$code.=<<___;
#ifdef	__arch64__
	restore
#else
	 and	%fp,$sentinel,$sentinel
	restore
	 and	$sentinel,1,%o7
	 and	%fp,$sentinel,$sentinel
	 srl	%fp,0,%fp		! just in case?
	 or	%o7,$sentinel,$sentinel
	brz,a,pn $sentinel,.Ldone_$NUM
	mov	0,%i0		! return failure
#endif
___
for($i=0; $i<$NUM; $i++) {
$code.=<<___;
	std	@R[$i],[$tp+$i*8]
___
}
$code.=<<___;
	mov	1,%i0		! return success
.Ldone_$NUM:
	ret
	restore

.Labort_$NUM:
	restore
	restore
	restore
	restore
	restore
.Labort1_$NUM:
	restore

	mov	0,%i0		! return failure
	ret
	restore
.type	bn_pwr5_mont_t4_$NUM, #function
.size	bn_pwr5_mont_t4_$NUM, .-bn_pwr5_mont_t4_$NUM
___
}

for ($i=8;$i<=32;$i+=8) {
	&generate_bn_pwr5_mont_t4($i);
}

{
########################################################################
# Fall-back subroutines
#
# copy of bn_mul_mont_vis3 adjusted for vectors of 64-bit values
#
($n0,$m0,$m1,$lo0,$hi0, $lo1,$hi1,$aj,$alo,$nj,$nlo,$tj)=
	(map("%g$_",(1..5)),map("%o$_",(0..5,7)));

# int bn_mul_mont(
$rp="%o0";	# u64 *rp,
$ap="%o1";	# const u64 *ap,
$bp="%o2";	# const u64 *bp,
$np="%o3";	# const u64 *np,
$n0p="%o4";	# const BN_ULONG *n0,
$num="%o5";	# int num);	# caller ensures that num is >=3
$code.=<<___;
.globl	bn_mul_mont_t4
.align	32
bn_mul_mont_t4:
	add	%sp,	STACK_BIAS,	%g4	! real top of stack
	sll	$num,	3,	$num		! size in bytes
	add	$num,	63,	%g1
	andn	%g1,	63,	%g1		! buffer size rounded up to 64 bytes
	sub	%g4,	%g1,	%g1
	andn	%g1,	63,	%g1		! align at 64 byte
	sub	%g1,	STACK_FRAME,	%g1	! new top of stack
	sub	%g1,	%g4,	%g1

	save	%sp,	%g1,	%sp
___
#	+-------------------------------+<-----	%sp
#	.				.
#	+-------------------------------+<-----	aligned at 64 bytes
#	| __int64 tmp[0]		|
#	+-------------------------------+
#	.				.
#	.				.
#	+-------------------------------+<-----	aligned at 64 bytes
#	.				.
($rp,$ap,$bp,$np,$n0p,$num)=map("%i$_",(0..5));
($t0,$t1,$t2,$t3,$cnt,$tp,$bufsz)=map("%l$_",(0..7));
($ovf,$i)=($t0,$t1);
$code.=<<___;
	ld	[$n0p+0],	$t0	! pull n0[0..1] value
	ld	[$n0p+4],	$t1
	add	%sp, STACK_BIAS+STACK_FRAME, $tp
	ldx	[$bp+0],	$m0	! m0=bp[0]
	sllx	$t1,	32,	$n0
	add	$bp,	8,	$bp
	or	$t0,	$n0,	$n0

	ldx	[$ap+0],	$aj	! ap[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[0]
	umulxhi	$aj,	$m0,	$hi0

	ldx	[$ap+8],	$aj	! ap[1]
	add	$ap,	16,	$ap
	ldx	[$np+0],	$nj	! np[0]

	mulx	$lo0,	$n0,	$m1	! "tp[0]"*n0

	mulx	$aj,	$m0,	$alo	! ap[1]*bp[0]
	umulxhi	$aj,	$m0,	$aj	! ahi=aj

	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	umulxhi	$nj,	$m1,	$hi1

	ldx	[$np+8],	$nj	! np[1]

	addcc	$lo0,	$lo1,	$lo1
	add	$np,	16,	$np
	addxc	%g0,	$hi1,	$hi1

	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.L1st
	sub	$num,	24,	$cnt	! cnt=num-3

.align	16
.L1st:
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0

	ldx	[$ap+0],	$aj	! ap[j]
	addcc	$nlo,	$hi1,	$lo1
	add	$ap,	8,	$ap
	addxc	$nj,	%g0,	$hi1	! nhi=nj

	ldx	[$np+0],	$nj	! np[j]
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[0]
	add	$np,	8,	$np
	umulxhi	$aj,	$m0,	$aj	! ahi=aj

	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addxc	%g0,	$hi1,	$hi1
	stxa	$lo1,	[$tp]0xe2	! tp[j-1]
	add	$tp,	8,	$tp	! tp++

	brnz,pt	$cnt,	.L1st
	sub	$cnt,	8,	$cnt	! j--
!.L1st
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	addxc	%g0,	$hi1,	$hi1
	stxa	$lo1,	[$tp]0xe2	! tp[j-1]
	add	$tp,	8,	$tp

	addcc	$hi0,	$hi1,	$hi1
	addxc	%g0,	%g0,	$ovf	! upmost overflow bit
	stxa	$hi1,	[$tp]0xe2
	add	$tp,	8,	$tp

	ba	.Louter
	sub	$num,	16,	$i	! i=num-2

.align	16
.Louter:
	ldx	[$bp+0],	$m0	! m0=bp[i]
	add	$bp,	8,	$bp

	sub	$ap,	$num,	$ap	! rewind
	sub	$np,	$num,	$np
	sub	$tp,	$num,	$tp

	ldx	[$ap+0],	$aj	! ap[0]
	ldx	[$np+0],	$nj	! np[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[i]
	ldx	[$tp],		$tj	! tp[0]
	umulxhi	$aj,	$m0,	$hi0
	ldx	[$ap+8],	$aj	! ap[1]
	addcc	$lo0,	$tj,	$lo0	! ap[0]*bp[i]+tp[0]
	mulx	$aj,	$m0,	$alo	! ap[1]*bp[i]
	addxc	%g0,	$hi0,	$hi0
	mulx	$lo0,	$n0,	$m1	! tp[0]*n0
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	add	$ap,	16,	$ap
	umulxhi	$nj,	$m1,	$hi1
	ldx	[$np+8],	$nj	! np[1]
	add	$np,	16,	$np
	addcc	$lo1,	$lo0,	$lo1
	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	addxc	%g0,	$hi1,	$hi1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.Linner
	sub	$num,	24,	$cnt	! cnt=num-3
.align	16
.Linner:
	addcc	$alo,	$hi0,	$lo0
	ldx	[$tp+8],	$tj	! tp[j]
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	ldx	[$ap+0],	$aj	! ap[j]
	add	$ap,	8,	$ap
	addcc	$nlo,	$hi1,	$lo1
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[i]
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	ldx	[$np+0],	$nj	! np[j]
	add	$np,	8,	$np
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addxc	%g0,	$hi0,	$hi0
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]
	add	$tp,	8,	$tp
	brnz,pt	$cnt,	.Linner
	sub	$cnt,	8,	$cnt
!.Linner
	ldx	[$tp+8],	$tj	! tp[j]
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi0,	$hi0

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]

	subcc	%g0,	$ovf,	%g0	! move upmost overflow to CCR.xcc
	addxccc	$hi1,	$hi0,	$hi1
	addxc	%g0,	%g0,	$ovf
	stx	$hi1,	[$tp+8]
	add	$tp,	16,	$tp

	brnz,pt	$i,	.Louter
	sub	$i,	8,	$i

	sub	$ap,	$num,	$ap	! rewind
	sub	$np,	$num,	$np
	sub	$tp,	$num,	$tp
	ba	.Lsub
	subcc	$num,	8,	$cnt	! cnt=num-1 and clear CCR.xcc

.align	16
.Lsub:
	ldx	[$tp],		$tj
	add	$tp,	8,	$tp
	ldx	[$np+0],	$nj
	add	$np,	8,	$np
	subccc	$tj,	$nj,	$t2	! tp[j]-np[j]
	srlx	$tj,	32,	$tj
	srlx	$nj,	32,	$nj
	subccc	$tj,	$nj,	$t3
	add	$rp,	8,	$rp
	st	$t2,	[$rp-4]		! reverse order
	st	$t3,	[$rp-8]
	brnz,pt	$cnt,	.Lsub
	sub	$cnt,	8,	$cnt

	sub	$np,	$num,	$np	! rewind
	sub	$tp,	$num,	$tp
	sub	$rp,	$num,	$rp

	subccc	$ovf,	%g0,	$ovf	! handle upmost overflow bit
	ba	.Lcopy
	sub	$num,	8,	$cnt

.align	16
.Lcopy:					! conditional copy
	ldx	[$tp],		$tj
	ldx	[$rp+0],	$t2
	stx	%g0,	[$tp]		! zap
	add	$tp,	8,	$tp
	movcs	%icc,	$tj,	$t2
	stx	$t2,	[$rp+0]
	add	$rp,	8,	$rp
	brnz	$cnt,	.Lcopy
	sub	$cnt,	8,	$cnt

	mov	1,	%o0
	ret
	restore
.type	bn_mul_mont_t4, #function
.size	bn_mul_mont_t4, .-bn_mul_mont_t4
___

# int bn_mul_mont_gather5(
$rp="%o0";	# u64 *rp,
$ap="%o1";	# const u64 *ap,
$bp="%o2";	# const u64 *pwrtbl,
$np="%o3";	# const u64 *np,
$n0p="%o4";	# const BN_ULONG *n0,
$num="%o5";	# int num,	# caller ensures that num is >=3
		# int power);
$code.=<<___;
.globl	bn_mul_mont_gather5_t4
.align	32
bn_mul_mont_gather5_t4:
	add	%sp,	STACK_BIAS,	%g4	! real top of stack
	sll	$num,	3,	$num		! size in bytes
	add	$num,	63,	%g1
	andn	%g1,	63,	%g1		! buffer size rounded up to 64 bytes
	sub	%g4,	%g1,	%g1
	andn	%g1,	63,	%g1		! align at 64 byte
	sub	%g1,	STACK_FRAME,	%g1	! new top of stack
	sub	%g1,	%g4,	%g1
	LDPTR	[%sp+STACK_7thARG],	%g4	! load power, 7th argument

	save	%sp,	%g1,	%sp
___
#	+-------------------------------+<-----	%sp
#	.				.
#	+-------------------------------+<-----	aligned at 64 bytes
#	| __int64 tmp[0]		|
#	+-------------------------------+
#	.				.
#	.				.
#	+-------------------------------+<-----	aligned at 64 bytes
#	.				.
($rp,$ap,$bp,$np,$n0p,$num)=map("%i$_",(0..5));
($t0,$t1,$t2,$t3,$cnt,$tp,$bufsz,$ccr)=map("%l$_",(0..7));
($ovf,$i)=($t0,$t1);
	&load_ccr($bp,"%g4",$ccr);
	&load_b($bp,$m0,"%o7");		# m0=bp[0]

$code.=<<___;
	ld	[$n0p+0],	$t0	! pull n0[0..1] value
	ld	[$n0p+4],	$t1
	add	%sp, STACK_BIAS+STACK_FRAME, $tp
	sllx	$t1,	32,	$n0
	or	$t0,	$n0,	$n0

	ldx	[$ap+0],	$aj	! ap[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[0]
	umulxhi	$aj,	$m0,	$hi0

	ldx	[$ap+8],	$aj	! ap[1]
	add	$ap,	16,	$ap
	ldx	[$np+0],	$nj	! np[0]

	mulx	$lo0,	$n0,	$m1	! "tp[0]"*n0

	mulx	$aj,	$m0,	$alo	! ap[1]*bp[0]
	umulxhi	$aj,	$m0,	$aj	! ahi=aj

	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	umulxhi	$nj,	$m1,	$hi1

	ldx	[$np+8],	$nj	! np[1]

	addcc	$lo0,	$lo1,	$lo1
	add	$np,	16,	$np
	addxc	%g0,	$hi1,	$hi1

	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.L1st_g5
	sub	$num,	24,	$cnt	! cnt=num-3

.align	16
.L1st_g5:
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0

	ldx	[$ap+0],	$aj	! ap[j]
	addcc	$nlo,	$hi1,	$lo1
	add	$ap,	8,	$ap
	addxc	$nj,	%g0,	$hi1	! nhi=nj

	ldx	[$np+0],	$nj	! np[j]
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[0]
	add	$np,	8,	$np
	umulxhi	$aj,	$m0,	$aj	! ahi=aj

	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addxc	%g0,	$hi1,	$hi1
	stxa	$lo1,	[$tp]0xe2	! tp[j-1]
	add	$tp,	8,	$tp	! tp++

	brnz,pt	$cnt,	.L1st_g5
	sub	$cnt,	8,	$cnt	! j--
!.L1st_g5
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	addxc	%g0,	$hi1,	$hi1
	stxa	$lo1,	[$tp]0xe2	! tp[j-1]
	add	$tp,	8,	$tp

	addcc	$hi0,	$hi1,	$hi1
	addxc	%g0,	%g0,	$ovf	! upmost overflow bit
	stxa	$hi1,	[$tp]0xe2
	add	$tp,	8,	$tp

	ba	.Louter_g5
	sub	$num,	16,	$i	! i=num-2

.align	16
.Louter_g5:
	wr	$ccr,	%g0,	%ccr
___
	&load_b($bp,$m0);		# m0=bp[i]
$code.=<<___;
	sub	$ap,	$num,	$ap	! rewind
	sub	$np,	$num,	$np
	sub	$tp,	$num,	$tp

	ldx	[$ap+0],	$aj	! ap[0]
	ldx	[$np+0],	$nj	! np[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[i]
	ldx	[$tp],		$tj	! tp[0]
	umulxhi	$aj,	$m0,	$hi0
	ldx	[$ap+8],	$aj	! ap[1]
	addcc	$lo0,	$tj,	$lo0	! ap[0]*bp[i]+tp[0]
	mulx	$aj,	$m0,	$alo	! ap[1]*bp[i]
	addxc	%g0,	$hi0,	$hi0
	mulx	$lo0,	$n0,	$m1	! tp[0]*n0
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	add	$ap,	16,	$ap
	umulxhi	$nj,	$m1,	$hi1
	ldx	[$np+8],	$nj	! np[1]
	add	$np,	16,	$np
	addcc	$lo1,	$lo0,	$lo1
	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	addxc	%g0,	$hi1,	$hi1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.Linner_g5
	sub	$num,	24,	$cnt	! cnt=num-3
.align	16
.Linner_g5:
	addcc	$alo,	$hi0,	$lo0
	ldx	[$tp+8],	$tj	! tp[j]
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	ldx	[$ap+0],	$aj	! ap[j]
	add	$ap,	8,	$ap
	addcc	$nlo,	$hi1,	$lo1
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[i]
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	ldx	[$np+0],	$nj	! np[j]
	add	$np,	8,	$np
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addxc	%g0,	$hi0,	$hi0
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]
	add	$tp,	8,	$tp
	brnz,pt	$cnt,	.Linner_g5
	sub	$cnt,	8,	$cnt
!.Linner_g5
	ldx	[$tp+8],	$tj	! tp[j]
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi0,	$hi0

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]

	subcc	%g0,	$ovf,	%g0	! move upmost overflow to CCR.xcc
	addxccc	$hi1,	$hi0,	$hi1
	addxc	%g0,	%g0,	$ovf
	stx	$hi1,	[$tp+8]
	add	$tp,	16,	$tp

	brnz,pt	$i,	.Louter_g5
	sub	$i,	8,	$i

	sub	$ap,	$num,	$ap	! rewind
	sub	$np,	$num,	$np
	sub	$tp,	$num,	$tp
	ba	.Lsub_g5
	subcc	$num,	8,	$cnt	! cnt=num-1 and clear CCR.xcc

.align	16
.Lsub_g5:
	ldx	[$tp],		$tj
	add	$tp,	8,	$tp
	ldx	[$np+0],	$nj
	add	$np,	8,	$np
	subccc	$tj,	$nj,	$t2	! tp[j]-np[j]
	srlx	$tj,	32,	$tj
	srlx	$nj,	32,	$nj
	subccc	$tj,	$nj,	$t3
	add	$rp,	8,	$rp
	st	$t2,	[$rp-4]		! reverse order
	st	$t3,	[$rp-8]
	brnz,pt	$cnt,	.Lsub_g5
	sub	$cnt,	8,	$cnt

	sub	$np,	$num,	$np	! rewind
	sub	$tp,	$num,	$tp
	sub	$rp,	$num,	$rp

	subccc	$ovf,	%g0,	$ovf	! handle upmost overflow bit
	ba	.Lcopy_g5
	sub	$num,	8,	$cnt

.align	16
.Lcopy_g5:				! conditional copy
	ldx	[$tp],		$tj
	ldx	[$rp+0],	$t2
	stx	%g0,	[$tp]		! zap
	add	$tp,	8,	$tp
	movcs	%icc,	$tj,	$t2
	stx	$t2,	[$rp+0]
	add	$rp,	8,	$rp
	brnz	$cnt,	.Lcopy_g5
	sub	$cnt,	8,	$cnt

	mov	1,	%o0
	ret
	restore
.type	bn_mul_mont_gather5_t4, #function
.size	bn_mul_mont_gather5_t4, .-bn_mul_mont_gather5_t4
___
}

$code.=<<___;
.globl	bn_flip_t4
.align	32
bn_flip_t4:
.Loop_flip:
	ld	[%o1+0],	%o4
	sub	%o2,	1,	%o2
	ld	[%o1+4],	%o5
	add	%o1,	8,	%o1
	st	%o5,	[%o0+0]
	st	%o4,	[%o0+4]
	brnz	%o2,	.Loop_flip
	add	%o0,	8,	%o0
	retl
	nop
.type	bn_flip_t4, #function
.size	bn_flip_t4, .-bn_flip_t4

.globl	bn_flip_n_scatter5_t4
.align	32
bn_flip_n_scatter5_t4:
	sll	%o3,	3,	%o3
	srl	%o1,	1,	%o1
	add	%o3,	%o2,	%o2	! &pwrtbl[pwr]
	sub	%o1,	1,	%o1
.Loop_flip_n_scatter5:
	ld	[%o0+0],	%o4	! inp[i]
	ld	[%o0+4],	%o5
	add	%o0,	8,	%o0
	sllx	%o5,	32,	%o5
	or	%o4,	%o5,	%o5
	stx	%o5,	[%o2]
	add	%o2,	32*8,	%o2
	brnz	%o1,	.Loop_flip_n_scatter5
	sub	%o1,	1,	%o1
	retl
	nop
.type	bn_flip_n_scatter5_t4, #function
.size	bn_flip_n_scatter5_t4, .-bn_flip_n_scatter5_t4

.globl	bn_gather5_t4
.align	32
bn_gather5_t4:
___
	&load_ccr("%o2","%o3","%g1");
$code.=<<___;
	sub	%o1,	1,	%o1
.Loop_gather5:
___
	&load_b("%o2","%g1");
$code.=<<___;
	stx	%g1,	[%o0]
	add	%o0,	8,	%o0
	brnz	%o1,	.Loop_gather5
	sub	%o1,	1,	%o1

	retl
	nop
.type	bn_gather5_t4, #function
.size	bn_gather5_t4, .-bn_gather5_t4

.asciz	"Montgomery Multiplication for SPARC T4, David S. Miller, Andy Polyakov"
.align	4
___

&emit_assembler();

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


#! /usr/bin/env perl
# Copyright 2012-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/.
# ====================================================================
#
# October 2012
#
# The module implements bn_GF2m_mul_2x2 polynomial multiplication used
# in bn_gf2m.c. It's kind of low-hanging mechanical port from C for
# the time being... Except that it has two code paths: one suitable
# for all SPARCv9 processors and one for VIS3-capable ones. Former
# delivers ~25-45% more, more for longer keys, heaviest DH and DSA
# verify operations on venerable UltraSPARC II. On T4 VIS3 code is
# ~100-230% faster than gcc-generated code and ~35-90% faster than
# the pure SPARCv9 code path.

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

$locals=16*8;

$tab="%l0";

@T=("%g2","%g3");
@i=("%g4","%g5");

($a1,$a2,$a4,$a8,$a12,$a48)=map("%o$_",(0..5));
($lo,$hi,$b)=("%g1",$a8,"%o7"); $a=$lo;

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

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

#ifdef __PIC__
SPARC_PIC_THUNK(%g1)
#endif

.globl	bn_GF2m_mul_2x2
.align	16
bn_GF2m_mul_2x2:
        SPARC_LOAD_ADDRESS_LEAF(OPENSSL_sparcv9cap_P,%g1,%g5)
        ld	[%g1+0],%g1             	! OPENSSL_sparcv9cap_P[0]

        andcc	%g1, SPARCV9_VIS3, %g0
        bz,pn	%icc,.Lsoftware
        nop

	sllx	%o1, 32, %o1
	sllx	%o3, 32, %o3
	or	%o2, %o1, %o1
	or	%o4, %o3, %o3
	.word	0x95b262ab			! xmulx   %o1, %o3, %o2
	.word	0x99b262cb			! xmulxhi %o1, %o3, %o4
	srlx	%o2, 32, %o1			! 13 cycles later
	st	%o2, [%o0+0]
	st	%o1, [%o0+4]
	srlx	%o4, 32, %o3
	st	%o4, [%o0+8]
	retl
	st	%o3, [%o0+12]

.align	16
.Lsoftware:
	save	%sp,-STACK_FRAME-$locals,%sp

	sllx	%i1,32,$a
	mov	-1,$a12
	sllx	%i3,32,$b
	or	%i2,$a,$a
	srlx	$a12,1,$a48			! 0x7fff...
	or	%i4,$b,$b
	srlx	$a12,2,$a12			! 0x3fff...
	add	%sp,STACK_BIAS+STACK_FRAME,$tab

	sllx	$a,2,$a4
	mov	$a,$a1
	sllx	$a,1,$a2

	srax	$a4,63,@i[1]			! broadcast 61st bit
	and	$a48,$a4,$a4			! (a<<2)&0x7fff...
	srlx	$a48,2,$a48
	srax	$a2,63,@i[0]			! broadcast 62nd bit
	and	$a12,$a2,$a2			! (a<<1)&0x3fff...
	srax	$a1,63,$lo			! broadcast 63rd bit
	and	$a48,$a1,$a1			! (a<<0)&0x1fff...

	sllx	$a1,3,$a8
	and	$b,$lo,$lo
	and	$b,@i[0],@i[0]
	and	$b,@i[1],@i[1]

	stx	%g0,[$tab+0*8]			! tab[0]=0
	xor	$a1,$a2,$a12
	stx	$a1,[$tab+1*8]			! tab[1]=a1
	stx	$a2,[$tab+2*8]			! tab[2]=a2
	 xor	$a4,$a8,$a48
	stx	$a12,[$tab+3*8]			! tab[3]=a1^a2
	 xor	$a4,$a1,$a1

	stx	$a4,[$tab+4*8]			! tab[4]=a4
	xor	$a4,$a2,$a2
	stx	$a1,[$tab+5*8]			! tab[5]=a1^a4
	xor	$a4,$a12,$a12
	stx	$a2,[$tab+6*8]			! tab[6]=a2^a4
	 xor	$a48,$a1,$a1
	stx	$a12,[$tab+7*8]			! tab[7]=a1^a2^a4
	 xor	$a48,$a2,$a2

	stx	$a8,[$tab+8*8]			! tab[8]=a8
	xor	$a48,$a12,$a12
	stx	$a1,[$tab+9*8]			! tab[9]=a1^a8
	 xor	$a4,$a1,$a1
	stx	$a2,[$tab+10*8]			! tab[10]=a2^a8
	 xor	$a4,$a2,$a2
	stx	$a12,[$tab+11*8]		! tab[11]=a1^a2^a8

	xor	$a4,$a12,$a12
	stx	$a48,[$tab+12*8]		! tab[12]=a4^a8
	 srlx	$lo,1,$hi
	stx	$a1,[$tab+13*8]			! tab[13]=a1^a4^a8
	 sllx	$lo,63,$lo
	stx	$a2,[$tab+14*8]			! tab[14]=a2^a4^a8
	 srlx	@i[0],2,@T[0]
	stx	$a12,[$tab+15*8]		! tab[15]=a1^a2^a4^a8

	sllx	@i[0],62,$a1
	 sllx	$b,3,@i[0]
	srlx	@i[1],3,@T[1]
	 and	@i[0],`0xf<<3`,@i[0]
	sllx	@i[1],61,$a2
	 ldx	[$tab+@i[0]],@i[0]
	 srlx	$b,4-3,@i[1]
	xor	@T[0],$hi,$hi
	 and	@i[1],`0xf<<3`,@i[1]
	xor	$a1,$lo,$lo
	 ldx	[$tab+@i[1]],@i[1]
	xor	@T[1],$hi,$hi

	xor	@i[0],$lo,$lo
	srlx	$b,8-3,@i[0]
	 xor	$a2,$lo,$lo
	and	@i[0],`0xf<<3`,@i[0]
___
for($n=1;$n<14;$n++) {
$code.=<<___;
	sllx	@i[1],`$n*4`,@T[0]
	ldx	[$tab+@i[0]],@i[0]
	srlx	@i[1],`64-$n*4`,@T[1]
	xor	@T[0],$lo,$lo
	srlx	$b,`($n+2)*4`-3,@i[1]
	xor	@T[1],$hi,$hi
	and	@i[1],`0xf<<3`,@i[1]
___
	push(@i,shift(@i)); push(@T,shift(@T));
}
$code.=<<___;
	sllx	@i[1],`$n*4`,@T[0]
	ldx	[$tab+@i[0]],@i[0]
	srlx	@i[1],`64-$n*4`,@T[1]
	xor	@T[0],$lo,$lo

	sllx	@i[0],`($n+1)*4`,@T[0]
	 xor	@T[1],$hi,$hi
	srlx	@i[0],`64-($n+1)*4`,@T[1]
	xor	@T[0],$lo,$lo
	xor	@T[1],$hi,$hi

	srlx	$lo,32,%i1
	st	$lo,[%i0+0]
	st	%i1,[%i0+4]
	srlx	$hi,32,%i2
	st	$hi,[%i0+8]
	st	%i2,[%i0+12]

	ret
	restore
.type	bn_GF2m_mul_2x2,#function
.size	bn_GF2m_mul_2x2,.-bn_GF2m_mul_2x2
.asciz	"GF(2^m) Multiplication for SPARCv9, CRYPTOGAMS by <appro\@openssl.org>"
.align	4
___

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


#! /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. 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/.
# ====================================================================

# December 2005
#
# Pure SPARCv9/8+ and IALU-only bn_mul_mont implementation. The reasons
# for undertaken effort are multiple. First of all, UltraSPARC is not
# the whole SPARCv9 universe and other VIS-free implementations deserve
# optimized code as much. Secondly, newly introduced UltraSPARC T1,
# a.k.a. Niagara, has shared FPU and concurrent FPU-intensive paths,
# such as sparcv9a-mont, will simply sink it. Yes, T1 is equipped with
# several integrated RSA/DSA accelerator circuits accessible through
# kernel driver [only(*)], but having decent user-land software
# implementation is important too. Finally, reasons like desire to
# experiment with dedicated squaring procedure. Yes, this module
# implements one, because it was easiest to draft it in SPARCv9
# instructions...

# (*)	Engine accessing the driver in question is on my TODO list.
#	For reference, accelerator is estimated to give 6 to 10 times
#	improvement on single-threaded RSA sign. It should be noted
#	that 6-10x improvement coefficient does not actually mean
#	something extraordinary in terms of absolute [single-threaded]
#	performance, as SPARCv9 instruction set is by all means least
#	suitable for high performance crypto among other 64 bit
#	platforms. 6-10x factor simply places T1 in same performance
#	domain as say AMD64 and IA-64. Improvement of RSA verify don't
#	appear impressive at all, but it's the sign operation which is
#	far more critical/interesting.

# You might notice that inner loops are modulo-scheduled:-) This has
# essentially negligible impact on UltraSPARC performance, it's
# Fujitsu SPARC64 V users who should notice and hopefully appreciate
# the advantage... Currently this module surpasses sparcv9a-mont.pl
# by ~20% on UltraSPARC-III and later cores, but recall that sparcv9a
# module still have hidden potential [see TODO list there], which is
# estimated to be larger than 20%...

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

# int bn_mul_mont(
$rp="%i0";	# BN_ULONG *rp,
$ap="%i1";	# const BN_ULONG *ap,
$bp="%i2";	# const BN_ULONG *bp,
$np="%i3";	# const BN_ULONG *np,
$n0="%i4";	# const BN_ULONG *n0,
$num="%i5";	# int num);

$frame="STACK_FRAME";
$bias="STACK_BIAS";

$car0="%o0";
$car1="%o1";
$car2="%o2";	# 1 bit
$acc0="%o3";
$acc1="%o4";
$mask="%g1";	# 32 bits, what a waste...
$tmp0="%g4";
$tmp1="%g5";

$i="%l0";
$j="%l1";
$mul0="%l2";
$mul1="%l3";
$tp="%l4";
$apj="%l5";
$npj="%l6";
$tpj="%l7";

$fname="bn_mul_mont_int";

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

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

.global	$fname
.align	32
$fname:
	cmp	%o5,4			! 128 bits minimum
	bge,pt	%icc,.Lenter
	sethi	%hi(0xffffffff),$mask
	retl
	clr	%o0
.align	32
.Lenter:
	save	%sp,-$frame,%sp
	sll	$num,2,$num		! num*=4
	or	$mask,%lo(0xffffffff),$mask
	ld	[$n0],$n0
	cmp	$ap,$bp
	and	$num,$mask,$num
	ld	[$bp],$mul0		! bp[0]
	nop

	add	%sp,$bias,%o7		! real top of stack
	ld	[$ap],$car0		! ap[0] ! redundant in squaring context
	sub	%o7,$num,%o7
	ld	[$ap+4],$apj		! ap[1]
	and	%o7,-1024,%o7
	ld	[$np],$car1		! np[0]
	sub	%o7,$bias,%sp		! alloca
	ld	[$np+4],$npj		! np[1]
	be,pt	SIZE_T_CC,.Lbn_sqr_mont
	mov	12,$j

	mulx	$car0,$mul0,$car0	! ap[0]*bp[0]
	mulx	$apj,$mul0,$tmp0	!prologue! ap[1]*bp[0]
	and	$car0,$mask,$acc0
	add	%sp,$bias+$frame,$tp
	ld	[$ap+8],$apj		!prologue!

	mulx	$n0,$acc0,$mul1		! "t[0]"*n0
	and	$mul1,$mask,$mul1

	mulx	$car1,$mul1,$car1	! np[0]*"t[0]"*n0
	mulx	$npj,$mul1,$acc1	!prologue! np[1]*"t[0]"*n0
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	ld	[$np+8],$npj		!prologue!
	srlx	$car1,32,$car1
	mov	$tmp0,$acc0		!prologue!

.L1st:
	mulx	$apj,$mul0,$tmp0
	mulx	$npj,$mul1,$tmp1
	add	$acc0,$car0,$car0
	ld	[$ap+$j],$apj		! ap[j]
	and	$car0,$mask,$acc0
	add	$acc1,$car1,$car1
	ld	[$np+$j],$npj		! np[j]
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	add	$j,4,$j			! j++
	mov	$tmp0,$acc0
	st	$car1,[$tp]
	cmp	$j,$num
	mov	$tmp1,$acc1
	srlx	$car1,32,$car1
	bl	%icc,.L1st
	add	$tp,4,$tp		! tp++
!.L1st

	mulx	$apj,$mul0,$tmp0	!epilogue!
	mulx	$npj,$mul1,$tmp1
	add	$acc0,$car0,$car0
	and	$car0,$mask,$acc0
	add	$acc1,$car1,$car1
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	st	$car1,[$tp]
	srlx	$car1,32,$car1

	add	$tmp0,$car0,$car0
	and	$car0,$mask,$acc0
	add	$tmp1,$car1,$car1
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	st	$car1,[$tp+4]
	srlx	$car1,32,$car1

	add	$car0,$car1,$car1
	st	$car1,[$tp+8]
	srlx	$car1,32,$car2

	mov	4,$i			! i++
	ld	[$bp+4],$mul0		! bp[1]
.Louter:
	add	%sp,$bias+$frame,$tp
	ld	[$ap],$car0		! ap[0]
	ld	[$ap+4],$apj		! ap[1]
	ld	[$np],$car1		! np[0]
	ld	[$np+4],$npj		! np[1]
	ld	[$tp],$tmp1		! tp[0]
	ld	[$tp+4],$tpj		! tp[1]
	mov	12,$j

	mulx	$car0,$mul0,$car0
	mulx	$apj,$mul0,$tmp0	!prologue!
	add	$tmp1,$car0,$car0
	ld	[$ap+8],$apj		!prologue!
	and	$car0,$mask,$acc0

	mulx	$n0,$acc0,$mul1
	and	$mul1,$mask,$mul1

	mulx	$car1,$mul1,$car1
	mulx	$npj,$mul1,$acc1	!prologue!
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	ld	[$np+8],$npj		!prologue!
	srlx	$car1,32,$car1
	mov	$tmp0,$acc0		!prologue!

.Linner:
	mulx	$apj,$mul0,$tmp0
	mulx	$npj,$mul1,$tmp1
	add	$tpj,$car0,$car0
	ld	[$ap+$j],$apj		! ap[j]
	add	$acc0,$car0,$car0
	add	$acc1,$car1,$car1
	ld	[$np+$j],$npj		! np[j]
	and	$car0,$mask,$acc0
	ld	[$tp+8],$tpj		! tp[j]
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	add	$j,4,$j			! j++
	mov	$tmp0,$acc0
	st	$car1,[$tp]		! tp[j-1]
	srlx	$car1,32,$car1
	mov	$tmp1,$acc1
	cmp	$j,$num
	bl	%icc,.Linner
	add	$tp,4,$tp		! tp++
!.Linner

	mulx	$apj,$mul0,$tmp0	!epilogue!
	mulx	$npj,$mul1,$tmp1
	add	$tpj,$car0,$car0
	add	$acc0,$car0,$car0
	ld	[$tp+8],$tpj		! tp[j]
	and	$car0,$mask,$acc0
	add	$acc1,$car1,$car1
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	st	$car1,[$tp]		! tp[j-1]
	srlx	$car1,32,$car1

	add	$tpj,$car0,$car0
	add	$tmp0,$car0,$car0
	and	$car0,$mask,$acc0
	add	$tmp1,$car1,$car1
	add	$acc0,$car1,$car1
	st	$car1,[$tp+4]		! tp[j-1]
	srlx	$car0,32,$car0
	add	$i,4,$i			! i++
	srlx	$car1,32,$car1

	add	$car0,$car1,$car1
	cmp	$i,$num
	add	$car2,$car1,$car1
	st	$car1,[$tp+8]

	srlx	$car1,32,$car2
	bl,a	%icc,.Louter
	ld	[$bp+$i],$mul0		! bp[i]
!.Louter

	add	$tp,12,$tp

.Ltail:
	add	$np,$num,$np
	add	$rp,$num,$rp
	sub	%g0,$num,%o7		! k=-num
	ba	.Lsub
	subcc	%g0,%g0,%g0		! clear %icc.c
.align	16
.Lsub:
	ld	[$tp+%o7],%o0
	ld	[$np+%o7],%o1
	subccc	%o0,%o1,%o1		! tp[j]-np[j]
	add	$rp,%o7,$i
	add	%o7,4,%o7
	brnz	%o7,.Lsub
	st	%o1,[$i]
	subccc	$car2,0,$car2		! handle upmost overflow bit
	sub	%g0,$num,%o7

.Lcopy:
	ld	[$tp+%o7],%o1		! conditional copy
	ld	[$rp+%o7],%o0
	st	%g0,[$tp+%o7]		! zap tp
	movcs	%icc,%o1,%o0
	st	%o0,[$rp+%o7]
	add	%o7,4,%o7
	brnz	%o7,.Lcopy
	nop
	mov	1,%i0
	ret
	restore
___

########
######## .Lbn_sqr_mont gives up to 20% *overall* improvement over
######## code without following dedicated squaring procedure.
########
$sbit="%o5";

$code.=<<___;
.align	32
.Lbn_sqr_mont:
	mulx	$mul0,$mul0,$car0		! ap[0]*ap[0]
	mulx	$apj,$mul0,$tmp0		!prologue!
	and	$car0,$mask,$acc0
	add	%sp,$bias+$frame,$tp
	ld	[$ap+8],$apj			!prologue!

	mulx	$n0,$acc0,$mul1			! "t[0]"*n0
	srlx	$car0,32,$car0
	and	$mul1,$mask,$mul1

	mulx	$car1,$mul1,$car1		! np[0]*"t[0]"*n0
	mulx	$npj,$mul1,$acc1		!prologue!
	and	$car0,1,$sbit
	ld	[$np+8],$npj			!prologue!
	srlx	$car0,1,$car0
	add	$acc0,$car1,$car1
	srlx	$car1,32,$car1
	mov	$tmp0,$acc0			!prologue!

.Lsqr_1st:
	mulx	$apj,$mul0,$tmp0
	mulx	$npj,$mul1,$tmp1
	add	$acc0,$car0,$car0		! ap[j]*a0+c0
	add	$acc1,$car1,$car1
	ld	[$ap+$j],$apj			! ap[j]
	and	$car0,$mask,$acc0
	ld	[$np+$j],$npj			! np[j]
	srlx	$car0,32,$car0
	add	$acc0,$acc0,$acc0
	or	$sbit,$acc0,$acc0
	mov	$tmp1,$acc1
	srlx	$acc0,32,$sbit
	add	$j,4,$j				! j++
	and	$acc0,$mask,$acc0
	cmp	$j,$num
	add	$acc0,$car1,$car1
	st	$car1,[$tp]
	mov	$tmp0,$acc0
	srlx	$car1,32,$car1
	bl	%icc,.Lsqr_1st
	add	$tp,4,$tp			! tp++
!.Lsqr_1st

	mulx	$apj,$mul0,$tmp0		! epilogue
	mulx	$npj,$mul1,$tmp1
	add	$acc0,$car0,$car0		! ap[j]*a0+c0
	add	$acc1,$car1,$car1
	and	$car0,$mask,$acc0
	srlx	$car0,32,$car0
	add	$acc0,$acc0,$acc0
	or	$sbit,$acc0,$acc0
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	add	$acc0,$car1,$car1
	st	$car1,[$tp]
	srlx	$car1,32,$car1

	add	$tmp0,$car0,$car0		! ap[j]*a0+c0
	add	$tmp1,$car1,$car1
	and	$car0,$mask,$acc0
	srlx	$car0,32,$car0
	add	$acc0,$acc0,$acc0
	or	$sbit,$acc0,$acc0
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	add	$acc0,$car1,$car1
	st	$car1,[$tp+4]
	srlx	$car1,32,$car1

	add	$car0,$car0,$car0
	or	$sbit,$car0,$car0
	add	$car0,$car1,$car1
	st	$car1,[$tp+8]
	srlx	$car1,32,$car2

	ld	[%sp+$bias+$frame],$tmp0	! tp[0]
	ld	[%sp+$bias+$frame+4],$tmp1	! tp[1]
	ld	[%sp+$bias+$frame+8],$tpj	! tp[2]
	ld	[$ap+4],$mul0			! ap[1]
	ld	[$ap+8],$apj			! ap[2]
	ld	[$np],$car1			! np[0]
	ld	[$np+4],$npj			! np[1]
	mulx	$n0,$tmp0,$mul1

	mulx	$mul0,$mul0,$car0
	and	$mul1,$mask,$mul1

	mulx	$car1,$mul1,$car1
	mulx	$npj,$mul1,$acc1
	add	$tmp0,$car1,$car1
	and	$car0,$mask,$acc0
	ld	[$np+8],$npj			! np[2]
	srlx	$car1,32,$car1
	add	$tmp1,$car1,$car1
	srlx	$car0,32,$car0
	add	$acc0,$car1,$car1
	and	$car0,1,$sbit
	add	$acc1,$car1,$car1
	srlx	$car0,1,$car0
	mov	12,$j
	st	$car1,[%sp+$bias+$frame]	! tp[0]=
	srlx	$car1,32,$car1
	add	%sp,$bias+$frame+4,$tp

.Lsqr_2nd:
	mulx	$apj,$mul0,$acc0
	mulx	$npj,$mul1,$acc1
	add	$acc0,$car0,$car0
	add	$tpj,$sbit,$sbit
	ld	[$ap+$j],$apj			! ap[j]
	and	$car0,$mask,$acc0
	ld	[$np+$j],$npj			! np[j]
	srlx	$car0,32,$car0
	add	$acc1,$car1,$car1
	ld	[$tp+8],$tpj			! tp[j]
	add	$acc0,$acc0,$acc0
	add	$j,4,$j				! j++
	add	$sbit,$acc0,$acc0
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	cmp	$j,$num
	add	$acc0,$car1,$car1
	st	$car1,[$tp]			! tp[j-1]
	srlx	$car1,32,$car1
	bl	%icc,.Lsqr_2nd
	add	$tp,4,$tp			! tp++
!.Lsqr_2nd

	mulx	$apj,$mul0,$acc0
	mulx	$npj,$mul1,$acc1
	add	$acc0,$car0,$car0
	add	$tpj,$sbit,$sbit
	and	$car0,$mask,$acc0
	srlx	$car0,32,$car0
	add	$acc1,$car1,$car1
	add	$acc0,$acc0,$acc0
	add	$sbit,$acc0,$acc0
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	add	$acc0,$car1,$car1
	st	$car1,[$tp]			! tp[j-1]
	srlx	$car1,32,$car1

	add	$car0,$car0,$car0
	add	$sbit,$car0,$car0
	add	$car0,$car1,$car1
	add	$car2,$car1,$car1
	st	$car1,[$tp+4]
	srlx	$car1,32,$car2

	ld	[%sp+$bias+$frame],$tmp1	! tp[0]
	ld	[%sp+$bias+$frame+4],$tpj	! tp[1]
	ld	[$ap+8],$mul0			! ap[2]
	ld	[$np],$car1			! np[0]
	ld	[$np+4],$npj			! np[1]
	mulx	$n0,$tmp1,$mul1
	and	$mul1,$mask,$mul1
	mov	8,$i

	mulx	$mul0,$mul0,$car0
	mulx	$car1,$mul1,$car1
	and	$car0,$mask,$acc0
	add	$tmp1,$car1,$car1
	srlx	$car0,32,$car0
	add	%sp,$bias+$frame,$tp
	srlx	$car1,32,$car1
	and	$car0,1,$sbit
	srlx	$car0,1,$car0
	mov	4,$j

.Lsqr_outer:
.Lsqr_inner1:
	mulx	$npj,$mul1,$acc1
	add	$tpj,$car1,$car1
	add	$j,4,$j
	ld	[$tp+8],$tpj
	cmp	$j,$i
	add	$acc1,$car1,$car1
	ld	[$np+$j],$npj
	st	$car1,[$tp]
	srlx	$car1,32,$car1
	bl	%icc,.Lsqr_inner1
	add	$tp,4,$tp
!.Lsqr_inner1

	add	$j,4,$j
	ld	[$ap+$j],$apj			! ap[j]
	mulx	$npj,$mul1,$acc1
	add	$tpj,$car1,$car1
	ld	[$np+$j],$npj			! np[j]
	srlx	$car1,32,$tmp0
	and	$car1,$mask,$car1
	add	$tmp0,$sbit,$sbit
	add	$acc0,$car1,$car1
	ld	[$tp+8],$tpj			! tp[j]
	add	$acc1,$car1,$car1
	st	$car1,[$tp]
	srlx	$car1,32,$car1

	add	$j,4,$j
	cmp	$j,$num
	be,pn	%icc,.Lsqr_no_inner2
	add	$tp,4,$tp

.Lsqr_inner2:
	mulx	$apj,$mul0,$acc0
	mulx	$npj,$mul1,$acc1
	add	$tpj,$sbit,$sbit
	add	$acc0,$car0,$car0
	ld	[$ap+$j],$apj			! ap[j]
	and	$car0,$mask,$acc0
	ld	[$np+$j],$npj			! np[j]
	srlx	$car0,32,$car0
	add	$acc0,$acc0,$acc0
	ld	[$tp+8],$tpj			! tp[j]
	add	$sbit,$acc0,$acc0
	add	$j,4,$j				! j++
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	cmp	$j,$num
	add	$acc0,$car1,$car1
	add	$acc1,$car1,$car1
	st	$car1,[$tp]			! tp[j-1]
	srlx	$car1,32,$car1
	bl	%icc,.Lsqr_inner2
	add	$tp,4,$tp			! tp++

.Lsqr_no_inner2:
	mulx	$apj,$mul0,$acc0
	mulx	$npj,$mul1,$acc1
	add	$tpj,$sbit,$sbit
	add	$acc0,$car0,$car0
	and	$car0,$mask,$acc0
	srlx	$car0,32,$car0
	add	$acc0,$acc0,$acc0
	add	$sbit,$acc0,$acc0
	srlx	$acc0,32,$sbit
	and	$acc0,$mask,$acc0
	add	$acc0,$car1,$car1
	add	$acc1,$car1,$car1
	st	$car1,[$tp]			! tp[j-1]
	srlx	$car1,32,$car1

	add	$car0,$car0,$car0
	add	$sbit,$car0,$car0
	add	$car0,$car1,$car1
	add	$car2,$car1,$car1
	st	$car1,[$tp+4]
	srlx	$car1,32,$car2

	add	$i,4,$i				! i++
	ld	[%sp+$bias+$frame],$tmp1	! tp[0]
	ld	[%sp+$bias+$frame+4],$tpj	! tp[1]
	ld	[$ap+$i],$mul0			! ap[j]
	ld	[$np],$car1			! np[0]
	ld	[$np+4],$npj			! np[1]
	mulx	$n0,$tmp1,$mul1
	and	$mul1,$mask,$mul1
	add	$i,4,$tmp0

	mulx	$mul0,$mul0,$car0
	mulx	$car1,$mul1,$car1
	and	$car0,$mask,$acc0
	add	$tmp1,$car1,$car1
	srlx	$car0,32,$car0
	add	%sp,$bias+$frame,$tp
	srlx	$car1,32,$car1
	and	$car0,1,$sbit
	srlx	$car0,1,$car0

	cmp	$tmp0,$num			! i<num-1
	bl	%icc,.Lsqr_outer
	mov	4,$j

.Lsqr_last:
	mulx	$npj,$mul1,$acc1
	add	$tpj,$car1,$car1
	add	$j,4,$j
	ld	[$tp+8],$tpj
	cmp	$j,$i
	add	$acc1,$car1,$car1
	ld	[$np+$j],$npj
	st	$car1,[$tp]
	srlx	$car1,32,$car1
	bl	%icc,.Lsqr_last
	add	$tp,4,$tp
!.Lsqr_last

	mulx	$npj,$mul1,$acc1
	add	$tpj,$acc0,$acc0
	srlx	$acc0,32,$tmp0
	and	$acc0,$mask,$acc0
	add	$tmp0,$sbit,$sbit
	add	$acc0,$car1,$car1
	add	$acc1,$car1,$car1
	st	$car1,[$tp]
	srlx	$car1,32,$car1

	add	$car0,$car0,$car0		! recover $car0
	add	$sbit,$car0,$car0
	add	$car0,$car1,$car1
	add	$car2,$car1,$car1
	st	$car1,[$tp+4]
	srlx	$car1,32,$car2

	ba	.Ltail
	add	$tp,8,$tp
.type	$fname,#function
.size	$fname,(.-$fname)
.asciz	"Montgomery Multiplication for SPARCv9, CRYPTOGAMS by <appro\@openssl.org>"
.align	32
___
$code =~ s/\`([^\`]*)\`/eval($1)/gem;
print $code;
close STDOUT or die "error closing STDOUT: $!";


#! /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. 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/.
# ====================================================================

# October 2005
#
# "Teaser" Montgomery multiplication module for UltraSPARC. Why FPU?
# Because unlike integer multiplier, which simply stalls whole CPU,
# FPU is fully pipelined and can effectively emit 48 bit partial
# product every cycle. Why not blended SPARC v9? One can argue that
# making this module dependent on UltraSPARC VIS extension limits its
# binary compatibility. Well yes, it does exclude SPARC64 prior-V(!)
# implementations from compatibility matrix. But the rest, whole Sun
# UltraSPARC family and brand new Fujitsu's SPARC64 V, all support
# VIS extension instructions used in this module. This is considered
# good enough to not care about HAL SPARC64 users [if any] who have
# integer-only pure SPARCv9 module to "fall down" to.

# USI&II cores currently exhibit uniform 2x improvement [over pre-
# bn_mul_mont codebase] for all key lengths and benchmarks. On USIII
# performance improves few percents for shorter keys and worsens few
# percents for longer keys. This is because USIII integer multiplier
# is >3x faster than USI&II one, which is harder to match [but see
# TODO list below]. It should also be noted that SPARC64 V features
# out-of-order execution, which *might* mean that integer multiplier
# is pipelined, which in turn *might* be impossible to match... On
# additional note, SPARC64 V implements FP Multiply-Add instruction,
# which is perfectly usable in this context... In other words, as far
# as Fujitsu SPARC64 V goes, talk to the author:-)

# The implementation implies following "non-natural" limitations on
# input arguments:
# - num may not be less than 4;
# - num has to be even;
# Failure to meet either condition has no fatal effects, simply
# doesn't give any performance gain.

# TODO:
# - modulo-schedule inner loop for better performance (on in-order
#   execution core such as UltraSPARC this shall result in further
#   noticeable(!) improvement);
# - dedicated squaring procedure[?];

######################################################################
# November 2006
#
# Modulo-scheduled inner loops allow to interleave floating point and
# integer instructions and minimize Read-After-Write penalties. This
# results in *further* 20-50% performance improvement [depending on
# key length, more for longer keys] on USI&II cores and 30-80% - on
# USIII&IV.

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

$fname="bn_mul_mont_fpu";

$frame="STACK_FRAME";
$bias="STACK_BIAS";
$locals=64;

# In order to provide for 32-/64-bit ABI duality, I keep integers wider
# than 32 bit in %g1-%g4 and %o0-%o5. %l0-%l7 and %i0-%i5 are used
# exclusively for pointers, indexes and other small values...
# int bn_mul_mont(
$rp="%i0";	# BN_ULONG *rp,
$ap="%i1";	# const BN_ULONG *ap,
$bp="%i2";	# const BN_ULONG *bp,
$np="%i3";	# const BN_ULONG *np,
$n0="%i4";	# const BN_ULONG *n0,
$num="%i5";	# int num);

$tp="%l0";	# t[num]
$ap_l="%l1";	# a[num],n[num] are smashed to 32-bit words and saved
$ap_h="%l2";	# to these four vectors as double-precision FP values.
$np_l="%l3";	# This way a bunch of fxtods are eliminated in second
$np_h="%l4";	# loop and L1-cache aliasing is minimized...
$i="%l5";
$j="%l6";
$mask="%l7";	# 16-bit mask, 0xffff

$n0="%g4";	# reassigned(!) to "64-bit" register
$carry="%i4";	# %i4 reused(!) for a carry bit

# FP register naming chart
#
#     ..HILO
#       dcba
#   --------
#        LOa
#       LOb
#      LOc
#     LOd
#      HIa
#     HIb
#    HIc
#   HId
#    ..a
#   ..b
$ba="%f0";    $bb="%f2";    $bc="%f4";    $bd="%f6";
$na="%f8";    $nb="%f10";   $nc="%f12";   $nd="%f14";
$alo="%f16";  $alo_="%f17"; $ahi="%f18";  $ahi_="%f19";
$nlo="%f20";  $nlo_="%f21"; $nhi="%f22";  $nhi_="%f23";

$dota="%f24"; $dotb="%f26";

$aloa="%f32"; $alob="%f34"; $aloc="%f36"; $alod="%f38";
$ahia="%f40"; $ahib="%f42"; $ahic="%f44"; $ahid="%f46";
$nloa="%f48"; $nlob="%f50"; $nloc="%f52"; $nlod="%f54";
$nhia="%f56"; $nhib="%f58"; $nhic="%f60"; $nhid="%f62";

$ASI_FL16_P=0xD2;	# magic ASI value to engage 16-bit FP load

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

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

.global $fname
.align  32
$fname:
	save	%sp,-$frame-$locals,%sp

	cmp	$num,4
	bl,a,pn %icc,.Lret
	clr	%i0
	andcc	$num,1,%g0		! $num has to be even...
	bnz,a,pn %icc,.Lret
	clr	%i0			! signal "unsupported input value"

	srl	$num,1,$num
	sethi	%hi(0xffff),$mask
	ld	[%i4+0],$n0		! $n0 reassigned, remember?
	or	$mask,%lo(0xffff),$mask
	ld	[%i4+4],%o0
	sllx	%o0,32,%o0
	or	%o0,$n0,$n0		! $n0=n0[1].n0[0]

	sll	$num,3,$num		! num*=8

	add	%sp,$bias,%o0		! real top of stack
	sll	$num,2,%o1
	add	%o1,$num,%o1		! %o1=num*5
	sub	%o0,%o1,%o0
	and	%o0,-2048,%o0		! optimize TLB utilization
	sub	%o0,$bias,%sp		! alloca(5*num*8)

	rd	%asi,%o7		! save %asi
	add	%sp,$bias+$frame+$locals,$tp
	add	$tp,$num,$ap_l
	add	$ap_l,$num,$ap_l	! [an]p_[lh] point at the vectors' ends !
	add	$ap_l,$num,$ap_h
	add	$ap_h,$num,$np_l
	add	$np_l,$num,$np_h

	wr	%g0,$ASI_FL16_P,%asi	! setup %asi for 16-bit FP loads

	add	$rp,$num,$rp		! readjust input pointers to point
	add	$ap,$num,$ap		! at the ends too...
	add	$bp,$num,$bp
	add	$np,$num,$np

	stx	%o7,[%sp+$bias+$frame+48]	! save %asi

	sub	%g0,$num,$i		! i=-num
	sub	%g0,$num,$j		! j=-num

	add	$ap,$j,%o3
	add	$bp,$i,%o4

	ld	[%o3+4],%g1		! bp[0]
	ld	[%o3+0],%o0
	ld	[%o4+4],%g5		! ap[0]
	sllx	%g1,32,%g1
	ld	[%o4+0],%o1
	sllx	%g5,32,%g5
	or	%g1,%o0,%o0
	or	%g5,%o1,%o1

	add	$np,$j,%o5

	mulx	%o1,%o0,%o0		! ap[0]*bp[0]
	mulx	$n0,%o0,%o0		! ap[0]*bp[0]*n0
	stx	%o0,[%sp+$bias+$frame+0]

	ld	[%o3+0],$alo_	! load a[j] as pair of 32-bit words
	fzeros	$alo
	ld	[%o3+4],$ahi_
	fzeros	$ahi
	ld	[%o5+0],$nlo_	! load n[j] as pair of 32-bit words
	fzeros	$nlo
	ld	[%o5+4],$nhi_
	fzeros	$nhi

	! transfer b[i] to FPU as 4x16-bit values
	ldda	[%o4+2]%asi,$ba
	fxtod	$alo,$alo
	ldda	[%o4+0]%asi,$bb
	fxtod	$ahi,$ahi
	ldda	[%o4+6]%asi,$bc
	fxtod	$nlo,$nlo
	ldda	[%o4+4]%asi,$bd
	fxtod	$nhi,$nhi

	! transfer ap[0]*b[0]*n0 to FPU as 4x16-bit values
	ldda	[%sp+$bias+$frame+6]%asi,$na
	fxtod	$ba,$ba
	ldda	[%sp+$bias+$frame+4]%asi,$nb
	fxtod	$bb,$bb
	ldda	[%sp+$bias+$frame+2]%asi,$nc
	fxtod	$bc,$bc
	ldda	[%sp+$bias+$frame+0]%asi,$nd
	fxtod	$bd,$bd

	std	$alo,[$ap_l+$j]		! save smashed ap[j] in double format
	fxtod	$na,$na
	std	$ahi,[$ap_h+$j]
	fxtod	$nb,$nb
	std	$nlo,[$np_l+$j]		! save smashed np[j] in double format
	fxtod	$nc,$nc
	std	$nhi,[$np_h+$j]
	fxtod	$nd,$nd

		fmuld	$alo,$ba,$aloa
		fmuld	$nlo,$na,$nloa
		fmuld	$alo,$bb,$alob
		fmuld	$nlo,$nb,$nlob
		fmuld	$alo,$bc,$aloc
	faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
		fmuld	$alo,$bd,$alod
	faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
		fmuld	$ahi,$ba,$ahia
	faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
		fmuld	$ahi,$bb,$ahib
	faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
		fmuld	$ahi,$bc,$ahic
	faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
		fmuld	$ahi,$bd,$ahid
	faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid

	faddd	$ahic,$nhic,$dota	! $nhic
	faddd	$ahid,$nhid,$dotb	! $nhid

	faddd	$nloc,$nhia,$nloc
	faddd	$nlod,$nhib,$nlod

	fdtox	$nloa,$nloa
	fdtox	$nlob,$nlob
	fdtox	$nloc,$nloc
	fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	add	$j,8,$j
	std	$nlob,[%sp+$bias+$frame+8]
	add	$ap,$j,%o4
	std	$nloc,[%sp+$bias+$frame+16]
	add	$np,$j,%o5
	std	$nlod,[%sp+$bias+$frame+24]

	ld	[%o4+0],$alo_	! load a[j] as pair of 32-bit words
	fzeros	$alo
	ld	[%o4+4],$ahi_
	fzeros	$ahi
	ld	[%o5+0],$nlo_	! load n[j] as pair of 32-bit words
	fzeros	$nlo
	ld	[%o5+4],$nhi_
	fzeros	$nhi

	fxtod	$alo,$alo
	fxtod	$ahi,$ahi
	fxtod	$nlo,$nlo
	fxtod	$nhi,$nhi

	ldx	[%sp+$bias+$frame+0],%o0
		fmuld	$alo,$ba,$aloa
	ldx	[%sp+$bias+$frame+8],%o1
		fmuld	$nlo,$na,$nloa
	ldx	[%sp+$bias+$frame+16],%o2
		fmuld	$alo,$bb,$alob
	ldx	[%sp+$bias+$frame+24],%o3
		fmuld	$nlo,$nb,$nlob

	srlx	%o0,16,%o7
	std	$alo,[$ap_l+$j]		! save smashed ap[j] in double format
		fmuld	$alo,$bc,$aloc
	add	%o7,%o1,%o1
	std	$ahi,[$ap_h+$j]
		faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
	srlx	%o1,16,%o7
	std	$nlo,[$np_l+$j]		! save smashed np[j] in double format
		fmuld	$alo,$bd,$alod
	add	%o7,%o2,%o2
	std	$nhi,[$np_h+$j]
		faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
	srlx	%o2,16,%o7
		fmuld	$ahi,$ba,$ahia
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
		faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
	!and	%o0,$mask,%o0
	!and	%o1,$mask,%o1
	!and	%o2,$mask,%o2
	!sllx	%o1,16,%o1
	!sllx	%o2,32,%o2
	!sllx	%o3,48,%o7
	!or	%o1,%o0,%o0
	!or	%o2,%o0,%o0
	!or	%o7,%o0,%o0		! 64-bit result
	srlx	%o3,16,%g1		! 34-bit carry
		fmuld	$ahi,$bb,$ahib

	faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
		fmuld	$ahi,$bc,$ahic
	faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
		fmuld	$ahi,$bd,$ahid
	faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid

	faddd	$dota,$nloa,$nloa
	faddd	$dotb,$nlob,$nlob
	faddd	$ahic,$nhic,$dota	! $nhic
	faddd	$ahid,$nhid,$dotb	! $nhid

	faddd	$nloc,$nhia,$nloc
	faddd	$nlod,$nhib,$nlod

	fdtox	$nloa,$nloa
	fdtox	$nlob,$nlob
	fdtox	$nloc,$nloc
	fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	std	$nlob,[%sp+$bias+$frame+8]
	addcc	$j,8,$j
	std	$nloc,[%sp+$bias+$frame+16]
	bz,pn	%icc,.L1stskip
	std	$nlod,[%sp+$bias+$frame+24]

.align	32			! incidentally already aligned !
.L1st:
	add	$ap,$j,%o4
	add	$np,$j,%o5
	ld	[%o4+0],$alo_	! load a[j] as pair of 32-bit words
	fzeros	$alo
	ld	[%o4+4],$ahi_
	fzeros	$ahi
	ld	[%o5+0],$nlo_	! load n[j] as pair of 32-bit words
	fzeros	$nlo
	ld	[%o5+4],$nhi_
	fzeros	$nhi

	fxtod	$alo,$alo
	fxtod	$ahi,$ahi
	fxtod	$nlo,$nlo
	fxtod	$nhi,$nhi

	ldx	[%sp+$bias+$frame+0],%o0
		fmuld	$alo,$ba,$aloa
	ldx	[%sp+$bias+$frame+8],%o1
		fmuld	$nlo,$na,$nloa
	ldx	[%sp+$bias+$frame+16],%o2
		fmuld	$alo,$bb,$alob
	ldx	[%sp+$bias+$frame+24],%o3
		fmuld	$nlo,$nb,$nlob

	srlx	%o0,16,%o7
	std	$alo,[$ap_l+$j]		! save smashed ap[j] in double format
		fmuld	$alo,$bc,$aloc
	add	%o7,%o1,%o1
	std	$ahi,[$ap_h+$j]
		faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
	srlx	%o1,16,%o7
	std	$nlo,[$np_l+$j]		! save smashed np[j] in double format
		fmuld	$alo,$bd,$alod
	add	%o7,%o2,%o2
	std	$nhi,[$np_h+$j]
		faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
	srlx	%o2,16,%o7
		fmuld	$ahi,$ba,$ahia
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
	and	%o0,$mask,%o0
		faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
	and	%o1,$mask,%o1
	and	%o2,$mask,%o2
		fmuld	$ahi,$bb,$ahib
	sllx	%o1,16,%o1
		faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
	sllx	%o2,32,%o2
		fmuld	$ahi,$bc,$ahic
	sllx	%o3,48,%o7
	or	%o1,%o0,%o0
		faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
	or	%o2,%o0,%o0
		fmuld	$ahi,$bd,$ahid
	or	%o7,%o0,%o0		! 64-bit result
		faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid
	addcc	%g1,%o0,%o0
		faddd	$dota,$nloa,$nloa
	srlx	%o3,16,%g1		! 34-bit carry
		faddd	$dotb,$nlob,$nlob
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	stx	%o0,[$tp]		! tp[j-1]=

	faddd	$ahic,$nhic,$dota	! $nhic
	faddd	$ahid,$nhid,$dotb	! $nhid

	faddd	$nloc,$nhia,$nloc
	faddd	$nlod,$nhib,$nlod

	fdtox	$nloa,$nloa
	fdtox	$nlob,$nlob
	fdtox	$nloc,$nloc
	fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	std	$nlob,[%sp+$bias+$frame+8]
	std	$nloc,[%sp+$bias+$frame+16]
	std	$nlod,[%sp+$bias+$frame+24]

	addcc	$j,8,$j
	bnz,pt	%icc,.L1st
	add	$tp,8,$tp

.L1stskip:
	fdtox	$dota,$dota
	fdtox	$dotb,$dotb

	ldx	[%sp+$bias+$frame+0],%o0
	ldx	[%sp+$bias+$frame+8],%o1
	ldx	[%sp+$bias+$frame+16],%o2
	ldx	[%sp+$bias+$frame+24],%o3

	srlx	%o0,16,%o7
	std	$dota,[%sp+$bias+$frame+32]
	add	%o7,%o1,%o1
	std	$dotb,[%sp+$bias+$frame+40]
	srlx	%o1,16,%o7
	add	%o7,%o2,%o2
	srlx	%o2,16,%o7
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
	and	%o0,$mask,%o0
	and	%o1,$mask,%o1
	and	%o2,$mask,%o2
	sllx	%o1,16,%o1
	sllx	%o2,32,%o2
	sllx	%o3,48,%o7
	or	%o1,%o0,%o0
	or	%o2,%o0,%o0
	or	%o7,%o0,%o0		! 64-bit result
	ldx	[%sp+$bias+$frame+32],%o4
	addcc	%g1,%o0,%o0
	ldx	[%sp+$bias+$frame+40],%o5
	srlx	%o3,16,%g1		! 34-bit carry
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	stx	%o0,[$tp]		! tp[j-1]=
	add	$tp,8,$tp

	srlx	%o4,16,%o7
	add	%o7,%o5,%o5
	and	%o4,$mask,%o4
	sllx	%o5,16,%o7
	or	%o7,%o4,%o4
	addcc	%g1,%o4,%o4
	srlx	%o5,48,%g1
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	mov	%g1,$carry
	stx	%o4,[$tp]		! tp[num-1]=

	ba	.Louter
	add	$i,8,$i
.align	32
.Louter:
	sub	%g0,$num,$j		! j=-num
	add	%sp,$bias+$frame+$locals,$tp

	add	$ap,$j,%o3
	add	$bp,$i,%o4

	ld	[%o3+4],%g1		! bp[i]
	ld	[%o3+0],%o0
	ld	[%o4+4],%g5		! ap[0]
	sllx	%g1,32,%g1
	ld	[%o4+0],%o1
	sllx	%g5,32,%g5
	or	%g1,%o0,%o0
	or	%g5,%o1,%o1

	ldx	[$tp],%o2		! tp[0]
	mulx	%o1,%o0,%o0
	addcc	%o2,%o0,%o0
	mulx	$n0,%o0,%o0		! (ap[0]*bp[i]+t[0])*n0
	stx	%o0,[%sp+$bias+$frame+0]

	! transfer b[i] to FPU as 4x16-bit values
	ldda	[%o4+2]%asi,$ba
	ldda	[%o4+0]%asi,$bb
	ldda	[%o4+6]%asi,$bc
	ldda	[%o4+4]%asi,$bd

	! transfer (ap[0]*b[i]+t[0])*n0 to FPU as 4x16-bit values
	ldda	[%sp+$bias+$frame+6]%asi,$na
	fxtod	$ba,$ba
	ldda	[%sp+$bias+$frame+4]%asi,$nb
	fxtod	$bb,$bb
	ldda	[%sp+$bias+$frame+2]%asi,$nc
	fxtod	$bc,$bc
	ldda	[%sp+$bias+$frame+0]%asi,$nd
	fxtod	$bd,$bd
	ldd	[$ap_l+$j],$alo		! load a[j] in double format
	fxtod	$na,$na
	ldd	[$ap_h+$j],$ahi
	fxtod	$nb,$nb
	ldd	[$np_l+$j],$nlo		! load n[j] in double format
	fxtod	$nc,$nc
	ldd	[$np_h+$j],$nhi
	fxtod	$nd,$nd

		fmuld	$alo,$ba,$aloa
		fmuld	$nlo,$na,$nloa
		fmuld	$alo,$bb,$alob
		fmuld	$nlo,$nb,$nlob
		fmuld	$alo,$bc,$aloc
	faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
		fmuld	$alo,$bd,$alod
	faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
		fmuld	$ahi,$ba,$ahia
	faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
		fmuld	$ahi,$bb,$ahib
	faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
		fmuld	$ahi,$bc,$ahic
	faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
		fmuld	$ahi,$bd,$ahid
	faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid

	faddd	$ahic,$nhic,$dota	! $nhic
	faddd	$ahid,$nhid,$dotb	! $nhid

	faddd	$nloc,$nhia,$nloc
	faddd	$nlod,$nhib,$nlod

	fdtox	$nloa,$nloa
	fdtox	$nlob,$nlob
	fdtox	$nloc,$nloc
	fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	std	$nlob,[%sp+$bias+$frame+8]
	std	$nloc,[%sp+$bias+$frame+16]
	add	$j,8,$j
	std	$nlod,[%sp+$bias+$frame+24]

	ldd	[$ap_l+$j],$alo		! load a[j] in double format
	ldd	[$ap_h+$j],$ahi
	ldd	[$np_l+$j],$nlo		! load n[j] in double format
	ldd	[$np_h+$j],$nhi

		fmuld	$alo,$ba,$aloa
		fmuld	$nlo,$na,$nloa
		fmuld	$alo,$bb,$alob
		fmuld	$nlo,$nb,$nlob
		fmuld	$alo,$bc,$aloc
	ldx	[%sp+$bias+$frame+0],%o0
		faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
	ldx	[%sp+$bias+$frame+8],%o1
		fmuld	$alo,$bd,$alod
	ldx	[%sp+$bias+$frame+16],%o2
		faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
	ldx	[%sp+$bias+$frame+24],%o3
		fmuld	$ahi,$ba,$ahia

	srlx	%o0,16,%o7
		faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
	add	%o7,%o1,%o1
		fmuld	$ahi,$bb,$ahib
	srlx	%o1,16,%o7
		faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
	add	%o7,%o2,%o2
		fmuld	$ahi,$bc,$ahic
	srlx	%o2,16,%o7
		faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
	! why?
	and	%o0,$mask,%o0
		fmuld	$ahi,$bd,$ahid
	and	%o1,$mask,%o1
	and	%o2,$mask,%o2
		faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid
	sllx	%o1,16,%o1
		faddd	$dota,$nloa,$nloa
	sllx	%o2,32,%o2
		faddd	$dotb,$nlob,$nlob
	sllx	%o3,48,%o7
	or	%o1,%o0,%o0
		faddd	$ahic,$nhic,$dota	! $nhic
	or	%o2,%o0,%o0
		faddd	$ahid,$nhid,$dotb	! $nhid
	or	%o7,%o0,%o0		! 64-bit result
	ldx	[$tp],%o7
		faddd	$nloc,$nhia,$nloc
	addcc	%o7,%o0,%o0
	! end-of-why?
		faddd	$nlod,$nhib,$nlod
	srlx	%o3,16,%g1		! 34-bit carry
		fdtox	$nloa,$nloa
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	fdtox	$nlob,$nlob
	fdtox	$nloc,$nloc
	fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	std	$nlob,[%sp+$bias+$frame+8]
	addcc	$j,8,$j
	std	$nloc,[%sp+$bias+$frame+16]
	bz,pn	%icc,.Linnerskip
	std	$nlod,[%sp+$bias+$frame+24]

	ba	.Linner
	nop
.align	32
.Linner:
	ldd	[$ap_l+$j],$alo		! load a[j] in double format
	ldd	[$ap_h+$j],$ahi
	ldd	[$np_l+$j],$nlo		! load n[j] in double format
	ldd	[$np_h+$j],$nhi

		fmuld	$alo,$ba,$aloa
		fmuld	$nlo,$na,$nloa
		fmuld	$alo,$bb,$alob
		fmuld	$nlo,$nb,$nlob
		fmuld	$alo,$bc,$aloc
	ldx	[%sp+$bias+$frame+0],%o0
		faddd	$aloa,$nloa,$nloa
		fmuld	$nlo,$nc,$nloc
	ldx	[%sp+$bias+$frame+8],%o1
		fmuld	$alo,$bd,$alod
	ldx	[%sp+$bias+$frame+16],%o2
		faddd	$alob,$nlob,$nlob
		fmuld	$nlo,$nd,$nlod
	ldx	[%sp+$bias+$frame+24],%o3
		fmuld	$ahi,$ba,$ahia

	srlx	%o0,16,%o7
		faddd	$aloc,$nloc,$nloc
		fmuld	$nhi,$na,$nhia
	add	%o7,%o1,%o1
		fmuld	$ahi,$bb,$ahib
	srlx	%o1,16,%o7
		faddd	$alod,$nlod,$nlod
		fmuld	$nhi,$nb,$nhib
	add	%o7,%o2,%o2
		fmuld	$ahi,$bc,$ahic
	srlx	%o2,16,%o7
		faddd	$ahia,$nhia,$nhia
		fmuld	$nhi,$nc,$nhic
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
	and	%o0,$mask,%o0
		fmuld	$ahi,$bd,$ahid
	and	%o1,$mask,%o1
	and	%o2,$mask,%o2
		faddd	$ahib,$nhib,$nhib
		fmuld	$nhi,$nd,$nhid
	sllx	%o1,16,%o1
		faddd	$dota,$nloa,$nloa
	sllx	%o2,32,%o2
		faddd	$dotb,$nlob,$nlob
	sllx	%o3,48,%o7
	or	%o1,%o0,%o0
		faddd	$ahic,$nhic,$dota	! $nhic
	or	%o2,%o0,%o0
		faddd	$ahid,$nhid,$dotb	! $nhid
	or	%o7,%o0,%o0		! 64-bit result
		faddd	$nloc,$nhia,$nloc
	addcc	%g1,%o0,%o0
	ldx	[$tp+8],%o7		! tp[j]
		faddd	$nlod,$nhib,$nlod
	srlx	%o3,16,%g1		! 34-bit carry
		fdtox	$nloa,$nloa
	bcs,a	%xcc,.+8
	add	%g1,1,%g1
		fdtox	$nlob,$nlob
	addcc	%o7,%o0,%o0
		fdtox	$nloc,$nloc
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	stx	%o0,[$tp]		! tp[j-1]
		fdtox	$nlod,$nlod

	std	$nloa,[%sp+$bias+$frame+0]
	std	$nlob,[%sp+$bias+$frame+8]
	std	$nloc,[%sp+$bias+$frame+16]
	addcc	$j,8,$j
	std	$nlod,[%sp+$bias+$frame+24]
	bnz,pt	%icc,.Linner
	add	$tp,8,$tp

.Linnerskip:
	fdtox	$dota,$dota
	fdtox	$dotb,$dotb

	ldx	[%sp+$bias+$frame+0],%o0
	ldx	[%sp+$bias+$frame+8],%o1
	ldx	[%sp+$bias+$frame+16],%o2
	ldx	[%sp+$bias+$frame+24],%o3

	srlx	%o0,16,%o7
	std	$dota,[%sp+$bias+$frame+32]
	add	%o7,%o1,%o1
	std	$dotb,[%sp+$bias+$frame+40]
	srlx	%o1,16,%o7
	add	%o7,%o2,%o2
	srlx	%o2,16,%o7
	add	%o7,%o3,%o3		! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
	and	%o0,$mask,%o0
	and	%o1,$mask,%o1
	and	%o2,$mask,%o2
	sllx	%o1,16,%o1
	sllx	%o2,32,%o2
	sllx	%o3,48,%o7
	or	%o1,%o0,%o0
	or	%o2,%o0,%o0
	ldx	[%sp+$bias+$frame+32],%o4
	or	%o7,%o0,%o0		! 64-bit result
	ldx	[%sp+$bias+$frame+40],%o5
	addcc	%g1,%o0,%o0
	ldx	[$tp+8],%o7		! tp[j]
	srlx	%o3,16,%g1		! 34-bit carry
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	addcc	%o7,%o0,%o0
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	stx	%o0,[$tp]		! tp[j-1]
	add	$tp,8,$tp

	srlx	%o4,16,%o7
	add	%o7,%o5,%o5
	and	%o4,$mask,%o4
	sllx	%o5,16,%o7
	or	%o7,%o4,%o4
	addcc	%g1,%o4,%o4
	srlx	%o5,48,%g1
	bcs,a	%xcc,.+8
	add	%g1,1,%g1

	addcc	$carry,%o4,%o4
	stx	%o4,[$tp]		! tp[num-1]
	mov	%g1,$carry
	bcs,a	%xcc,.+8
	add	$carry,1,$carry

	addcc	$i,8,$i
	bnz	%icc,.Louter
	nop

	add	$tp,8,$tp		! adjust tp to point at the end
	orn	%g0,%g0,%g4
	sub	%g0,$num,%o7		! n=-num
	ba	.Lsub
	subcc	%g0,%g0,%g0		! clear %icc.c

.align	32
.Lsub:
	ldx	[$tp+%o7],%o0
	add	$np,%o7,%g1
	ld	[%g1+0],%o2
	ld	[%g1+4],%o3
	srlx	%o0,32,%o1
	subccc	%o0,%o2,%o2
	add	$rp,%o7,%g1
	subccc	%o1,%o3,%o3
	st	%o2,[%g1+0]
	add	%o7,8,%o7
	brnz,pt	%o7,.Lsub
	st	%o3,[%g1+4]
	subc	$carry,0,%g4
	sub	%g0,$num,%o7		! n=-num
	ba	.Lcopy
	nop

.align	32
.Lcopy:
	ldx	[$tp+%o7],%o0
	add	$rp,%o7,%g1
	ld	[%g1+0],%o2
	ld	[%g1+4],%o3
	stx	%g0,[$tp+%o7]
	and	%o0,%g4,%o0
	srlx	%o0,32,%o1
	andn	%o2,%g4,%o2
	andn	%o3,%g4,%o3
	or	%o2,%o0,%o0
	or	%o3,%o1,%o1
	st	%o0,[%g1+0]
	add	%o7,8,%o7
	brnz,pt	%o7,.Lcopy
	st	%o1,[%g1+4]
	sub	%g0,$num,%o7		! n=-num

.Lzap:
	stx	%g0,[$ap_l+%o7]
	stx	%g0,[$ap_h+%o7]
	stx	%g0,[$np_l+%o7]
	stx	%g0,[$np_h+%o7]
	add	%o7,8,%o7
	brnz,pt	%o7,.Lzap
	nop

	ldx	[%sp+$bias+$frame+48],%o7
	wr	%g0,%o7,%asi		! restore %asi

	mov	1,%i0
.Lret:
	ret
	restore
.type   $fname,#function
.size	$fname,(.-$fname)
.asciz	"Montgomery Multiplication for UltraSPARC, CRYPTOGAMS by <appro\@openssl.org>"
.align	32
___

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

# Below substitution makes it possible to compile without demanding
# VIS extensions on command line, e.g. -xarch=v9 vs. -xarch=v9a. I
# dare to do this, because VIS capability is detected at run-time now
# and this routine is not called on CPU not capable to execute it. Do
# note that fzeros is not the only VIS dependency! Another dependency
# is implicit and is just _a_ numerical value loaded to %asi register,
# which assembler can't recognize as VIS specific...
$code =~ s/fzeros\s+%f([0-9]+)/
	   sprintf(".word\t0x%x\t! fzeros %%f%d",0x81b00c20|($1<<25),$1)
	  /gem;

print $code;
# flush
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/.
# ====================================================================
#
# Wrapper around 'rep montmul', VIA-specific instruction accessing
# PadLock Montgomery Multiplier. The wrapper is designed as drop-in
# replacement for OpenSSL bn_mul_mont [first implemented in 0.9.9].
#
# Below are interleaved outputs from 'openssl speed rsa dsa' for 4
# different software configurations on 1.5GHz VIA Esther processor.
# Lines marked with "software integer" denote performance of hand-
# coded integer-only assembler found in OpenSSL 0.9.7. "Software SSE2"
# refers to hand-coded SSE2 Montgomery multiplication procedure found
# OpenSSL 0.9.9. "Hardware VIA SDK" refers to padlock_pmm routine from
# Padlock SDK 2.0.1 available for download from VIA, which naturally
# utilizes the magic 'repz montmul' instruction. And finally "hardware
# this" refers to *this* implementation which also uses 'repz montmul'
#
#                   sign    verify    sign/s verify/s
# rsa  512 bits 0.001720s 0.000140s    581.4   7149.7	software integer
# rsa  512 bits 0.000690s 0.000086s   1450.3  11606.0	software SSE2
# rsa  512 bits 0.006136s 0.000201s    163.0   4974.5	hardware VIA SDK
# rsa  512 bits 0.000712s 0.000050s   1404.9  19858.5	hardware this
#
# rsa 1024 bits 0.008518s 0.000413s    117.4   2420.8	software integer
# rsa 1024 bits 0.004275s 0.000277s    233.9   3609.7	software SSE2
# rsa 1024 bits 0.012136s 0.000260s     82.4   3844.5	hardware VIA SDK
# rsa 1024 bits 0.002522s 0.000116s    396.5   8650.9	hardware this
#
# rsa 2048 bits 0.050101s 0.001371s     20.0    729.6	software integer
# rsa 2048 bits 0.030273s 0.001008s     33.0    991.9	software SSE2
# rsa 2048 bits 0.030833s 0.000976s     32.4   1025.1	hardware VIA SDK
# rsa 2048 bits 0.011879s 0.000342s     84.2   2921.7	hardware this
#
# rsa 4096 bits 0.327097s 0.004859s      3.1    205.8	software integer
# rsa 4096 bits 0.229318s 0.003859s      4.4    259.2	software SSE2
# rsa 4096 bits 0.233953s 0.003274s      4.3    305.4	hardware VIA SDK
# rsa 4096 bits 0.070493s 0.001166s     14.2    857.6	hardware this
#
# dsa  512 bits 0.001342s 0.001651s    745.2    605.7	software integer
# dsa  512 bits 0.000844s 0.000987s   1185.3   1013.1	software SSE2
# dsa  512 bits 0.001902s 0.002247s    525.6    444.9	hardware VIA SDK
# dsa  512 bits 0.000458s 0.000524s   2182.2   1909.1	hardware this
#
# dsa 1024 bits 0.003964s 0.004926s    252.3    203.0	software integer
# dsa 1024 bits 0.002686s 0.003166s    372.3    315.8	software SSE2
# dsa 1024 bits 0.002397s 0.002823s    417.1    354.3	hardware VIA SDK
# dsa 1024 bits 0.000978s 0.001170s   1022.2    855.0	hardware this
#
# dsa 2048 bits 0.013280s 0.016518s     75.3     60.5	software integer
# dsa 2048 bits 0.009911s 0.011522s    100.9     86.8	software SSE2
# dsa 2048 bits 0.009542s 0.011763s    104.8     85.0	hardware VIA SDK
# dsa 2048 bits 0.002884s 0.003352s    346.8    298.3	hardware this
#
# To give you some other reference point here is output for 2.4GHz P4
# running hand-coded SSE2 bn_mul_mont found in 0.9.9, i.e. "software
# SSE2" in above terms.
#
# rsa  512 bits 0.000407s 0.000047s   2454.2  21137.0
# rsa 1024 bits 0.002426s 0.000141s    412.1   7100.0
# rsa 2048 bits 0.015046s 0.000491s     66.5   2034.9
# rsa 4096 bits 0.109770s 0.002379s      9.1    420.3
# dsa  512 bits 0.000438s 0.000525s   2281.1   1904.1
# dsa 1024 bits 0.001346s 0.001595s    742.7    627.0
# dsa 2048 bits 0.004745s 0.005582s    210.7    179.1
#
# Conclusions:
# - VIA SDK leaves a *lot* of room for improvement (which this
#   implementation successfully fills:-);
# - 'rep montmul' gives up to >3x performance improvement depending on
#   key length;
# - in terms of absolute performance it delivers approximately as much
#   as modern out-of-order 32-bit cores [again, for longer keys].

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

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

&asm_init($ARGV[0]);

# int bn_mul_mont(BN_ULONG *rp, const BN_ULONG *ap, const BN_ULONG *bp, const BN_ULONG *np,const BN_ULONG *n0, int num);
$func="bn_mul_mont_padlock";

$pad=16*1;	# amount of reserved bytes on top of every vector

# stack layout
$mZeroPrime=&DWP(0,"esp");		# these are specified by VIA
$A=&DWP(4,"esp");
$B=&DWP(8,"esp");
$T=&DWP(12,"esp");
$M=&DWP(16,"esp");
$scratch=&DWP(20,"esp");
$rp=&DWP(24,"esp");			# these are mine
$sp=&DWP(28,"esp");
# &DWP(32,"esp")			# 32 byte scratch area
# &DWP(64+(4*$num+$pad)*0,"esp")	# padded tp[num]
# &DWP(64+(4*$num+$pad)*1,"esp")	# padded copy of ap[num]
# &DWP(64+(4*$num+$pad)*2,"esp")	# padded copy of bp[num]
# &DWP(64+(4*$num+$pad)*3,"esp")	# padded copy of np[num]
# Note that SDK suggests to unconditionally allocate 2K per vector. This
# has quite an impact on performance. It naturally depends on key length,
# but to give an example 1024 bit private RSA key operations suffer >30%
# penalty. I allocate only as much as actually required...

&function_begin($func);
	&xor	("eax","eax");
	&mov	("ecx",&wparam(5));	# num
	# meet VIA's limitations for num [note that the specification
	# expresses them in bits, while we work with amount of 32-bit words]
	&test	("ecx",3);
	&jnz	(&label("leave"));	# num % 4 != 0
	&cmp	("ecx",8);
	&jb	(&label("leave"));	# num < 8
	&cmp	("ecx",1024);
	&ja	(&label("leave"));	# num > 1024

	&pushf	();
	&cld	();

	&mov	("edi",&wparam(0));	# rp
	&mov	("eax",&wparam(1));	# ap
	&mov	("ebx",&wparam(2));	# bp
	&mov	("edx",&wparam(3));	# np
	&mov	("esi",&wparam(4));	# n0
	&mov	("esi",&DWP(0,"esi"));	# *n0

	&lea	("ecx",&DWP($pad,"","ecx",4));	# ecx becomes vector size in bytes
	&lea	("ebp",&DWP(64,"","ecx",4));	# allocate 4 vectors + 64 bytes
	&neg	("ebp");
	&add	("ebp","esp");
	&and	("ebp",-64);		# align to cache-line
	&xchg	("ebp","esp");		# alloca

	&mov	($rp,"edi");		# save rp
	&mov	($sp,"ebp");		# save esp

	&mov	($mZeroPrime,"esi");
	&lea	("esi",&DWP(64,"esp"));	# tp
	&mov	($T,"esi");
	&lea	("edi",&DWP(32,"esp"));	# scratch area
	&mov	($scratch,"edi");
	&mov	("esi","eax");

	&lea	("ebp",&DWP(-$pad,"ecx"));
	&shr	("ebp",2);		# restore original num value in ebp

	&xor	("eax","eax");

	&mov	("ecx","ebp");
	&lea	("ecx",&DWP((32+$pad)/4,"ecx"));# padded tp + scratch
	&data_byte(0xf3,0xab);		# rep stosl, bzero

	&mov	("ecx","ebp");
	&lea	("edi",&DWP(64+$pad,"esp","ecx",4));# pointer to ap copy
	&mov	($A,"edi");
	&data_byte(0xf3,0xa5);		# rep movsl, memcpy
	&mov	("ecx",$pad/4);
	&data_byte(0xf3,0xab);		# rep stosl, bzero pad
	# edi points at the end of padded ap copy...

	&mov	("ecx","ebp");
	&mov	("esi","ebx");
	&mov	($B,"edi");
	&data_byte(0xf3,0xa5);		# rep movsl, memcpy
	&mov	("ecx",$pad/4);
	&data_byte(0xf3,0xab);		# rep stosl, bzero pad
	# edi points at the end of padded bp copy...

	&mov	("ecx","ebp");
	&mov	("esi","edx");
	&mov	($M,"edi");
	&data_byte(0xf3,0xa5);		# rep movsl, memcpy
	&mov	("ecx",$pad/4);
	&data_byte(0xf3,0xab);		# rep stosl, bzero pad
	# edi points at the end of padded np copy...

	# let magic happen...
	&mov	("ecx","ebp");
	&mov	("esi","esp");
	&shl	("ecx",5);		# convert word counter to bit counter
	&align	(4);
	&data_byte(0xf3,0x0f,0xa6,0xc0);# rep montmul

	&mov	("ecx","ebp");
	&lea	("esi",&DWP(64,"esp"));		# tp
	# edi still points at the end of padded np copy...
	&neg	("ebp");
	&lea	("ebp",&DWP(-$pad,"edi","ebp",4));	# so just "rewind"
	&mov	("edi",$rp);			# restore rp
	&xor	("edx","edx");			# i=0 and clear CF

&set_label("sub",8);
	&mov	("eax",&DWP(0,"esi","edx",4));
	&sbb	("eax",&DWP(0,"ebp","edx",4));
	&mov	(&DWP(0,"edi","edx",4),"eax");	# rp[i]=tp[i]-np[i]
	&lea	("edx",&DWP(1,"edx"));		# i++
	&loop	(&label("sub"));		# doesn't affect CF!

	&mov	("eax",&DWP(0,"esi","edx",4));	# upmost overflow bit
	&sbb	("eax",0);

	&mov	("ecx","edx");			# num
	&mov	("edx",0);			# i=0

&set_label("copy",8);
	&mov	("ebx",&DWP(0,"esi","edx",4));
	&mov	("eax",&DWP(0,"edi","edx",4));
	&mov	(&DWP(0,"esi","edx",4),"ecx");	# zap tp
	&cmovc	("eax","ebx");
	&mov	(&DWP(0,"edi","edx",4),"eax");
	&lea	("edx",&DWP(1,"edx"));		# i++
	&loop	(&label("copy"));

	&mov	("ebp",$sp);
	&xor	("eax","eax");

	&mov	("ecx",64/4);
	&mov	("edi","esp");		# zap frame including scratch area
	&data_byte(0xf3,0xab);		# rep stosl, bzero

	# zap copies of ap, bp and np
	&lea	("edi",&DWP(64+$pad,"esp","edx",4));# pointer to ap
	&lea	("ecx",&DWP(3*$pad/4,"edx","edx",2));
	&data_byte(0xf3,0xab);		# rep stosl, bzero

	&mov	("esp","ebp");
	&inc	("eax");		# signal "done"
	&popf	();
&set_label("leave");
&function_end($func);

&asciz("Padlock Montgomery Multiplication, CRYPTOGAMS by <appro\@openssl.org>");

&asm_finish();

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


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

# October 2012.
#
# SPARCv9 VIS3 Montgomery multiplication procedure suitable for T3 and
# onward. There are three new instructions used here: umulxhi,
# addxc[cc] and initializing store. On T3 RSA private key operations
# are 1.54/1.87/2.11/2.26 times faster for 512/1024/2048/4096-bit key
# lengths. This is without dedicated squaring procedure. On T4
# corresponding coefficients are 1.47/2.10/2.80/2.90x, which is mostly
# for reference purposes, because T4 has dedicated Montgomery
# multiplication and squaring *instructions* that deliver even more.

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

$frame = "STACK_FRAME";
$bias = "STACK_BIAS";

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

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

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

($n0,$m0,$m1,$lo0,$hi0, $lo1,$hi1,$aj,$alo,$nj,$nlo,$tj)=
	(map("%g$_",(1..5)),map("%o$_",(0..5,7)));

# int bn_mul_mont(
$rp="%o0";	# BN_ULONG *rp,
$ap="%o1";	# const BN_ULONG *ap,
$bp="%o2";	# const BN_ULONG *bp,
$np="%o3";	# const BN_ULONG *np,
$n0p="%o4";	# const BN_ULONG *n0,
$num="%o5";	# int num);	# caller ensures that num is even
				# and >=6
$code.=<<___;
.globl	bn_mul_mont_vis3
.align	32
bn_mul_mont_vis3:
	add	%sp,	$bias,	%g4	! real top of stack
	sll	$num,	2,	$num	! size in bytes
	add	$num,	63,	%g5
	andn	%g5,	63,	%g5	! buffer size rounded up to 64 bytes
	add	%g5,	%g5,	%g1
	add	%g5,	%g1,	%g1	! 3*buffer size
	sub	%g4,	%g1,	%g1
	andn	%g1,	63,	%g1	! align at 64 byte
	sub	%g1,	$frame,	%g1	! new top of stack
	sub	%g1,	%g4,	%g1

	save	%sp,	%g1,	%sp
___

#	+-------------------------------+<-----	%sp
#	.				.
#	+-------------------------------+<-----	aligned at 64 bytes
#	| __int64 tmp[0]		|
#	+-------------------------------+
#	.				.
#	.				.
#	+-------------------------------+<----- aligned at 64 bytes
#	| __int64 ap[1..0]		|	converted ap[]
#	+-------------------------------+
#	| __int64 np[1..0]		|	converted np[]
#	+-------------------------------+
#	| __int64 ap[3..2]		|
#	.				.
#	.				.
#	+-------------------------------+
($rp,$ap,$bp,$np,$n0p,$num)=map("%i$_",(0..5));
($t0,$t1,$t2,$t3,$cnt,$tp,$bufsz,$anp)=map("%l$_",(0..7));
($ovf,$i)=($t0,$t1);
$code.=<<___;
	ld	[$n0p+0],	$t0	! pull n0[0..1] value
	add	%sp, $bias+$frame, $tp
	ld	[$n0p+4],	$t1
	add	$tp,	%g5,	$anp
	ld	[$bp+0],	$t2	! m0=bp[0]
	sllx	$t1,	32,	$n0
	ld	[$bp+4],	$t3
	or	$t0,	$n0,	$n0
	add	$bp,	8,	$bp

	ld	[$ap+0],	$t0	! ap[0]
	sllx	$t3,	32,	$m0
	ld	[$ap+4],	$t1
	or	$t2,	$m0,	$m0

	ld	[$ap+8],	$t2	! ap[1]
	sllx	$t1,	32,	$aj
	ld	[$ap+12],	$t3
	or	$t0,	$aj,	$aj
	add	$ap,	16,	$ap
	stx	$aj,	[$anp]		! converted ap[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[0]
	umulxhi	$aj,	$m0,	$hi0

	ld	[$np+0],	$t0	! np[0]
	sllx	$t3,	32,	$aj
	ld	[$np+4],	$t1
	or	$t2,	$aj,	$aj

	ld	[$np+8],	$t2	! np[1]
	sllx	$t1,	32,	$nj
	ld	[$np+12],	$t3
	or	$t0, $nj,	$nj
	add	$np,	16,	$np
	stx	$nj,	[$anp+8]	! converted np[0]

	mulx	$lo0,	$n0,	$m1	! "tp[0]"*n0
	stx	$aj,	[$anp+16]	! converted ap[1]

	mulx	$aj,	$m0,	$alo	! ap[1]*bp[0]
	umulxhi	$aj,	$m0,	$aj	! ahi=aj

	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	umulxhi	$nj,	$m1,	$hi1

	sllx	$t3,	32,	$nj
	or	$t2,	$nj,	$nj
	stx	$nj,	[$anp+24]	! converted np[1]
	add	$anp,	32,	$anp

	addcc	$lo0,	$lo1,	$lo1
	addxc	%g0,	$hi1,	$hi1

	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.L1st
	sub	$num,	24,	$cnt	! cnt=num-3

.align	16
.L1st:
	ld	[$ap+0],	$t0	! ap[j]
	addcc	$alo,	$hi0,	$lo0
	ld	[$ap+4],	$t1
	addxc	$aj,	%g0,	$hi0

	sllx	$t1,	32,	$aj
	add	$ap,	8,	$ap
	or	$t0,	$aj,	$aj
	stx	$aj,	[$anp]		! converted ap[j]

	ld	[$np+0],	$t2	! np[j]
	addcc	$nlo,	$hi1,	$lo1
	ld	[$np+4],	$t3
	addxc	$nj,	%g0,	$hi1	! nhi=nj

	sllx	$t3,	32,	$nj
	add	$np,	8,	$np
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[0]
	or	$t2,	$nj,	$nj
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	stx	$nj,	[$anp+8]	! converted np[j]
	add	$anp,	16,	$anp	! anp++

	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]
	add	$tp,	8,	$tp	! tp++

	brnz,pt	$cnt,	.L1st
	sub	$cnt,	8,	$cnt	! j--
!.L1st
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1
	addcc	$lo0,	$lo1,	$lo1	! np[j]*m1+ap[j]*bp[0]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]
	add	$tp,	8,	$tp

	addcc	$hi0,	$hi1,	$hi1
	addxc	%g0,	%g0,	$ovf	! upmost overflow bit
	stx	$hi1,	[$tp]
	add	$tp,	8,	$tp

	ba	.Louter
	sub	$num,	16,	$i	! i=num-2

.align	16
.Louter:
	ld	[$bp+0],	$t2	! m0=bp[i]
	ld	[$bp+4],	$t3

	sub	$anp,	$num,	$anp	! rewind
	sub	$tp,	$num,	$tp
	sub	$anp,	$num,	$anp

	add	$bp,	8,	$bp
	sllx	$t3,	32,	$m0
	ldx	[$anp+0],	$aj	! ap[0]
	or	$t2,	$m0,	$m0
	ldx	[$anp+8],	$nj	! np[0]

	mulx	$aj,	$m0,	$lo0	! ap[0]*bp[i]
	ldx	[$tp],		$tj	! tp[0]
	umulxhi	$aj,	$m0,	$hi0
	ldx	[$anp+16],	$aj	! ap[1]
	addcc	$lo0,	$tj,	$lo0	! ap[0]*bp[i]+tp[0]
	mulx	$aj,	$m0,	$alo	! ap[1]*bp[i]
	addxc	%g0,	$hi0,	$hi0
	mulx	$lo0,	$n0,	$m1	! tp[0]*n0
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	mulx	$nj,	$m1,	$lo1	! np[0]*m1
	umulxhi	$nj,	$m1,	$hi1
	ldx	[$anp+24],	$nj	! np[1]
	add	$anp,	32,	$anp
	addcc	$lo1,	$lo0,	$lo1
	mulx	$nj,	$m1,	$nlo	! np[1]*m1
	addxc	%g0,	$hi1,	$hi1
	umulxhi	$nj,	$m1,	$nj	! nhi=nj

	ba	.Linner
	sub	$num,	24,	$cnt	! cnt=num-3
.align	16
.Linner:
	addcc	$alo,	$hi0,	$lo0
	ldx	[$tp+8],	$tj	! tp[j]
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	ldx	[$anp+0],	$aj	! ap[j]
	addcc	$nlo,	$hi1,	$lo1
	mulx	$aj,	$m0,	$alo	! ap[j]*bp[i]
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	ldx	[$anp+8],	$nj	! np[j]
	add	$anp,	16,	$anp
	umulxhi	$aj,	$m0,	$aj	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	mulx	$nj,	$m1,	$nlo	! np[j]*m1
	addxc	%g0,	$hi0,	$hi0
	umulxhi	$nj,	$m1,	$nj	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]
	add	$tp,	8,	$tp
	brnz,pt	$cnt,	.Linner
	sub	$cnt,	8,	$cnt
!.Linner
	ldx	[$tp+8],	$tj	! tp[j]
	addcc	$alo,	$hi0,	$lo0
	addxc	$aj,	%g0,	$hi0	! ahi=aj
	addcc	$lo0,	$tj,	$lo0	! ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi0,	$hi0

	addcc	$nlo,	$hi1,	$lo1
	addxc	$nj,	%g0,	$hi1	! nhi=nj
	addcc	$lo1,	$lo0,	$lo1	! np[j]*m1+ap[j]*bp[i]+tp[j]
	addxc	%g0,	$hi1,	$hi1
	stx	$lo1,	[$tp]		! tp[j-1]

	subcc	%g0,	$ovf,	%g0	! move upmost overflow to CCR.xcc
	addxccc	$hi1,	$hi0,	$hi1
	addxc	%g0,	%g0,	$ovf
	stx	$hi1,	[$tp+8]
	add	$tp,	16,	$tp

	brnz,pt	$i,	.Louter
	sub	$i,	8,	$i

	sub	$anp,	$num,	$anp	! rewind
	sub	$tp,	$num,	$tp
	sub	$anp,	$num,	$anp
	ba	.Lsub
	subcc	$num,	8,	$cnt	! cnt=num-1 and clear CCR.xcc

.align	16
.Lsub:
	ldx	[$tp],		$tj
	add	$tp,	8,	$tp
	ldx	[$anp+8],	$nj
	add	$anp,	16,	$anp
	subccc	$tj,	$nj,	$t2	! tp[j]-np[j]
	srlx	$tj,	32,	$tj
	srlx	$nj,	32,	$nj
	subccc	$tj,	$nj,	$t3
	add	$rp,	8,	$rp
	st	$t2,	[$rp-4]		! reverse order
	st	$t3,	[$rp-8]
	brnz,pt	$cnt,	.Lsub
	sub	$cnt,	8,	$cnt

	sub	$anp,	$num,	$anp	! rewind
	sub	$tp,	$num,	$tp
	sub	$anp,	$num,	$anp
	sub	$rp,	$num,	$rp

	subccc	$ovf,	%g0,	$ovf	! handle upmost overflow bit
	ba	.Lcopy
	sub	$num,	8,	$cnt

.align	16
.Lcopy:					! conditional copy
	ld	[$tp+0],	$t0
	ld	[$tp+4],	$t1
	ld	[$rp+0],	$t2
	ld	[$rp+4],	$t3
	stx	%g0,	[$tp]		! zap
	add	$tp,	8,	$tp
	stx	%g0,	[$anp]		! zap
	stx	%g0,	[$anp+8]
	add	$anp,	16,	$anp
	movcs	%icc,	$t0,	$t2
	movcs	%icc,	$t1,	$t3
	st	$t3,	[$rp+0]		! flip order
	st	$t2,	[$rp+4]
	add	$rp,	8,	$rp
	brnz	$cnt,	.Lcopy
	sub	$cnt,	8,	$cnt

	mov	1,	%o0
	ret
	restore
.type	bn_mul_mont_vis3, #function
.size	bn_mul_mont_vis3, .-bn_mul_mont_vis3
.asciz  "Montgomery Multiplication for SPARCv9 VIS3, 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 unvis3 {
my ($mnemonic,$rs1,$rs2,$rd)=@_;
my %bias = ( "g" => 0, "o" => 8, "l" => 16, "i" => 24 );
my ($ref,$opf);
my %visopf = (	"addxc"		=> 0x011,
		"addxccc"	=> 0x013,
		"umulxhi"	=> 0x016	);

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

    if ($opf=$visopf{$mnemonic}) {
	foreach ($rs1,$rs2,$rd) {
	    return $ref if (!/%([goli])([0-9])/);
	    $_=$bias{$1}+$2;
	}

	return	sprintf ".word\t0x%08x !%s",
			0x81b00000|$rd<<25|$rs1<<14|$opf<<5|$rs2,
			$ref;
    } else {
	return $ref;
    }
}

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

	s/\b(umulxhi|addxc[c]{0,2})\s+(%[goli][0-7]),\s*(%[goli][0-7]),\s*(%[goli][0-7])/
		&unvis3($1,$2,$3,$4)
	 /ge;

	print $_,"\n";
}

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