mirror of
				https://github.com/ossrs/srs.git
				synced 2025-03-09 15:49:59 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			329 lines
		
	
	
	
		
			6.2 KiB
		
	
	
	
		
			Raku
		
	
	
	
	
	
			
		
		
	
	
			329 lines
		
	
	
	
		
			6.2 KiB
		
	
	
	
		
			Raku
		
	
	
	
	
	
#! /usr/bin/env perl
 | 
						|
# Copyright 2009-2020 The OpenSSL Project Authors. All Rights Reserved.
 | 
						|
#
 | 
						|
# Licensed under the OpenSSL license (the "License").  You may not use
 | 
						|
# this file except in compliance with the License.  You can obtain a copy
 | 
						|
# in the file LICENSE in the source distribution or at
 | 
						|
# https://www.openssl.org/source/license.html
 | 
						|
 | 
						|
 | 
						|
# ====================================================================
 | 
						|
# Written by Andy Polyakov <appro@openssl.org> for the OpenSSL
 | 
						|
# project. The module is, however, dual licensed under OpenSSL and
 | 
						|
# CRYPTOGAMS licenses depending on where you obtain it. For further
 | 
						|
# details see http://www.openssl.org/~appro/cryptogams/.
 | 
						|
# ====================================================================
 | 
						|
 | 
						|
# SHA1 block procedure for Alpha.
 | 
						|
 | 
						|
# On 21264 performance is 33% better than code generated by vendor
 | 
						|
# compiler, and 75% better than GCC [3.4], and in absolute terms is
 | 
						|
# 8.7 cycles per processed byte. Implementation features vectorized
 | 
						|
# byte swap, but not Xupdate.
 | 
						|
 | 
						|
@X=(	"\$0",	"\$1",	"\$2",	"\$3",	"\$4",	"\$5",	"\$6",	"\$7",
 | 
						|
	"\$8",	"\$9",	"\$10",	"\$11",	"\$12",	"\$13",	"\$14",	"\$15");
 | 
						|
$ctx="a0";	# $16
 | 
						|
$inp="a1";
 | 
						|
$num="a2";
 | 
						|
$A="a3";
 | 
						|
$B="a4";	# 20
 | 
						|
$C="a5";
 | 
						|
$D="t8";
 | 
						|
$E="t9";	@V=($A,$B,$C,$D,$E);
 | 
						|
$t0="t10";	# 24
 | 
						|
$t1="t11";
 | 
						|
$t2="ra";
 | 
						|
$t3="t12";
 | 
						|
$K="AT";	# 28
 | 
						|
 | 
						|
sub BODY_00_19 {
 | 
						|
my ($i,$a,$b,$c,$d,$e)=@_;
 | 
						|
my $j=$i+1;
 | 
						|
$code.=<<___ if ($i==0);
 | 
						|
	ldq_u	@X[0],0+0($inp)
 | 
						|
	ldq_u	@X[1],0+7($inp)
 | 
						|
___
 | 
						|
$code.=<<___ if (!($i&1) && $i<14);
 | 
						|
	ldq_u	@X[$i+2],($i+2)*4+0($inp)
 | 
						|
	ldq_u	@X[$i+3],($i+2)*4+7($inp)
 | 
						|
___
 | 
						|
$code.=<<___ if (!($i&1) && $i<15);
 | 
						|
	extql	@X[$i],$inp,@X[$i]
 | 
						|
	extqh	@X[$i+1],$inp,@X[$i+1]
 | 
						|
 | 
						|
	or	@X[$i+1],@X[$i],@X[$i]	# pair of 32-bit values are fetched
 | 
						|
 | 
						|
	srl	@X[$i],24,$t0		# vectorized byte swap
 | 
						|
	srl	@X[$i],8,$t2
 | 
						|
 | 
						|
	sll	@X[$i],8,$t3
 | 
						|
	sll	@X[$i],24,@X[$i]
 | 
						|
	zapnot	$t0,0x11,$t0
 | 
						|
	zapnot	$t2,0x22,$t2
 | 
						|
 | 
						|
	zapnot	@X[$i],0x88,@X[$i]
 | 
						|
	or	$t0,$t2,$t0
 | 
						|
	zapnot	$t3,0x44,$t3
 | 
						|
	sll	$a,5,$t1
 | 
						|
 | 
						|
	or	@X[$i],$t0,@X[$i]
 | 
						|
	addl	$K,$e,$e
 | 
						|
	and	$b,$c,$t2
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
 | 
						|
	or	@X[$i],$t3,@X[$i]
 | 
						|
	srl	$a,27,$t0
 | 
						|
	bic	$d,$b,$t3
 | 
						|
	sll	$b,30,$b
 | 
						|
 | 
						|
	extll	@X[$i],4,@X[$i+1]	# extract upper half
 | 
						|
	or	$t2,$t3,$t2
 | 
						|
	addl	@X[$i],$e,$e
 | 
						|
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	srl	$b,32,$t3
 | 
						|
	zapnot	@X[$i],0xf,@X[$i]
 | 
						|
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	or	$t3,$b,$b
 | 
						|
___
 | 
						|
$code.=<<___ if (($i&1) && $i<15);
 | 
						|
	sll	$a,5,$t1
 | 
						|
	addl	$K,$e,$e
 | 
						|
	and	$b,$c,$t2
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
 | 
						|
	srl	$a,27,$t0
 | 
						|
	addl	@X[$i%16],$e,$e
 | 
						|
	bic	$d,$b,$t3
 | 
						|
	sll	$b,30,$b
 | 
						|
 | 
						|
	or	$t2,$t3,$t2
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	srl	$b,32,$t3
 | 
						|
	zapnot	@X[$i],0xf,@X[$i]
 | 
						|
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	or	$t3,$b,$b
 | 
						|
___
 | 
						|
$code.=<<___ if ($i>=15);	# with forward Xupdate
 | 
						|
	sll	$a,5,$t1
 | 
						|
	addl	$K,$e,$e
 | 
						|
	and	$b,$c,$t2
 | 
						|
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
	addl	@X[$i%16],$e,$e
 | 
						|
	bic	$d,$b,$t3
 | 
						|
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	srl	$a,27,$t0
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	or	$t2,$t3,$t2
 | 
						|
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	sll	$b,30,$b
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	srl	@X[$j%16],31,$t1
 | 
						|
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	srl	$b,32,$t3
 | 
						|
	addl	@X[$j%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	or	$t3,$b,$b
 | 
						|
	zapnot	@X[$i%16],0xf,@X[$i%16]
 | 
						|
	or	$t1,@X[$j%16],@X[$j%16]
 | 
						|
___
 | 
						|
}
 | 
						|
 | 
						|
sub BODY_20_39 {
 | 
						|
my ($i,$a,$b,$c,$d,$e)=@_;
 | 
						|
my $j=$i+1;
 | 
						|
$code.=<<___ if ($i<79);	# with forward Xupdate
 | 
						|
	sll	$a,5,$t1
 | 
						|
	addl	$K,$e,$e
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	sll	$b,30,$t3
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	xor	$b,$c,$t2
 | 
						|
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	srl	$b,2,$b
 | 
						|
	addl	@X[$i%16],$e,$e
 | 
						|
	xor	$d,$t2,$t2
 | 
						|
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	srl	@X[$j%16],31,$t1
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	srl	$a,27,$t0
 | 
						|
	addl	@X[$j%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	or	$t3,$b,$b
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	or	$t1,@X[$j%16],@X[$j%16]
 | 
						|
___
 | 
						|
$code.=<<___ if ($i<77);
 | 
						|
	zapnot	@X[$i%16],0xf,@X[$i%16]
 | 
						|
___
 | 
						|
$code.=<<___ if ($i==79);	# with context fetch
 | 
						|
	sll	$a,5,$t1
 | 
						|
	addl	$K,$e,$e
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
	ldl	@X[0],0($ctx)
 | 
						|
 | 
						|
	sll	$b,30,$t3
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	xor	$b,$c,$t2
 | 
						|
	ldl	@X[1],4($ctx)
 | 
						|
 | 
						|
	srl	$b,2,$b
 | 
						|
	addl	@X[$i%16],$e,$e
 | 
						|
	xor	$d,$t2,$t2
 | 
						|
	ldl	@X[2],8($ctx)
 | 
						|
 | 
						|
	srl	$a,27,$t0
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	ldl	@X[3],12($ctx)
 | 
						|
 | 
						|
	or	$t3,$b,$b
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	ldl	@X[4],16($ctx)
 | 
						|
___
 | 
						|
}
 | 
						|
 | 
						|
sub BODY_40_59 {
 | 
						|
my ($i,$a,$b,$c,$d,$e)=@_;
 | 
						|
my $j=$i+1;
 | 
						|
$code.=<<___;	# with forward Xupdate
 | 
						|
	sll	$a,5,$t1
 | 
						|
	addl	$K,$e,$e
 | 
						|
	zapnot	$a,0xf,$a
 | 
						|
	xor	@X[($j+2)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	srl	$a,27,$t0
 | 
						|
	and	$b,$c,$t2
 | 
						|
	and	$b,$d,$t3
 | 
						|
	xor	@X[($j+8)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	sll	$b,30,$b
 | 
						|
	addl	$t1,$e,$e
 | 
						|
	xor	@X[($j+13)%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	srl	@X[$j%16],31,$t1
 | 
						|
	addl	$t0,$e,$e
 | 
						|
	or	$t2,$t3,$t2
 | 
						|
	and	$c,$d,$t3
 | 
						|
 | 
						|
	or	$t2,$t3,$t2
 | 
						|
	srl	$b,32,$t3
 | 
						|
	addl	@X[$i%16],$e,$e
 | 
						|
	addl	@X[$j%16],@X[$j%16],@X[$j%16]
 | 
						|
 | 
						|
	or	$t3,$b,$b
 | 
						|
	addl	$t2,$e,$e
 | 
						|
	or	$t1,@X[$j%16],@X[$j%16]
 | 
						|
	zapnot	@X[$i%16],0xf,@X[$i%16]
 | 
						|
___
 | 
						|
}
 | 
						|
 | 
						|
$code=<<___;
 | 
						|
#ifdef __linux__
 | 
						|
#include <asm/regdef.h>
 | 
						|
#else
 | 
						|
#include <asm.h>
 | 
						|
#include <regdef.h>
 | 
						|
#endif
 | 
						|
 | 
						|
.text
 | 
						|
 | 
						|
.set	noat
 | 
						|
.set	noreorder
 | 
						|
.globl	sha1_block_data_order
 | 
						|
.align	5
 | 
						|
.ent	sha1_block_data_order
 | 
						|
sha1_block_data_order:
 | 
						|
	lda	sp,-64(sp)
 | 
						|
	stq	ra,0(sp)
 | 
						|
	stq	s0,8(sp)
 | 
						|
	stq	s1,16(sp)
 | 
						|
	stq	s2,24(sp)
 | 
						|
	stq	s3,32(sp)
 | 
						|
	stq	s4,40(sp)
 | 
						|
	stq	s5,48(sp)
 | 
						|
	stq	fp,56(sp)
 | 
						|
	.mask	0x0400fe00,-64
 | 
						|
	.frame	sp,64,ra
 | 
						|
	.prologue 0
 | 
						|
 | 
						|
	ldl	$A,0($ctx)
 | 
						|
	ldl	$B,4($ctx)
 | 
						|
	sll	$num,6,$num
 | 
						|
	ldl	$C,8($ctx)
 | 
						|
	ldl	$D,12($ctx)
 | 
						|
	ldl	$E,16($ctx)
 | 
						|
	addq	$inp,$num,$num
 | 
						|
 | 
						|
.Lloop:
 | 
						|
	.set	noreorder
 | 
						|
	ldah	$K,23170(zero)
 | 
						|
	zapnot	$B,0xf,$B
 | 
						|
	lda	$K,31129($K)	# K_00_19
 | 
						|
___
 | 
						|
for ($i=0;$i<20;$i++) { &BODY_00_19($i,@V); unshift(@V,pop(@V)); }
 | 
						|
 | 
						|
$code.=<<___;
 | 
						|
	ldah	$K,28378(zero)
 | 
						|
	lda	$K,-5215($K)	# K_20_39
 | 
						|
___
 | 
						|
for (;$i<40;$i++) { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
 | 
						|
 | 
						|
$code.=<<___;
 | 
						|
	ldah	$K,-28900(zero)
 | 
						|
	lda	$K,-17188($K)	# K_40_59
 | 
						|
___
 | 
						|
for (;$i<60;$i++) { &BODY_40_59($i,@V); unshift(@V,pop(@V)); }
 | 
						|
 | 
						|
$code.=<<___;
 | 
						|
	ldah	$K,-13725(zero)
 | 
						|
	lda	$K,-15914($K)	# K_60_79
 | 
						|
___
 | 
						|
for (;$i<80;$i++) { &BODY_20_39($i,@V); unshift(@V,pop(@V)); }
 | 
						|
 | 
						|
$code.=<<___;
 | 
						|
	addl	@X[0],$A,$A
 | 
						|
	addl	@X[1],$B,$B
 | 
						|
	addl	@X[2],$C,$C
 | 
						|
	addl	@X[3],$D,$D
 | 
						|
	addl	@X[4],$E,$E
 | 
						|
	stl	$A,0($ctx)
 | 
						|
	stl	$B,4($ctx)
 | 
						|
	addq	$inp,64,$inp
 | 
						|
	stl	$C,8($ctx)
 | 
						|
	stl	$D,12($ctx)
 | 
						|
	stl	$E,16($ctx)
 | 
						|
	cmpult	$inp,$num,$t1
 | 
						|
	bne	$t1,.Lloop
 | 
						|
 | 
						|
	.set	noreorder
 | 
						|
	ldq	ra,0(sp)
 | 
						|
	ldq	s0,8(sp)
 | 
						|
	ldq	s1,16(sp)
 | 
						|
	ldq	s2,24(sp)
 | 
						|
	ldq	s3,32(sp)
 | 
						|
	ldq	s4,40(sp)
 | 
						|
	ldq	s5,48(sp)
 | 
						|
	ldq	fp,56(sp)
 | 
						|
	lda	sp,64(sp)
 | 
						|
	ret	(ra)
 | 
						|
.end	sha1_block_data_order
 | 
						|
.ascii	"SHA1 block transform for Alpha, CRYPTOGAMS by <appro\@openssl.org>"
 | 
						|
.align	2
 | 
						|
___
 | 
						|
$output=pop and open STDOUT,">$output";
 | 
						|
print $code;
 | 
						|
close STDOUT or die "error closing STDOUT: $!";
 |