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

# Ascetic x86_64 AT&T to MASM/NASM assembler translator by <appro>.
#
# Why AT&T to MASM and not vice versa? Several reasons. Because AT&T
# format is way easier to parse. Because it's simpler to "gear" from
# Unix ABI to Windows one [see cross-reference "card" at the end of
# file]. Because Linux targets were available first...
#
# In addition the script also "distills" code suitable for GNU
# assembler, so that it can be compiled with more rigid assemblers,
# such as Solaris /usr/ccs/bin/as.
#
# This translator is not designed to convert *arbitrary* assembler
# code from AT&T format to MASM one. It's designed to convert just
# enough to provide for dual-ABI OpenSSL modules development...
# There *are* limitations and you might have to modify your assembler
# code or this script to achieve the desired result...
#
# Currently recognized limitations:
#
# - can't use multiple ops per line;
#
# Dual-ABI styling rules.
#
# 1. Adhere to Unix register and stack layout [see cross-reference
#    ABI "card" at the end for explanation].
# 2. Forget about "red zone," stick to more traditional blended
#    stack frame allocation. If volatile storage is actually required
#    that is. If not, just leave the stack as is.
# 3. Functions tagged with ".type name,@function" get crafted with
#    unified Win64 prologue and epilogue automatically. If you want
#    to take care of ABI differences yourself, tag functions as
#    ".type name,@abi-omnipotent" instead.
# 4. To optimize the Win64 prologue you can specify number of input
#    arguments as ".type name,@function,N." Keep in mind that if N is
#    larger than 6, then you *have to* write "abi-omnipotent" code,
#    because >6 cases can't be addressed with unified prologue.
# 5. Name local labels as .L*, do *not* use dynamic labels such as 1:
#    (sorry about latter).
# 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is
#    required to identify the spots, where to inject Win64 epilogue!
#    But on the pros, it's then prefixed with rep automatically:-)
# 7. Stick to explicit ip-relative addressing. If you have to use
#    GOTPCREL addressing, stick to mov symbol@GOTPCREL(%rip),%r??.
#    Both are recognized and translated to proper Win64 addressing
#    modes.
#
# 8. In order to provide for structured exception handling unified
#    Win64 prologue copies %rsp value to %rax. For further details
#    see SEH paragraph at the end.
# 9. .init segment is allowed to contain calls to functions only.
# a. If function accepts more than 4 arguments *and* >4th argument
#    is declared as non 64-bit value, do clear its upper part.
#
# TODO(https://crbug.com/boringssl/259): The dual-ABI mechanism described here
# does not quite unwind correctly on Windows. The seh_directive logic below has
# the start of a new mechanism.

use strict;

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

open STDOUT,">$output" || die "can't open $output: $!"
	if (defined($output));

my $gas=1;	$gas=0 if ($output =~ /\.asm$/);
my $elf=1;	$elf=0 if (!$gas);
my $apple=0;
my $win64=0;
my $prefix="";
my $decor=".L";

my $masmref=8 + 50727*2**-32;	# 8.00.50727 shipped with VS2005
my $masm=0;
my $PTR=" PTR";

my $nasmref=2.03;
my $nasm=0;

if    ($flavour eq "mingw64")	{ $gas=1; $elf=0; $win64=1;
				  # TODO(davidben): Before supporting the
				  # mingw64 perlasm flavour, do away with this
				  # environment variable check.
                                  die "mingw64 not supported";
				  $prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`;
				  $prefix =~ s|\R$||; # Better chomp
				}
elsif ($flavour eq "macosx")	{ $gas=1; $elf=0; $apple=1; $prefix="_"; $decor="L\$"; }
elsif ($flavour eq "masm")	{ $gas=0; $elf=0; $masm=$masmref; $win64=1; $decor="\$L\$"; }
elsif ($flavour eq "nasm")	{ $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $decor="\$L\$"; $PTR=""; }
elsif (!$gas)			{ die "unknown flavour $flavour"; }

my $current_segment;
my $current_function;
my %globals;

{ package opcode;	# pick up opcodes
    sub re {
	my	($class, $line) = @_;
	my	$self = {};
	my	$ret;

	if ($$line =~ /^([a-z][a-z0-9]*)/i) {
	    bless $self,$class;
	    $self->{op} = $1;
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;

	    undef $self->{sz};
	    if ($self->{op} =~ /^(movz)x?([bw]).*/) {	# movz is pain...
		$self->{op} = $1;
		$self->{sz} = $2;
	    } elsif ($self->{op} =~ /call|jmp/) {
		$self->{sz} = "";
	    } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn
		$self->{sz} = "";
	    } elsif ($self->{op} =~ /^[vk]/) { # VEX or k* such as kmov
		$self->{sz} = "";
	    } elsif ($self->{op} =~ /mov[dq]/ && $$line =~ /%xmm/) {
		$self->{sz} = "";
	    } elsif ($self->{op} =~ /^or([qlwb])$/) {
		$self->{op} = "or";
		$self->{sz} = $1;
	    } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) {
		$self->{op} = $1;
		$self->{sz} = $2;
	    }
	}
	$ret;
    }
    sub size {
	my ($self, $sz) = @_;
	$self->{sz} = $sz if (defined($sz) && !defined($self->{sz}));
	$self->{sz};
    }
    sub out {
	my $self = shift;
	if ($gas) {
	    if ($self->{op} eq "movz") {	# movz is pain...
		sprintf "%s%s%s",$self->{op},$self->{sz},shift;
	    } elsif ($self->{op} =~ /^set/) {
		"$self->{op}";
	    } elsif ($self->{op} eq "ret") {
		my $epilogue = "";
		if ($win64 && $current_function->{abi} eq "svr4") {
		    $epilogue = "movq	8(%rsp),%rdi\n\t" .
				"movq	16(%rsp),%rsi\n\t";
		}
	    	$epilogue . ".byte	0xf3,0xc3";
	    } elsif ($self->{op} eq "call" && !$elf && $current_segment eq ".init") {
		".p2align\t3\n\t.quad";
	    } else {
		"$self->{op}$self->{sz}";
	    }
	} else {
	    $self->{op} =~ s/^movz/movzx/;
	    if ($self->{op} eq "ret") {
		$self->{op} = "";
		if ($win64 && $current_function->{abi} eq "svr4") {
		    $self->{op} = "mov	rdi,QWORD$PTR\[8+rsp\]\t;WIN64 epilogue\n\t".
				  "mov	rsi,QWORD$PTR\[16+rsp\]\n\t";
	    	}
		$self->{op} .= "DB\t0F3h,0C3h\t\t;repret";
	    } elsif ($self->{op} =~ /^(pop|push)f/) {
		$self->{op} .= $self->{sz};
	    } elsif ($self->{op} eq "call" && $current_segment eq ".CRT\$XCU") {
		$self->{op} = "\tDQ";
	    }
	    $self->{op};
	}
    }
    sub mnemonic {
	my ($self, $op) = @_;
	$self->{op}=$op if (defined($op));
	$self->{op};
    }
}
{ package const;	# pick up constants, which start with $
    sub re {
	my	($class, $line) = @_;
	my	$self = {};
	my	$ret;

	if ($$line =~ /^\$([^,]+)/) {
	    bless $self, $class;
	    $self->{value} = $1;
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
	}
	$ret;
    }
    sub out {
    	my $self = shift;

	$self->{value} =~ s/\b(0b[0-1]+)/oct($1)/eig;
	if ($gas) {
	    # Solaris /usr/ccs/bin/as can't handle multiplications
	    # in $self->{value}
	    my $value = $self->{value};
	    no warnings;    # oct might complain about overflow, ignore here...
	    $value =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
	    if ($value =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg) {
		$self->{value} = $value;
	    }
	    sprintf "\$%s",$self->{value};
	} else {
	    my $value = $self->{value};
	    $value =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm);
	    sprintf "%s",$value;
	}
    }
}
{ package ea;		# pick up effective addresses: expr(%reg,%reg,scale)

    my %szmap = (	b=>"BYTE$PTR",    w=>"WORD$PTR",
			l=>"DWORD$PTR",   d=>"DWORD$PTR",
			q=>"QWORD$PTR",   o=>"OWORD$PTR",
			x=>"XMMWORD$PTR", y=>"YMMWORD$PTR",
			z=>"ZMMWORD$PTR" ) if (!$gas);

    sub re {
	my	($class, $line, $opcode) = @_;
	my	$self = {};
	my	$ret;

	# optional * ----vvv--- appears in indirect jmp/call
	if ($$line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)((?:{[^}]+})*)/) {
	    bless $self, $class;
	    $self->{asterisk} = $1;
	    $self->{label} = $2;
	    ($self->{base},$self->{index},$self->{scale})=split(/,/,$3);
	    $self->{scale} = 1 if (!defined($self->{scale}));
	    $self->{opmask} = $4;
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;

	    if ($win64 && $self->{label} =~ s/\@GOTPCREL//) {
		die if ($opcode->mnemonic() ne "mov");
		$opcode->mnemonic("lea");
	    }
	    $self->{base}  =~ s/^%//;
	    $self->{index} =~ s/^%// if (defined($self->{index}));
	    $self->{opcode} = $opcode;
	}
	$ret;
    }
    sub size {}
    sub out {
	my ($self, $sz) = @_;

	$self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
	$self->{label} =~ s/\.L/$decor/g;

	# Silently convert all EAs to 64-bit. This is required for
	# elder GNU assembler and results in more compact code,
	# *but* most importantly AES module depends on this feature!
	$self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
	$self->{base}  =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;

	# Solaris /usr/ccs/bin/as can't handle multiplications
	# in $self->{label}...
	use integer;
	$self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
	$self->{label} =~ s/\b([0-9]+\s*[\*\/\%]\s*[0-9]+)\b/eval($1)/eg;

	# Some assemblers insist on signed presentation of 32-bit
	# offsets, but sign extension is a tricky business in perl...
	if ((1<<31)<<1) {
	    $self->{label} =~ s/\b([0-9]+)\b/$1<<32>>32/eg;
	} else {
	    $self->{label} =~ s/\b([0-9]+)\b/$1>>0/eg;
	}

	# if base register is %rbp or %r13, see if it's possible to
	# flip base and index registers [for better performance]
	if (!$self->{label} && $self->{index} && $self->{scale}==1 &&
	    $self->{base} =~ /(rbp|r13)/) {
		$self->{base} = $self->{index}; $self->{index} = $1;
	}

	if ($gas) {
	    $self->{label} =~ s/^___imp_/__imp__/   if ($flavour eq "mingw64");

	    if (defined($self->{index})) {
		sprintf "%s%s(%s,%%%s,%d)%s",
					$self->{asterisk},$self->{label},
					$self->{base}?"%$self->{base}":"",
					$self->{index},$self->{scale},
					$self->{opmask};
	    } else {
		sprintf "%s%s(%%%s)%s",	$self->{asterisk},$self->{label},
					$self->{base},$self->{opmask};
	    }
	} else {
	    $self->{label} =~ s/\./\$/g;
	    $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig;
	    $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/);

	    my $mnemonic = $self->{opcode}->mnemonic();
	    ($self->{asterisk})				&& ($sz="q") ||
	    ($mnemonic =~ /^v?mov([qd])$/)		&& ($sz=$1)  ||
	    ($mnemonic =~ /^v?pinsr([qdwb])$/)		&& ($sz=$1)  ||
	    ($mnemonic =~ /^vpbroadcast([qdwb])$/)	&& ($sz=$1)  ||
	    ($mnemonic =~ /^v(?!perm)[a-z]+[fi]128$/)	&& ($sz="x");

	    $self->{opmask}  =~ s/%(k[0-7])/$1/;

	    if (defined($self->{index})) {
		sprintf "%s[%s%s*%d%s]%s",$szmap{$sz},
					$self->{label}?"$self->{label}+":"",
					$self->{index},$self->{scale},
					$self->{base}?"+$self->{base}":"",
					$self->{opmask};
	    } elsif ($self->{base} eq "rip") {
		sprintf "%s[%s]",$szmap{$sz},$self->{label};
	    } else {
		sprintf "%s[%s%s]%s",	$szmap{$sz},
					$self->{label}?"$self->{label}+":"",
					$self->{base},$self->{opmask};
	    }
	}
    }
}
{ package register;	# pick up registers, which start with %.
    sub re {
	my	($class, $line, $opcode) = @_;
	my	$self = {};
	my	$ret;

	# optional * ----vvv--- appears in indirect jmp/call
	if ($$line =~ /^(\*?)%(\w+)((?:{[^}]+})*)/) {
	    bless $self,$class;
	    $self->{asterisk} = $1;
	    $self->{value} = $2;
	    $self->{opmask} = $3;
	    $opcode->size($self->size());
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
	}
	$ret;
    }
    sub size {
	my	$self = shift;
	my	$ret;

	if    ($self->{value} =~ /^r[\d]+b$/i)	{ $ret="b"; }
	elsif ($self->{value} =~ /^r[\d]+w$/i)	{ $ret="w"; }
	elsif ($self->{value} =~ /^r[\d]+d$/i)	{ $ret="l"; }
	elsif ($self->{value} =~ /^r[\w]+$/i)	{ $ret="q"; }
	elsif ($self->{value} =~ /^[a-d][hl]$/i){ $ret="b"; }
	elsif ($self->{value} =~ /^[\w]{2}l$/i)	{ $ret="b"; }
	elsif ($self->{value} =~ /^[\w]{2}$/i)	{ $ret="w"; }
	elsif ($self->{value} =~ /^e[a-z]{2}$/i){ $ret="l"; }

	$ret;
    }
    sub out {
    	my $self = shift;
	if ($gas)	{ sprintf "%s%%%s%s",	$self->{asterisk},
						$self->{value},
						$self->{opmask}; }
	else		{ $self->{opmask} =~ s/%(k[0-7])/$1/;
			  $self->{value}.$self->{opmask}; }
    }
}
{ package label;	# pick up labels, which end with :
    sub re {
	my	($class, $line) = @_;
	my	$self = {};
	my	$ret;

	if ($$line =~ /(^[\.\w]+)\:/) {
	    bless $self,$class;
	    $self->{value} = $1;
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;

	    $self->{value} =~ s/^\.L/$decor/;
	}
	$ret;
    }
    sub out {
	my $self = shift;

	if ($gas) {
	    my $func = ($globals{$self->{value}} or $self->{value}) . ":";
	    if ($win64	&& $current_function->{name} eq $self->{value}
			&& $current_function->{abi} eq "svr4") {
		$func .= "\n";
		$func .= "	movq	%rdi,8(%rsp)\n";
		$func .= "	movq	%rsi,16(%rsp)\n";
		$func .= "	movq	%rsp,%rax\n";
		$func .= "${decor}SEH_begin_$current_function->{name}:\n";
		my $narg = $current_function->{narg};
		$narg=6 if (!defined($narg));
		$func .= "	movq	%rcx,%rdi\n" if ($narg>0);
		$func .= "	movq	%rdx,%rsi\n" if ($narg>1);
		$func .= "	movq	%r8,%rdx\n"  if ($narg>2);
		$func .= "	movq	%r9,%rcx\n"  if ($narg>3);
		$func .= "	movq	40(%rsp),%r8\n" if ($narg>4);
		$func .= "	movq	48(%rsp),%r9\n" if ($narg>5);
	    }
	    $func;
	} elsif ($self->{value} ne "$current_function->{name}") {
	    # Make all labels in masm global.
	    $self->{value} .= ":" if ($masm);
	    $self->{value} . ":";
	} elsif ($win64 && $current_function->{abi} eq "svr4") {
	    my $func =	"$current_function->{name}" .
			($nasm ? ":" : "\tPROC $current_function->{scope}") .
			"\n";
	    $func .= "	mov	QWORD$PTR\[8+rsp\],rdi\t;WIN64 prologue\n";
	    $func .= "	mov	QWORD$PTR\[16+rsp\],rsi\n";
	    $func .= "	mov	rax,rsp\n";
	    $func .= "${decor}SEH_begin_$current_function->{name}:";
	    $func .= ":" if ($masm);
	    $func .= "\n";
	    my $narg = $current_function->{narg};
	    $narg=6 if (!defined($narg));
	    $func .= "	mov	rdi,rcx\n" if ($narg>0);
	    $func .= "	mov	rsi,rdx\n" if ($narg>1);
	    $func .= "	mov	rdx,r8\n"  if ($narg>2);
	    $func .= "	mov	rcx,r9\n"  if ($narg>3);
	    $func .= "	mov	r8,QWORD$PTR\[40+rsp\]\n" if ($narg>4);
	    $func .= "	mov	r9,QWORD$PTR\[48+rsp\]\n" if ($narg>5);
	    $func .= "\n";
	} else {
	   "$current_function->{name}".
			($nasm ? ":" : "\tPROC $current_function->{scope}");
	}
    }
}
{ package expr;		# pick up expressions
    sub re {
	my	($class, $line, $opcode) = @_;
	my	$self = {};
	my	$ret;

	if ($$line =~ /(^[^,]+)/) {
	    bless $self,$class;
	    $self->{value} = $1;
	    $ret = $self;
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;

	    $self->{value} =~ s/\@PLT// if (!$elf);
	    $self->{value} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
	    $self->{value} =~ s/\.L/$decor/g;
	    $self->{opcode} = $opcode;
	}
	$ret;
    }
    sub out {
	my $self = shift;
	if ($nasm && $self->{opcode}->mnemonic()=~m/^j(?![re]cxz)/) {
	    "NEAR ".$self->{value};
	} else {
	    $self->{value};
	}
    }
}
{ package cfi_directive;
    # CFI directives annotate instructions that are significant for
    # stack unwinding procedure compliant with DWARF specification,
    # see http://dwarfstd.org/. Besides naturally expected for this
    # script platform-specific filtering function, this module adds
    # three auxiliary synthetic directives not recognized by [GNU]
    # assembler:
    #
    # - .cfi_push to annotate push instructions in prologue, which
    #   translates to .cfi_adjust_cfa_offset (if needed) and
    #   .cfi_offset;
    # - .cfi_pop to annotate pop instructions in epilogue, which
    #   translates to .cfi_adjust_cfa_offset (if needed) and
    #   .cfi_restore;
    # - [and most notably] .cfi_cfa_expression which encodes
    #   DW_CFA_def_cfa_expression and passes it to .cfi_escape as
    #   byte vector;
    #
    # CFA expressions were introduced in DWARF specification version
    # 3 and describe how to deduce CFA, Canonical Frame Address. This
    # becomes handy if your stack frame is variable and you can't
    # spare register for [previous] frame pointer. Suggested directive
    # syntax is made-up mix of DWARF operator suffixes [subset of]
    # and references to registers with optional bias. Following example
    # describes offloaded *original* stack pointer at specific offset
    # from *current* stack pointer:
    #
    #   .cfi_cfa_expression     %rsp+40,deref,+8
    #
    # Final +8 has everything to do with the fact that CFA is defined
    # as reference to top of caller's stack, and on x86_64 call to
    # subroutine pushes 8-byte return address. In other words original
    # stack pointer upon entry to a subroutine is 8 bytes off from CFA.

    # Below constants are taken from "DWARF Expressions" section of the
    # DWARF specification, section is numbered 7.7 in versions 3 and 4.
    my %DW_OP_simple = (	# no-arg operators, mapped directly
	deref	=> 0x06,	dup	=> 0x12,
	drop	=> 0x13,	over	=> 0x14,
	pick	=> 0x15,	swap	=> 0x16,
	rot	=> 0x17,	xderef	=> 0x18,

	abs	=> 0x19,	and	=> 0x1a,
	div	=> 0x1b,	minus	=> 0x1c,
	mod	=> 0x1d,	mul	=> 0x1e,
	neg	=> 0x1f,	not	=> 0x20,
	or	=> 0x21,	plus	=> 0x22,
	shl	=> 0x24,	shr	=> 0x25,
	shra	=> 0x26,	xor	=> 0x27,
	);

    my %DW_OP_complex = (	# used in specific subroutines
	constu		=> 0x10,	# uleb128
	consts		=> 0x11,	# sleb128
	plus_uconst	=> 0x23,	# uleb128
	lit0 		=> 0x30,	# add 0-31 to opcode
	reg0		=> 0x50,	# add 0-31 to opcode
	breg0		=> 0x70,	# add 0-31 to opcole, sleb128
	regx		=> 0x90,	# uleb28
	fbreg		=> 0x91,	# sleb128
	bregx		=> 0x92,	# uleb128, sleb128
	piece		=> 0x93,	# uleb128
	);

    # Following constants are defined in x86_64 ABI supplement, for
    # example available at https://www.uclibc.org/docs/psABI-x86_64.pdf,
    # see section 3.7 "Stack Unwind Algorithm".
    my %DW_reg_idx = (
	"%rax"=>0,  "%rdx"=>1,  "%rcx"=>2,  "%rbx"=>3,
	"%rsi"=>4,  "%rdi"=>5,  "%rbp"=>6,  "%rsp"=>7,
	"%r8" =>8,  "%r9" =>9,  "%r10"=>10, "%r11"=>11,
	"%r12"=>12, "%r13"=>13, "%r14"=>14, "%r15"=>15
	);

    my ($cfa_reg, $cfa_rsp);
    my @cfa_stack;

    # [us]leb128 format is variable-length integer representation base
    # 2^128, with most significant bit of each byte being 0 denoting
    # *last* most significant digit. See "Variable Length Data" in the
    # DWARF specification, numbered 7.6 at least in versions 3 and 4.
    sub sleb128 {
	use integer;	# get right shift extend sign

	my $val = shift;
	my $sign = ($val < 0) ? -1 : 0;
	my @ret = ();

	while(1) {
	    push @ret, $val&0x7f;

	    # see if remaining bits are same and equal to most
	    # significant bit of the current digit, if so, it's
	    # last digit...
	    last if (($val>>6) == $sign);

	    @ret[-1] |= 0x80;
	    $val >>= 7;
	}

	return @ret;
    }
    sub uleb128 {
	my $val = shift;
	my @ret = ();

	while(1) {
	    push @ret, $val&0x7f;

	    # see if it's last significant digit...
	    last if (($val >>= 7) == 0);

	    @ret[-1] |= 0x80;
	}

	return @ret;
    }
    sub const {
	my $val = shift;

	if ($val >= 0 && $val < 32) {
            return ($DW_OP_complex{lit0}+$val);
	}
	return ($DW_OP_complex{consts}, sleb128($val));
    }
    sub reg {
	my $val = shift;

	return if ($val !~ m/^(%r\w+)(?:([\+\-])((?:0x)?[0-9a-f]+))?/);

	my $reg = $DW_reg_idx{$1};
	my $off = eval ("0 $2 $3");

	return (($DW_OP_complex{breg0} + $reg), sleb128($off));
	# Yes, we use DW_OP_bregX+0 to push register value and not
	# DW_OP_regX, because latter would require even DW_OP_piece,
	# which would be a waste under the circumstances. If you have
	# to use DWP_OP_reg, use "regx:N"...
    }
    sub cfa_expression {
	my $line = shift;
	my @ret;

	foreach my $token (split(/,\s*/,$line)) {
	    if ($token =~ /^%r/) {
		push @ret,reg($token);
	    } elsif ($token =~ /((?:0x)?[0-9a-f]+)\((%r\w+)\)/) {
		push @ret,reg("$2+$1");
	    } elsif ($token =~ /(\w+):(\-?(?:0x)?[0-9a-f]+)(U?)/i) {
		my $i = 1*eval($2);
		push @ret,$DW_OP_complex{$1}, ($3 ? uleb128($i) : sleb128($i));
	    } elsif (my $i = 1*eval($token) or $token eq "0") {
		if ($token =~ /^\+/) {
		    push @ret,$DW_OP_complex{plus_uconst},uleb128($i);
		} else {
		    push @ret,const($i);
		}
	    } else {
		push @ret,$DW_OP_simple{$token};
	    }
	}

	# Finally we return DW_CFA_def_cfa_expression, 15, followed by
	# length of the expression and of course the expression itself.
	return (15,scalar(@ret),@ret);
    }
    sub re {
	my	($class, $line) = @_;
	my	$self = {};
	my	$ret;

	if ($$line =~ s/^\s*\.cfi_(\w+)\s*//) {
	    bless $self,$class;
	    $ret = $self;
	    undef $self->{value};
	    my $dir = $1;

	    SWITCH: for ($dir) {
	    # What is $cfa_rsp? Effectively it's difference between %rsp
	    # value and current CFA, Canonical Frame Address, which is
	    # why it starts with -8. Recall that CFA is top of caller's
	    # stack...
	    /startproc/	&& do {	($cfa_reg, $cfa_rsp) = ("%rsp", -8); last; };
	    /endproc/	&& do {	($cfa_reg, $cfa_rsp) = ("%rsp",  0); last; };
	    /def_cfa_register/
			&& do {	$cfa_reg = $$line; last; };
	    /def_cfa_offset/
			&& do {	$cfa_rsp = -1*eval($$line) if ($cfa_reg eq "%rsp");
				last;
			      };
	    /adjust_cfa_offset/
			&& do {	$cfa_rsp -= 1*eval($$line) if ($cfa_reg eq "%rsp");
				last;
			      };
	    /def_cfa/	&& do {	if ($$line =~ /(%r\w+)\s*,\s*(.+)/) {
				    $cfa_reg = $1;
				    $cfa_rsp = -1*eval($2) if ($cfa_reg eq "%rsp");
				}
				last;
			      };
	    /push/	&& do {	$dir = undef;
				$cfa_rsp -= 8;
				if ($cfa_reg eq "%rsp") {
				    $self->{value} = ".cfi_adjust_cfa_offset\t8\n";
				}
				$self->{value} .= ".cfi_offset\t$$line,$cfa_rsp";
				last;
			      };
	    /pop/	&& do {	$dir = undef;
				$cfa_rsp += 8;
				if ($cfa_reg eq "%rsp") {
				    $self->{value} = ".cfi_adjust_cfa_offset\t-8\n";
				}
				$self->{value} .= ".cfi_restore\t$$line";
				last;
			      };
	    /cfa_expression/
			&& do {	$dir = undef;
				$self->{value} = ".cfi_escape\t" .
					join(",", map(sprintf("0x%02x", $_),
						      cfa_expression($$line)));
				last;
			      };
	    /remember_state/
			&& do {	push @cfa_stack, [$cfa_reg, $cfa_rsp];
				last;
			      };
	    /restore_state/
			&& do {	($cfa_reg, $cfa_rsp) = @{pop @cfa_stack};
				last;
			      };
	    }

	    $self->{value} = ".cfi_$dir\t$$line" if ($dir);

	    $$line = "";
	}

	return $ret;
    }
    sub out {
	my $self = shift;
	return ($elf ? $self->{value} : undef);
    }
}
{ package seh_directive;
    # This implements directives, like MASM's, for specifying Windows unwind
    # codes. See https://learn.microsoft.com/en-us/cpp/build/exception-handling-x64?view=msvc-170
    # for details on the Windows unwind mechanism. Unlike MASM's directives, we
    # have no .seh_endprolog directive. Instead, the last prolog directive is
    # implicitly the end of the prolog.
    #
    # TODO(https://crbug.com/boringssl/259): For now, SEH directives are ignored
    # on non-Windows platforms. This means functions need to specify both CFI
    # and SEH directives, often redundantly. Ideally we'd abstract between the
    # two. E.g., we can synthesize CFI from SEH prologs, but SEH does not
    # annotate epilogs, so we'd need to combine parts from both. Or we can
    # restrict ourselves to a subset of CFI and synthesize SEH from CFI.
    #
    # Additionally, this only supports @abi-omnipotent functions. It is
    # incompatible with the automatic calling convention conversion. The main
    # complication is the current scheme modifies RDI and RSI (non-volatile on
    # Windows) at the start of the function, and saves them in the parameter
    # stack area. This can be expressed with .seh_savereg, but .seh_savereg is
    # only usable late in the prolog. However, unwind information gives enough
    # information to locate the parameter stack area at any point in the
    # function, so we can defer conversion or implement other schemes.

    my $UWOP_PUSH_NONVOL = 0;
    my $UWOP_ALLOC_LARGE = 1;
    my $UWOP_ALLOC_SMALL = 2;
    my $UWOP_SET_FPREG = 3;
    my $UWOP_SAVE_NONVOL = 4;
    my $UWOP_SAVE_NONVOL_FAR = 5;
    my $UWOP_SAVE_XMM128 = 8;
    my $UWOP_SAVE_XMM128_FAR = 9;

    my %UWOP_REG_TO_NUMBER = ("%rax" => 0, "%rcx" => 1, "%rdx" => 2, "%rbx" => 3,
			      "%rsp" => 4, "%rbp" => 5, "%rsi" => 6, "%rdi" => 7,
			      map(("%r$_" => $_), (8..15)));
    my %UWOP_NUMBER_TO_REG = reverse %UWOP_REG_TO_NUMBER;

    # The contents of the pdata and xdata sections so far.
    my ($xdata, $pdata) = ("", "");

    my %info;

    my $next_label = 0;
    my $current_label_func = "";

    # _new_unwind_label allocates a new label, unique to the file.
    sub _new_unwind_label {
	my ($name) = (@_);
	# Labels only need to be unique, but to make diffs easier to read, scope
	# them all under the current function.
	my $func = $current_function->{name};
	if ($func ne $current_label_func) {
	    $current_label_func = $func;
	    $next_label = 0;
	}

	my $num = $next_label++;
	return ".LSEH_${name}_${func}_${num}";
    }

    sub _check_in_proc {
	die "Missing .seh_startproc directive" unless %info;
    }

    sub _check_not_in_proc {
	die "Missing .seh_endproc directive" if %info;
    }

    sub _startproc {
	_check_not_in_proc();
	if ($current_function->{abi} eq "svr4") {
	    die "SEH directives can only be used with \@abi-omnipotent";
	}

	my $info_label = _new_unwind_label("info");
	my $start_label = _new_unwind_label("begin");
	%info = (
	    # info_label is the label of the function's entry in .xdata.
	    info_label => $info_label,
	    # start_label is the start of the function.
	    start_label => $start_label,
	    # endprolog is the label of the last unwind code in the function.
	    endprolog => $start_label,
	    # unwind_codes contains the textual representation of the
	    # unwind codes in the function so far.
	    unwind_codes => "",
	    # num_codes is the number of 16-bit words in unwind_codes.
	    num_codes => 0,
	    # frame_reg is the number of the frame register, or zero if
	    # there is none.
	    frame_reg => 0,
	    # frame_offset is the offset into the fixed part of the stack that
	    # the frame register points into.
	    frame_offset => 0,
	    # has_offset is whether directives taking an offset have
	    # been used. This is used to check that such directives
	    # come after the fixed portion of the stack frame is established.
	    has_offset => 0,
	    # has_nonpushreg is whether directives other than
	    # .seh_pushreg have been used. This is used to check that
	    # .seh_pushreg directives are first.
	    has_nonpushreg => 0,
	);
	return $start_label;
    }

    sub _add_unwind_code {
	my ($op, $value, @extra) = @_;
	_check_in_proc();
	if ($op != $UWOP_PUSH_NONVOL) {
	    $info{has_nonpushreg} = 1;
	} elsif ($info{has_nonpushreg}) {
	    die ".seh_pushreg directives must appear first in the prolog";
	}

	my $label = _new_unwind_label("prolog");
	# Encode an UNWIND_CODE structure. See
	# https://learn.microsoft.com/en-us/cpp/build/exception-handling-x64?view=msvc-170#struct-unwind_code
	my $encoded = $op | ($value << 4);
	my $codes = <<____;
	.byte	$label-$info{start_label}
	.byte	$encoded
____
	# Some opcodes need additional values to encode themselves.
	foreach (@extra) {
	    $codes .= "\t.value\t$_\n";
	}

	$info{num_codes} += 1 + scalar(@extra);
	# Unwind codes are listed in reverse order.
	$info{unwind_codes} = $codes . $info{unwind_codes};
	# Track the label of the last unwind code. It implicitly is the end of
	# the prolog. MASM has an endprolog directive, but it seems to be
	# unnecessary.
	$info{endprolog} = $label;
	return $label;
    }

    sub _updating_fixed_allocation {
	_check_in_proc();
	if ($info{frame_reg} != 0) {
	    # Windows documentation does not explicitly forbid .seh_allocstack
	    # after .seh_setframe, but it appears to have no effect. Offsets are
	    # still relative to the fixed allocation when the frame register was
	    # established.
	    die "fixed allocation may not be increased after .seh_setframe";
	}
	if ($info{has_offset}) {
	    # Windows documentation does not explicitly forbid .seh_savereg
	    # before .seh_allocstack, but it does not work very well. Offsets
	    # are relative to the top of the final fixed allocation, not where
	    # RSP currently is.
	    die "directives with an offset must come after the fixed allocation is established.";
	}
    }

    sub _endproc {
	_check_in_proc();
	if ($info{num_codes} == 0) {
	    # If a Windows function has no directives (i.e. it doesn't touch the
	    # stack), it is a leaf function and is not expected to appear in
	    # .pdata or .xdata.
	    die ".seh_endproc found with no unwind codes";
	}

	my $end_label = _new_unwind_label("end");
	# Encode a RUNTIME_FUNCTION. See
	# https://learn.microsoft.com/en-us/cpp/build/exception-handling-x64?view=msvc-170#struct-runtime_function
	$pdata .= <<____;
	.rva	$info{start_label}
	.rva	$end_label
	.rva	$info{info_label}

____

	# Encode an UNWIND_INFO. See
	# https://learn.microsoft.com/en-us/cpp/build/exception-handling-x64?view=msvc-170#struct-unwind_info
	my $frame_encoded = $info{frame_reg} | (($info{frame_offset} / 16) << 4);
	$xdata .= <<____;
$info{info_label}:
	.byte	1	# version 1, no flags
	.byte	$info{endprolog}-$info{start_label}
	.byte	$info{num_codes}
	.byte	$frame_encoded
$info{unwind_codes}
____

	%info = ();
	return $end_label;
    }

    sub re {
	my ($class, $line) = @_;
	if ($$line =~ s/^\s*\.seh_(\w+)\s*//) {
	    my $dir = $1;
	    if (!$win64) {
		$$line = "";
		return;
	    }

	    my $label;
	    SWITCH: for ($dir) {
		/^startproc$/ && do {
		    $label = _startproc();
		    last;
		};
		/^pushreg$/ && do {
		    $$line =~ /^(%\w+)\s*$/ or die "could not parse .seh_$dir";
		    my $reg_num = $UWOP_REG_TO_NUMBER{$1} or die "unknown register $1";
		    _updating_fixed_allocation();
		    $label = _add_unwind_code($UWOP_PUSH_NONVOL, $reg_num);
		    last;
		};
		/^allocstack$/ && do {
		    my $num = eval($$line);
		    if ($num <= 0 || $num % 8 != 0) {
			die "invalid stack allocation: $num";
		    }
		    _updating_fixed_allocation();
		    if ($num <= 128) {
			$label = _add_unwind_code($UWOP_ALLOC_SMALL, ($num - 8) / 8);
		    } elsif ($num < 512 * 1024) {
			$label = _add_unwind_code($UWOP_ALLOC_LARGE, 0, $num / 8);
		    } elsif ($num < 4 * 1024 * 1024 * 1024) {
			$label = _add_unwind_code($UWOP_ALLOC_LARGE, 1, $num >> 16, $num & 0xffff);
		    } else {
			die "stack allocation too large: $num"
		    }
		    last;
		};
		/^setframe$/ && do {
		    if ($info{frame_reg} != 0) {
			die "duplicate .seh_setframe directive";
		    }
		    if ($info{has_offset}) {
			die "directives with with an offset must come after .seh_setframe.";
		    }
		    $$line =~ /(%\w+)\s*,\s*(.+)/ or die "could not parse .seh_$dir";
		    my $reg_num = $UWOP_REG_TO_NUMBER{$1} or die "unknown register $1";
		    my $offset = eval($2);
		    if ($offset < 0 || $offset % 16 != 0 || $offset > 240) {
			die "invalid offset: $offset";
		    }
		    $info{frame_reg} = $reg_num;
		    $info{frame_offset} = $offset;
		    $label = _add_unwind_code($UWOP_SET_FPREG, 0);
		    last;
		};
		/^savereg$/ && do {
		    $$line =~ /(%\w+)\s*,\s*(.+)/ or die "could not parse .seh_$dir";
		    my $reg_num = $UWOP_REG_TO_NUMBER{$1} or die "unknown register $1";
		    my $offset = eval($2);
		    if ($offset < 0 || $offset % 8 != 0) {
			die "invalid offset: $offset";
		    }
		    if ($offset < 8 * 65536) {
			$label = _add_unwind_code($UWOP_SAVE_NONVOL, $reg_num, $offset / 8);
		    } else {
			$label = _add_unwind_code($UWOP_SAVE_NONVOL_FAR, $reg_num, $offset >> 16, $offset & 0xffff);
		    }
		    $info{has_offset} = 1;
		    last;
		};
		/^savexmm128$/ && do {
		    $$line =~ /%xmm(\d+)\s*,\s*(.+)/ or die "could not parse .seh_$dir";
		    my $reg_num = $1;
		    my $offset = eval($2);
		    if ($offset < 0 || $offset % 16 != 0) {
			die "invalid offset: $offset";
		    }
		    if ($offset < 16 * 65536) {
			$label = _add_unwind_code($UWOP_SAVE_XMM128, $reg_num, $offset / 16);
		    } else {
			$label = _add_unwind_code($UWOP_SAVE_XMM128_FAR, $reg_num, $offset >> 16, $offset & 0xffff);
		    }
		    $info{has_offset} = 1;
		    last;
		};
		/^endproc$/ && do {
		    $label = _endproc();
		    last;
		};
		die "unknown SEH directive .seh_$dir";
	    }

	    # All SEH directives compile to labels inline. The other data is
	    # emitted later.
	    $$line = "";
	    $label .= ":";
	    return label->re(\$label);
	}
    }

    sub pdata_and_xdata {
	return "" unless $win64;

	my $ret = "";
	if ($pdata ne "") {
	    $ret .= <<____;
.section	.pdata
.align	4
$pdata
____
	}
	if ($xdata ne "") {
	    $ret .= <<____;
.section	.xdata
.align	4
$xdata
____
	}
	return $ret;
    }
}
{ package directive;	# pick up directives, which start with .
    my %sections;
    sub nasm_section {
	my ($name, $qualifiers) = @_;
	my $ret = "section\t$name";
	if (exists $sections{$name}) {
	    # Work around https://bugzilla.nasm.us/show_bug.cgi?id=3392701. Only
	    # emit section qualifiers the first time a section is referenced.
	    # For all subsequent references, require the qualifiers match and
	    # omit them.
	    #
	    # See also https://crbug.com/1422018 and b/270643835.
	    my $old = $sections{$name};
	    die "Inconsistent qualifiers: $qualifiers vs $old" if ($qualifiers ne "" && $qualifiers ne $old);
	} else {
	    $sections{$name} = $qualifiers;
	    if ($qualifiers ne "") {
		$ret .= " $qualifiers";
	    }
	}
	return $ret;
    }
    sub re {
	my	($class, $line) = @_;
	my	$self = {};
	my	$ret;
	my	$dir;

	# chain-call to cfi_directive and seh_directive.
	$ret = cfi_directive->re($line) and return $ret;
	$ret = seh_directive->re($line) and return $ret;

	if ($$line =~ /^\s*(\.\w+)/) {
	    bless $self,$class;
	    $dir = $1;
	    $ret = $self;
	    undef $self->{value};
	    $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;

	    SWITCH: for ($dir) {
		/\.global|\.globl|\.extern/
			    && do { $globals{$$line} = $prefix . $$line;
				    $$line = $globals{$$line} if ($prefix);
				    last;
				  };
		/\.type/    && do { my ($sym,$type,$narg) = split(/\s*,\s*/,$$line);
				    if ($type eq "\@function") {
					undef $current_function;
					$current_function->{name} = $sym;
					$current_function->{abi}  = "svr4";
					$current_function->{narg} = $narg;
					$current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE";
				    } elsif ($type eq "\@abi-omnipotent") {
					undef $current_function;
					$current_function->{name} = $sym;
					$current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE";
				    }
				    $$line =~ s/\@abi\-omnipotent/\@function/;
				    $$line =~ s/\@function.*/\@function/;
				    last;
				  };
		/\.asciz/   && do { if ($$line =~ /^"(.*)"$/) {
					$dir  = ".byte";
					$$line = join(",",unpack("C*",$1),0);
				    }
				    last;
				  };
		/\.rva|\.long|\.quad|\.byte/
			    && do { $$line =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
				    $$line =~ s/\.L/$decor/g;
				    last;
				  };
	    }

	    if ($gas) {
		$self->{value} = $dir . "\t" . $$line;

		if ($dir =~ /\.extern/) {
		    if ($flavour eq "elf") {
			$self->{value} .= "\n.hidden $$line";
		    } else {
			$self->{value} = "";
		    }
		} elsif (!$elf && $dir =~ /\.type/) {
		    $self->{value} = "";
		    $self->{value} = ".def\t" . ($globals{$1} or $1) . ";\t" .
				(defined($globals{$1})?".scl 2;":".scl 3;") .
				"\t.type 32;\t.endef"
				if ($win64 && $$line =~ /([^,]+),\@function/);
		} elsif (!$elf && $dir =~ /\.size/) {
		    $self->{value} = "";
		    if (defined($current_function)) {
			$self->{value} .= "${decor}SEH_end_$current_function->{name}:"
				if ($win64 && $current_function->{abi} eq "svr4");
			undef $current_function;
		    }
		} elsif (!$elf && $dir =~ /\.align/) {
		    $self->{value} = ".p2align\t" . (log($$line)/log(2));
		} elsif ($dir eq ".section") {
		    $current_segment=$$line;
		    if (!$elf && $current_segment eq ".rodata") {
			if	($flavour eq "macosx") { $self->{value} = ".section\t__DATA,__const"; }
		    }
		    if (!$elf && $current_segment eq ".init") {
			if	($flavour eq "macosx")	{ $self->{value} = ".mod_init_func"; }
			elsif	($flavour eq "mingw64")	{ $self->{value} = ".section\t.ctors"; }
		    }
		} elsif ($dir =~ /\.(text|data)/) {
		    $current_segment=".$1";
		} elsif ($dir =~ /\.global|\.globl|\.extern/) {
		    if ($flavour eq "macosx") {
		        $self->{value} .= "\n.private_extern $$line";
		    } else {
		        $self->{value} .= "\n.hidden $$line";
		    }
		} elsif ($dir =~ /\.hidden/) {
		    if    ($flavour eq "macosx")  { $self->{value} = ".private_extern\t$prefix$$line"; }
		    elsif ($flavour eq "mingw64") { $self->{value} = ""; }
		} elsif ($dir =~ /\.comm/) {
		    $self->{value} = "$dir\t$prefix$$line";
		    $self->{value} =~ s|,([0-9]+),([0-9]+)$|",$1,".log($2)/log(2)|e if ($flavour eq "macosx");
		}
		$$line = "";
		return $self;
	    }

	    # non-gas case or nasm/masm
	    SWITCH: for ($dir) {
		/\.text/    && do { my $v=undef;
				    if ($nasm) {
					$v=nasm_section(".text", "code align=64")."\n";
				    } else {
					$v="$current_segment\tENDS\n" if ($current_segment);
					$current_segment = ".text\$";
					$v.="$current_segment\tSEGMENT ";
					$v.=$masm>=$masmref ? "ALIGN(256)" : "PAGE";
					$v.=" 'CODE'";
				    }
				    $self->{value} = $v;
				    last;
				  };
		/\.data/    && do { my $v=undef;
				    if ($nasm) {
					$v=nasm_section(".data", "data align=8")."\n";
				    } else {
					$v="$current_segment\tENDS\n" if ($current_segment);
					$current_segment = "_DATA";
					$v.="$current_segment\tSEGMENT";
				    }
				    $self->{value} = $v;
				    last;
				  };
		/\.section/ && do { my $v=undef;
				    $$line =~ s/([^,]*).*/$1/;
				    $$line = ".CRT\$XCU" if ($$line eq ".init");
				    $$line = ".rdata" if ($$line eq ".rodata");
				    if ($nasm) {
					my $qualifiers = "";
					if ($$line=~/\.([prx])data/) {
					    $qualifiers = "rdata align=";
					    $qualifiers .= $1 eq "p"? 4 : 8;
					} elsif ($$line=~/\.CRT\$/i) {
					    $qualifiers = "rdata align=8";
					}
					$v = nasm_section($$line, $qualifiers);
				    } else {
					$v="$current_segment\tENDS\n" if ($current_segment);
					$v.="$$line\tSEGMENT";
					if ($$line=~/\.([prx])data/) {
					    $v.=" READONLY";
					    $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref);
					} elsif ($$line=~/\.CRT\$/i) {
					    $v.=" READONLY ";
					    $v.=$masm>=$masmref ? "ALIGN(8)" : "DWORD";
					}
				    }
				    $current_segment = $$line;
				    $self->{value} = $v;
				    last;
				  };
		/\.extern/  && do { $self->{value}  = "EXTERN\t".$$line;
				    $self->{value} .= ":NEAR" if ($masm);
				    last;
				  };
		/\.globl|.global/
			    && do { $self->{value}  = $masm?"PUBLIC":"global";
				    $self->{value} .= "\t".$$line;
				    last;
				  };
		/\.size/    && do { if (defined($current_function)) {
					undef $self->{value};
					if ($current_function->{abi} eq "svr4") {
					    $self->{value}="${decor}SEH_end_$current_function->{name}:";
					    $self->{value}.=":\n" if($masm);
					}
					$self->{value}.="$current_function->{name}\tENDP" if($masm && $current_function->{name});
					undef $current_function;
				    }
				    last;
				  };
		/\.align/   && do { my $max = ($masm && $masm>=$masmref) ? 256 : 4096;
				    $self->{value} = "ALIGN\t".($$line>$max?$max:$$line);
				    last;
				  };
		/\.(value|long|rva|quad)/
			    && do { my $sz  = substr($1,0,1);
				    my @arr = split(/,\s*/,$$line);
				    my $last = pop(@arr);
				    my $conv = sub  {	my $var=shift;
							$var=~s/^(0b[0-1]+)/oct($1)/eig;
							$var=~s/^0x([0-9a-f]+)/0$1h/ig if ($masm);
							if ($sz eq "D" && ($current_segment=~/.[px]data/ || $dir eq ".rva"))
							{ $var=~s/^([_a-z\$\@][_a-z0-9\$\@]*)/$nasm?"$1 wrt ..imagebase":"imagerel $1"/egi; }
							$var;
						    };

				    $sz =~ tr/bvlrq/BWDDQ/;
				    $self->{value} = "\tD$sz\t";
				    for (@arr) { $self->{value} .= &$conv($_).","; }
				    $self->{value} .= &$conv($last);
				    last;
				  };
		/\.byte/    && do { my @str=split(/,\s*/,$$line);
				    map(s/(0b[0-1]+)/oct($1)/eig,@str);
				    map(s/0x([0-9a-f]+)/0$1h/ig,@str) if ($masm);
				    while ($#str>15) {
					$self->{value}.="\tDB\t"
						.join(",",@str[0..15])."\n";
					foreach (0..15) { shift @str; }
				    }
				    $self->{value}.="\tDB\t"
						.join(",",@str) if (@str);
				    last;
				  };
		/\.comm/    && do { my @str=split(/,\s*/,$$line);
				    my $v=undef;
				    if ($nasm) {
					$v.="common	$prefix@str[0] @str[1]";
				    } else {
					$v="$current_segment\tENDS\n" if ($current_segment);
					$current_segment = "_DATA";
					$v.="$current_segment\tSEGMENT\n";
					$v.="COMM	@str[0]:DWORD:".@str[1]/4;
				    }
				    $self->{value} = $v;
				    last;
				  };
	    }
	    $$line = "";
	}

	$ret;
    }
    sub out {
	my $self = shift;
	$self->{value};
    }
}

# Upon initial x86_64 introduction SSE>2 extensions were not introduced
# yet. In order not to be bothered by tracing exact assembler versions,
# but at the same time to provide a bare security minimum of AES-NI, we
# hard-code some instructions. Extensions past AES-NI on the other hand
# are traced by examining assembler version in individual perlasm
# modules...

my %regrm = (	"%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3,
		"%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7	);

sub rex {
 my $opcode=shift;
 my ($dst,$src,$rex)=@_;

   $rex|=0x04 if($dst>=8);
   $rex|=0x01 if($src>=8);
   push @$opcode,($rex|0x40) if ($rex);
}

my $movq = sub {	# elderly gas can't handle inter-register movq
  my $arg = shift;
  my @opcode=(0x66);
    if ($arg =~ /%xmm([0-9]+),\s*%r(\w+)/) {
	my ($src,$dst)=($1,$2);
	if ($dst !~ /[0-9]+/)	{ $dst = $regrm{"%e$dst"}; }
	rex(\@opcode,$src,$dst,0x8);
	push @opcode,0x0f,0x7e;
	push @opcode,0xc0|(($src&7)<<3)|($dst&7);	# ModR/M
	@opcode;
    } elsif ($arg =~ /%r(\w+),\s*%xmm([0-9]+)/) {
	my ($src,$dst)=($2,$1);
	if ($dst !~ /[0-9]+/)	{ $dst = $regrm{"%e$dst"}; }
	rex(\@opcode,$src,$dst,0x8);
	push @opcode,0x0f,0x6e;
	push @opcode,0xc0|(($src&7)<<3)|($dst&7);	# ModR/M
	@opcode;
    } else {
	();
    }
};

my $pextrd = sub {
    if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*(%\w+)/) {
      my @opcode=(0x66);
	my $imm=$1;
	my $src=$2;
	my $dst=$3;
	if ($dst =~ /%r([0-9]+)d/)	{ $dst = $1; }
	elsif ($dst =~ /%e/)		{ $dst = $regrm{$dst}; }
	rex(\@opcode,$src,$dst);
	push @opcode,0x0f,0x3a,0x16;
	push @opcode,0xc0|(($src&7)<<3)|($dst&7);	# ModR/M
	push @opcode,$imm;
	@opcode;
    } else {
	();
    }
};

my $pinsrd = sub {
    if (shift =~ /\$([0-9]+),\s*(%\w+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x66);
	my $imm=$1;
	my $src=$2;
	my $dst=$3;
	if ($src =~ /%r([0-9]+)/)	{ $src = $1; }
	elsif ($src =~ /%e/)		{ $src = $regrm{$src}; }
	rex(\@opcode,$dst,$src);
	push @opcode,0x0f,0x3a,0x22;
	push @opcode,0xc0|(($dst&7)<<3)|($src&7);	# ModR/M
	push @opcode,$imm;
	@opcode;
    } else {
	();
    }
};

my $pshufb = sub {
    if (shift =~ /%xmm([0-9]+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x66);
	rex(\@opcode,$2,$1);
	push @opcode,0x0f,0x38,0x00;
	push @opcode,0xc0|($1&7)|(($2&7)<<3);		# ModR/M
	@opcode;
    } else {
	();
    }
};

my $palignr = sub {
    if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x66);
	rex(\@opcode,$3,$2);
	push @opcode,0x0f,0x3a,0x0f;
	push @opcode,0xc0|($2&7)|(($3&7)<<3);		# ModR/M
	push @opcode,$1;
	@opcode;
    } else {
	();
    }
};

my $pclmulqdq = sub {
    if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x66);
	rex(\@opcode,$3,$2);
	push @opcode,0x0f,0x3a,0x44;
	push @opcode,0xc0|($2&7)|(($3&7)<<3);		# ModR/M
	my $c=$1;
	push @opcode,$c=~/^0/?oct($c):$c;
	@opcode;
    } else {
	();
    }
};

my $rdrand = sub {
    if (shift =~ /%[er](\w+)/) {
      my @opcode=();
      my $dst=$1;
	if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
	rex(\@opcode,0,$dst,8);
	push @opcode,0x0f,0xc7,0xf0|($dst&7);
	@opcode;
    } else {
	();
    }
};

my $rdseed = sub {
    if (shift =~ /%[er](\w+)/) {
      my @opcode=();
      my $dst=$1;
	if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
	rex(\@opcode,0,$dst,8);
	push @opcode,0x0f,0xc7,0xf8|($dst&7);
	@opcode;
    } else {
	();
    }
};

# Not all AVX-capable assemblers recognize AMD XOP extension. Since we
# are using only two instructions hand-code them in order to be excused
# from chasing assembler versions...

sub rxb {
 my $opcode=shift;
 my ($dst,$src1,$src2,$rxb)=@_;

   $rxb|=0x7<<5;
   $rxb&=~(0x04<<5) if($dst>=8);
   $rxb&=~(0x01<<5) if($src1>=8);
   $rxb&=~(0x02<<5) if($src2>=8);
   push @$opcode,$rxb;
}

my $vprotd = sub {
    if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x8f);
	rxb(\@opcode,$3,$2,-1,0x08);
	push @opcode,0x78,0xc2;
	push @opcode,0xc0|($2&7)|(($3&7)<<3);		# ModR/M
	my $c=$1;
	push @opcode,$c=~/^0/?oct($c):$c;
	@opcode;
    } else {
	();
    }
};

my $vprotq = sub {
    if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
      my @opcode=(0x8f);
	rxb(\@opcode,$3,$2,-1,0x08);
	push @opcode,0x78,0xc3;
	push @opcode,0xc0|($2&7)|(($3&7)<<3);		# ModR/M
	my $c=$1;
	push @opcode,$c=~/^0/?oct($c):$c;
	@opcode;
    } else {
	();
    }
};

# Intel Control-flow Enforcement Technology extension. All functions and
# indirect branch targets will have to start with this instruction...

my $endbranch = sub {
    (0xf3,0x0f,0x1e,0xfa);
};

########################################################################

{
  my $comment = "//";
  $comment = ";" if ($masm || $nasm);
  print <<___;
$comment This file is generated from a similarly-named Perl script in the BoringSSL
$comment source tree. Do not edit by hand.

___
}

if ($nasm) {
    die "unknown target" unless ($win64);
    print <<___;
\%ifidn __OUTPUT_FORMAT__, win64
default	rel
\%define XMMWORD
\%define YMMWORD
\%define ZMMWORD

\%ifdef BORINGSSL_PREFIX
\%include "boringssl_prefix_symbols_nasm.inc"
\%endif
___
} elsif ($masm) {
    print <<___;
OPTION	DOTNAME
___
}

if ($gas) {
    my $target;
    if ($elf) {
        # The "elf" target is really ELF with SysV ABI, but every ELF platform
        # uses the SysV ABI.
        $target = "defined(__ELF__)";
    } elsif ($apple) {
        $target = "defined(__APPLE__)";
    } else {
        die "unknown target: $flavour";
    }
    print <<___;
#if defined(__has_feature)
#if __has_feature(memory_sanitizer) && !defined(OPENSSL_NO_ASM)
#define OPENSSL_NO_ASM
#endif
#endif

#if defined(__x86_64__) && !defined(OPENSSL_NO_ASM) && $target
#if defined(BORINGSSL_PREFIX)
#include <boringssl_prefix_symbols_asm.h>
#endif
___
}

sub process_line {
    my $line = shift;
    $line =~ s|\R$||;           # Better chomp

    if ($nasm) {
	$line =~ s|^#ifdef |%ifdef |;
	$line =~ s|^#ifndef |%ifndef |;
	$line =~ s|^#endif|%endif|;
	$line =~ s|[#!].*$||;	# get rid of asm-style comments...
    } else {
	# Get rid of asm-style comments but not preprocessor directives. The
	# former are identified by having a letter after the '#' and starting in
	# the first column.
	$line =~ s|!.*$||;
	$line =~ s|(?<=.)#.*$||;
	$line =~ s|^#([^a-z].*)?$||;
    }

    $line =~ s|/\*.*\*/||;	# ... and C-style comments...
    $line =~ s|^\s+||;		# ... and skip white spaces in beginning
    $line =~ s|\s+$||;		# ... and at the end

    if (my $label=label->re(\$line))	{ print $label->out(); }

    if (my $directive=directive->re(\$line)) {
	printf "%s",$directive->out();
    } elsif (my $opcode=opcode->re(\$line)) {
	my $asm = eval("\$".$opcode->mnemonic());

	if ((ref($asm) eq 'CODE') && scalar(my @bytes=&$asm($line))) {
	    print $gas?".byte\t":"DB\t",join(',',@bytes),"\n";
	    next;
	}

	my @args;
	ARGUMENT: while (1) {
	    my $arg;

	    ($arg=register->re(\$line, $opcode))||
	    ($arg=const->re(\$line))		||
	    ($arg=ea->re(\$line, $opcode))	||
	    ($arg=expr->re(\$line, $opcode))	||
	    last ARGUMENT;

	    push @args,$arg;

	    last ARGUMENT if ($line !~ /^,/);

	    $line =~ s/^,\s*//;
	} # ARGUMENT:

	if ($#args>=0) {
	    my $insn;
	    my $sz=$opcode->size();

	    if ($gas) {
		$insn = $opcode->out($#args>=1?$args[$#args]->size():$sz);
		@args = map($_->out($sz),@args);
		printf "\t%s\t%s",$insn,join(",",@args);
	    } else {
		$insn = $opcode->out();
		foreach (@args) {
		    my $arg = $_->out();
		    # $insn.=$sz compensates for movq, pinsrw, ...
		    if ($arg =~ /^xmm[0-9]+$/) { $insn.=$sz; $sz="x" if(!$sz); last; }
		    if ($arg =~ /^ymm[0-9]+$/) { $insn.=$sz; $sz="y" if(!$sz); last; }
		    if ($arg =~ /^zmm[0-9]+$/) { $insn.=$sz; $sz="z" if(!$sz); last; }
		    if ($arg =~ /^mm[0-9]+$/)  { $insn.=$sz; $sz="q" if(!$sz); last; }
		}
		@args = reverse(@args);
		undef $sz if ($nasm && $opcode->mnemonic() eq "lea");
		printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
	    }
	} else {
	    printf "\t%s",$opcode->out();
	}
    }

    print $line,"\n";
}

while(defined(my $line=<>)) {
    process_line($line);
}
foreach my $line (split(/\n/, seh_directive->pdata_and_xdata())) {
    process_line($line);
}

print "\n$current_segment\tENDS\n"	if ($current_segment && $masm);
if ($masm) {
    print "END\n";
} elsif ($gas) {
    print <<___;
#endif
#if defined(__ELF__)
// See https://www.airs.com/blog/archives/518.
.section .note.GNU-stack,"",\%progbits
#endif
___
} elsif ($nasm) {
    print <<___;
\%else
; Work around https://bugzilla.nasm.us/show_bug.cgi?id=3392738
ret
\%endif
___
} else {
    die "unknown assembler";
}

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

#################################################
# Cross-reference x86_64 ABI "card"
#
# 		Unix		Win64
# %rax		*		*
# %rbx		-		-
# %rcx		#4		#1
# %rdx		#3		#2
# %rsi		#2		-
# %rdi		#1		-
# %rbp		-		-
# %rsp		-		-
# %r8		#5		#3
# %r9		#6		#4
# %r10		*		*
# %r11		*		*
# %r12		-		-
# %r13		-		-
# %r14		-		-
# %r15		-		-
#
# (*)	volatile register
# (-)	preserved by callee
# (#)	Nth argument, volatile
#
# In Unix terms top of stack is argument transfer area for arguments
# which could not be accommodated in registers. Or in other words 7th
# [integer] argument resides at 8(%rsp) upon function entry point.
# 128 bytes above %rsp constitute a "red zone" which is not touched
# by signal handlers and can be used as temporal storage without
# allocating a frame.
#
# In Win64 terms N*8 bytes on top of stack is argument transfer area,
# which belongs to/can be overwritten by callee. N is the number of
# arguments passed to callee, *but* not less than 4! This means that
# upon function entry point 5th argument resides at 40(%rsp), as well
# as that 32 bytes from 8(%rsp) can always be used as temporal
# storage [without allocating a frame]. One can actually argue that
# one can assume a "red zone" above stack pointer under Win64 as well.
# Point is that at apparently no occasion Windows kernel would alter
# the area above user stack pointer in true asynchronous manner...
#
# All the above means that if assembler programmer adheres to Unix
# register and stack layout, but disregards the "red zone" existence,
# it's possible to use following prologue and epilogue to "gear" from
# Unix to Win64 ABI in leaf functions with not more than 6 arguments.
#
# omnipotent_function:
# ifdef WIN64
#	movq	%rdi,8(%rsp)
#	movq	%rsi,16(%rsp)
#	movq	%rcx,%rdi	; if 1st argument is actually present
#	movq	%rdx,%rsi	; if 2nd argument is actually ...
#	movq	%r8,%rdx	; if 3rd argument is ...
#	movq	%r9,%rcx	; if 4th argument ...
#	movq	40(%rsp),%r8	; if 5th ...
#	movq	48(%rsp),%r9	; if 6th ...
# endif
#	...
# ifdef WIN64
#	movq	8(%rsp),%rdi
#	movq	16(%rsp),%rsi
# endif
#	ret
#
#################################################
# Win64 SEH, Structured Exception Handling.
#
# Unlike on Unix systems(*) lack of Win64 stack unwinding information
# has undesired side-effect at run-time: if an exception is raised in
# assembler subroutine such as those in question (basically we're
# referring to segmentation violations caused by malformed input
# parameters), the application is briskly terminated without invoking
# any exception handlers, most notably without generating memory dump
# or any user notification whatsoever. This poses a problem. It's
# possible to address it by registering custom language-specific
# handler that would restore processor context to the state at
# subroutine entry point and return "exception is not handled, keep
# unwinding" code. Writing such handler can be a challenge... But it's
# doable, though requires certain coding convention. Consider following
# snippet:
#
# .type	function,@function
# function:
#	movq	%rsp,%rax	# copy rsp to volatile register
#	pushq	%r15		# save non-volatile registers
#	pushq	%rbx
#	pushq	%rbp
#	movq	%rsp,%r11
#	subq	%rdi,%r11	# prepare [variable] stack frame
#	andq	$-64,%r11
#	movq	%rax,0(%r11)	# check for exceptions
#	movq	%r11,%rsp	# allocate [variable] stack frame
#	movq	%rax,0(%rsp)	# save original rsp value
# magic_point:
#	...
#	movq	0(%rsp),%rcx	# pull original rsp value
#	movq	-24(%rcx),%rbp	# restore non-volatile registers
#	movq	-16(%rcx),%rbx
#	movq	-8(%rcx),%r15
#	movq	%rcx,%rsp	# restore original rsp
# magic_epilogue:
#	ret
# .size function,.-function
#
# The key is that up to magic_point copy of original rsp value remains
# in chosen volatile register and no non-volatile register, except for
# rsp, is modified. While past magic_point rsp remains constant till
# the very end of the function. In this case custom language-specific
# exception handler would look like this:
#
# EXCEPTION_DISPOSITION handler (EXCEPTION_RECORD *rec,ULONG64 frame,
#		CONTEXT *context,DISPATCHER_CONTEXT *disp)
# {	ULONG64 *rsp = (ULONG64 *)context->Rax;
#	ULONG64  rip = context->Rip;
#
#	if (rip >= magic_point)
#	{   rsp = (ULONG64 *)context->Rsp;
#	    if (rip < magic_epilogue)
#	    {	rsp = (ULONG64 *)rsp[0];
#		context->Rbp = rsp[-3];
#		context->Rbx = rsp[-2];
#		context->R15 = rsp[-1];
#	    }
#	}
#	context->Rsp = (ULONG64)rsp;
#	context->Rdi = rsp[1];
#	context->Rsi = rsp[2];
#
#	memcpy (disp->ContextRecord,context,sizeof(CONTEXT));
#	RtlVirtualUnwind(UNW_FLAG_NHANDLER,disp->ImageBase,
#		dips->ControlPc,disp->FunctionEntry,disp->ContextRecord,
#		&disp->HandlerData,&disp->EstablisherFrame,NULL);
#	return ExceptionContinueSearch;
# }
#
# It's appropriate to implement this handler in assembler, directly in
# function's module. In order to do that one has to know members'
# offsets in CONTEXT and DISPATCHER_CONTEXT structures and some constant
# values. Here they are:
#
#	CONTEXT.Rax				120
#	CONTEXT.Rcx				128
#	CONTEXT.Rdx				136
#	CONTEXT.Rbx				144
#	CONTEXT.Rsp				152
#	CONTEXT.Rbp				160
#	CONTEXT.Rsi				168
#	CONTEXT.Rdi				176
#	CONTEXT.R8				184
#	CONTEXT.R9				192
#	CONTEXT.R10				200
#	CONTEXT.R11				208
#	CONTEXT.R12				216
#	CONTEXT.R13				224
#	CONTEXT.R14				232
#	CONTEXT.R15				240
#	CONTEXT.Rip				248
#	CONTEXT.Xmm6				512
#	sizeof(CONTEXT)				1232
#	DISPATCHER_CONTEXT.ControlPc		0
#	DISPATCHER_CONTEXT.ImageBase		8
#	DISPATCHER_CONTEXT.FunctionEntry	16
#	DISPATCHER_CONTEXT.EstablisherFrame	24
#	DISPATCHER_CONTEXT.TargetIp		32
#	DISPATCHER_CONTEXT.ContextRecord	40
#	DISPATCHER_CONTEXT.LanguageHandler	48
#	DISPATCHER_CONTEXT.HandlerData		56
#	UNW_FLAG_NHANDLER			0
#	ExceptionContinueSearch			1
#
# In order to tie the handler to the function one has to compose
# couple of structures: one for .xdata segment and one for .pdata.
#
# UNWIND_INFO structure for .xdata segment would be
#
# function_unwind_info:
#	.byte	9,0,0,0
#	.rva	handler
#
# This structure designates exception handler for a function with
# zero-length prologue, no stack frame or frame register.
#
# To facilitate composing of .pdata structures, auto-generated "gear"
# prologue copies rsp value to rax and denotes next instruction with
# .LSEH_begin_{function_name} label. This essentially defines the SEH
# styling rule mentioned in the beginning. Position of this label is
# chosen in such manner that possible exceptions raised in the "gear"
# prologue would be accounted to caller and unwound from latter's frame.
# End of function is marked with respective .LSEH_end_{function_name}
# label. To summarize, .pdata segment would contain
#
#	.rva	.LSEH_begin_function
#	.rva	.LSEH_end_function
#	.rva	function_unwind_info
#
# Reference to function_unwind_info from .xdata segment is the anchor.
# In case you wonder why references are 32-bit .rvas and not 64-bit
# .quads. References put into these two segments are required to be
# *relative* to the base address of the current binary module, a.k.a.
# image base. No Win64 module, be it .exe or .dll, can be larger than
# 2GB and thus such relative references can be and are accommodated in
# 32 bits.
#
# Having reviewed the example function code, one can argue that "movq
# %rsp,%rax" above is redundant. It is not! Keep in mind that on Unix
# rax would contain an undefined value. If this "offends" you, use
# another register and refrain from modifying rax till magic_point is
# reached, i.e. as if it was a non-volatile register. If more registers
# are required prior [variable] frame setup is completed, note that
# nobody says that you can have only one "magic point." You can
# "liberate" non-volatile registers by denoting last stack off-load
# instruction and reflecting it in finer grade unwind logic in handler.
# After all, isn't it why it's called *language-specific* handler...
#
# SE handlers are also involved in unwinding stack when executable is
# profiled or debugged. Profiling implies additional limitations that
# are too subtle to discuss here. For now it's sufficient to say that
# in order to simplify handlers one should either a) offload original
# %rsp to stack (like discussed above); or b) if you have a register to
# spare for frame pointer, choose volatile one.
#
# (*)	Note that we're talking about run-time, not debug-time. Lack of
#	unwind information makes debugging hard on both Windows and
#	Unix. "Unlike" refers to the fact that on Unix signal handler
#	will always be invoked, core dumped and appropriate exit code
#	returned to parent (for user notification).


#!/usr/bin/env perl
# Copyright (c) 2019, Google Inc.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# This file defines helper functions for crypto/test/abi_test.h on 32-bit
# ARM. See that header for details on how to use this.
#
# For convenience, this file is linked into libcrypto, where consuming builds
# already support architecture-specific sources. The static linker should drop
# this code in non-test binaries. This includes a shared library build of
# libcrypto, provided --gc-sections (ELF), -dead_strip (iOS), or equivalent is
# used.
#
# References:
#
# AAPCS: http://infocenter.arm.com/help/topic/com.arm.doc.ihi0042f/IHI0042F_aapcs.pdf
# iOS ARMv6: https://developer.apple.com/library/archive/documentation/Xcode/Conceptual/iPhoneOSABIReference/Articles/ARMv6FunctionCallingConventions.html
# iOS ARMv7: https://developer.apple.com/library/archive/documentation/Xcode/Conceptual/iPhoneOSABIReference/Articles/ARMv7FunctionCallingConventions.html
# Linux: http://sourcery.mentor.com/sgpp/lite/arm/portal/kbattach142/arm_gnu_linux_%20abi.pdf

use strict;

my $flavour = shift;
my $output  = shift;

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

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

my ($func, $state, $argv, $argc) = ("r0", "r1", "r2", "r3");
my $code = <<____;
.syntax	unified

.arch	armv7-a
.fpu	vfp

.text

@ abi_test_trampoline loads callee-saved registers from |state|, calls |func|
@ with |argv|, then saves the callee-saved registers into |state|. It returns
@ the result of |func|. The |unwind| argument is unused.
@ uint32_t abi_test_trampoline(void (*func)(...), CallerState *state,
@                              const uint32_t *argv, size_t argc,
@                              int unwind);
.type	abi_test_trampoline, %function
.globl	abi_test_trampoline
.align	4
abi_test_trampoline:
	@ Save parameters and all callee-saved registers. For convenience, we
	@ save r9 on iOS even though it's volatile.
	vstmdb	sp!, {d8-d15}
	stmdb	sp!, {r0-r11,lr}

	@ Reserve stack space for six (10-4) stack parameters, plus an extra 4
	@ bytes to keep it 8-byte-aligned (see AAPCS, section 5.3).
	sub     sp, sp, #28

	@ Every register in AAPCS is either non-volatile or a parameter (except
	@ r9 on iOS), so this code, by the actual call, loses all its scratch
	@ registers. First fill in stack parameters while there are registers
	@ to spare.
	cmp	$argc, #4
	bls	.Lstack_args_done
	mov	r4, sp				@ r4 is the output pointer.
	add	r5, $argv, $argc, lsl #2	@ Set r5 to the end of argv.
	add	$argv, $argv, #16		@ Skip four arguments.
.Lstack_args_loop:
	ldr	r6, [$argv], #4
	cmp	$argv, r5
	str	r6, [r4], #4
	bne	.Lstack_args_loop

.Lstack_args_done:
	@ Load registers from |$state|.
	vldmia	$state!, {d8-d15}
#if defined(__APPLE__)
	@ r9 is not volatile on iOS.
	ldmia	$state!, {r4-r8,r10-r11}
#else
	ldmia	$state!, {r4-r11}
#endif

	@ Load register parameters. This uses up our remaining registers, so we
	@ repurpose lr as scratch space.
	ldr	$argc, [sp, #40]	@ Reload argc.
	ldr	lr, [sp, #36]		@ Load argv into lr.
	cmp	$argc, #3
	bhi	.Larg_r3
	beq	.Larg_r2
	cmp	$argc, #1
	bhi	.Larg_r1
	beq	.Larg_r0
	b	.Largs_done

.Larg_r3:
	ldr	r3, [lr, #12]	@ argv[3]
.Larg_r2:
	ldr	r2, [lr, #8]	@ argv[2]
.Larg_r1:
	ldr	r1, [lr, #4]	@ argv[1]
.Larg_r0:
	ldr	r0, [lr]	@ argv[0]
.Largs_done:

	@ With every other register in use, load the function pointer into lr
	@ and call the function.
	ldr	lr, [sp, #28]
	blx	lr

	@ r1-r3 are free for use again. The trampoline only supports
	@ single-return functions. Pass r4-r11 to the caller.
	ldr	$state, [sp, #32]
	vstmia	$state!, {d8-d15}
#if defined(__APPLE__)
	@ r9 is not volatile on iOS.
	stmia	$state!, {r4-r8,r10-r11}
#else
	stmia	$state!, {r4-r11}
#endif

	@ Unwind the stack and restore registers.
	add	sp, sp, #44		@ 44 = 28+16
	ldmia	sp!, {r4-r11,lr}	@ Skip r0-r3 (see +16 above).
	vldmia	sp!, {d8-d15}

	bx	lr
.size	abi_test_trampoline,.-abi_test_trampoline
____

# abi_test_clobber_* zeros the corresponding register. These are used to test
# the ABI-testing framework.
foreach (0..12) {
  # This loop skips r13 (sp), r14 (lr, implicitly clobbered by every call), and
  # r15 (pc).
  $code .= <<____;
.type	abi_test_clobber_r$_, %function
.globl	abi_test_clobber_r$_
.align	4
abi_test_clobber_r$_:
	mov	r$_, #0
	bx	lr
.size	abi_test_clobber_r$_,.-abi_test_clobber_r$_
____
}

foreach (0..15) {
  my $lo = "s".(2*$_);
  my $hi = "s".(2*$_+1);
  $code .= <<____;
.type	abi_test_clobber_d$_, %function
.globl	abi_test_clobber_d$_
.align	4
abi_test_clobber_d$_:
	mov	r0, #0
	vmov	$lo, r0
	vmov	$hi, r0
	bx	lr
.size	abi_test_clobber_d$_,.-abi_test_clobber_d$_
____
}

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


#!/usr/bin/env perl
# Copyright (c) 2019, Google Inc.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# This file defines helper functions for crypto/test/abi_test.h on aarch64. See
# that header for details on how to use this.
#
# For convenience, this file is linked into libcrypto, where consuming builds
# already support architecture-specific sources. The static linker should drop
# this code in non-test binaries. This includes a shared library build of
# libcrypto, provided --gc-sections (ELF), -dead_strip (iOS), or equivalent is
# used.
#
# References:
#
# AAPCS64: http://infocenter.arm.com/help/topic/com.arm.doc.ihi0055b/IHI0055B_aapcs64.pdf
# iOS ARM64: https://developer.apple.com/library/archive/documentation/Xcode/Conceptual/iPhoneOSABIReference/Articles/ARM64FunctionCallingConventions.html

use strict;

my $flavour = shift;
my $output  = shift;

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

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

my ($func, $state, $argv, $argc) = ("x0", "x1", "x2", "x3");
my $code = <<____;
#include <openssl/arm_arch.h>

.text

// abi_test_trampoline loads callee-saved registers from |state|, calls |func|
// with |argv|, then saves the callee-saved registers into |state|. It returns
// the result of |func|. The |unwind| argument is unused.
// uint64_t abi_test_trampoline(void (*func)(...), CallerState *state,
//                              const uint64_t *argv, size_t argc,
//                              uint64_t unwind);
.type	abi_test_trampoline, %function
.globl	abi_test_trampoline
.align	4
abi_test_trampoline:
.Labi_test_trampoline_begin:
	AARCH64_SIGN_LINK_REGISTER
	// Stack layout (low to high addresses)
	//   x29,x30 (16 bytes)
	//    d8-d15 (64 bytes)
	//   x19-x28 (80 bytes)
	//    $state (8 bytes)
	//   padding (8 bytes)
	stp	x29, x30, [sp, #-176]!
	mov	x29, sp

	// Saved callee-saved registers and |state|.
	stp	d8, d9, [sp, #16]
	stp	d10, d11, [sp, #32]
	stp	d12, d13, [sp, #48]
	stp	d14, d15, [sp, #64]
	stp	x19, x20, [sp, #80]
	stp	x21, x22, [sp, #96]
	stp	x23, x24, [sp, #112]
	stp	x25, x26, [sp, #128]
	stp	x27, x28, [sp, #144]
	str	$state, [sp, #160]

	// Load registers from |state|, with the exception of x29. x29 is the
	// frame pointer and also callee-saved, but AAPCS64 allows platforms to
	// mandate that x29 always point to a frame. iOS64 does so, which means
	// we cannot fill x29 with entropy without violating ABI rules
	// ourselves. x29 is tested separately below.
	ldp	d8, d9, [$state], #16
	ldp	d10, d11, [$state], #16
	ldp	d12, d13, [$state], #16
	ldp	d14, d15, [$state], #16
	ldp	x19, x20, [$state], #16
	ldp	x21, x22, [$state], #16
	ldp	x23, x24, [$state], #16
	ldp	x25, x26, [$state], #16
	ldp	x27, x28, [$state], #16

	// Move parameters into temporary registers.
	mov	x9, $func
	mov	x10, $argv
	mov	x11, $argc

	// Load parameters into registers.
	cbz	x11, .Largs_done
	ldr	x0, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x1, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x2, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x3, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x4, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x5, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x6, [x10], #8
	subs	x11, x11, #1
	b.eq	.Largs_done
	ldr	x7, [x10], #8

.Largs_done:
	blr	x9

	// Reload |state| and store registers.
	ldr	$state, [sp, #160]
	stp	d8, d9, [$state], #16
	stp	d10, d11, [$state], #16
	stp	d12, d13, [$state], #16
	stp	d14, d15, [$state], #16
	stp	x19, x20, [$state], #16
	stp	x21, x22, [$state], #16
	stp	x23, x24, [$state], #16
	stp	x25, x26, [$state], #16
	stp	x27, x28, [$state], #16

	// |func| is required to preserve x29, the frame pointer. We cannot load
	// random values into x29 (see comment above), so compare it against the
	// expected value and zero the field of |state| if corrupted.
	mov	x9, sp
	cmp	x29, x9
	b.eq	.Lx29_ok
	str	xzr, [$state]

.Lx29_ok:
	// Restore callee-saved registers.
	ldp	d8, d9, [sp, #16]
	ldp	d10, d11, [sp, #32]
	ldp	d12, d13, [sp, #48]
	ldp	d14, d15, [sp, #64]
	ldp	x19, x20, [sp, #80]
	ldp	x21, x22, [sp, #96]
	ldp	x23, x24, [sp, #112]
	ldp	x25, x26, [sp, #128]
	ldp	x27, x28, [sp, #144]

	ldp	x29, x30, [sp], #176
	AARCH64_VALIDATE_LINK_REGISTER
	ret
.size	abi_test_trampoline,.-abi_test_trampoline
____

# abi_test_clobber_* zeros the corresponding register. These are used to test
# the ABI-testing framework.
foreach (0..29) {
  # x18 is the platform register and off limits.
  next if ($_ == 18);
  $code .= <<____;
.type	abi_test_clobber_x$_, %function
.globl	abi_test_clobber_x$_
.align	4
abi_test_clobber_x$_:
	AARCH64_VALID_CALL_TARGET
	mov	x$_, xzr
	ret
.size	abi_test_clobber_x$_,.-abi_test_clobber_x$_
____
}
foreach (0..31) {
  $code .= <<____;
.type	abi_test_clobber_d$_, %function
.globl	abi_test_clobber_d$_
.align	4
abi_test_clobber_d$_:
	AARCH64_VALID_CALL_TARGET
	fmov	d$_, xzr
	ret
.size	abi_test_clobber_d$_,.-abi_test_clobber_d$_
____
}

# abi_test_clobber_v*_upper clobbers only the upper half of v*. AAPCS64 only
# requires the lower half (d*) be preserved.
foreach (8..15) {
  $code .= <<____;
.type	abi_test_clobber_v${_}_upper, %function
.globl	abi_test_clobber_v${_}_upper
.align	4
abi_test_clobber_v${_}_upper:
	AARCH64_VALID_CALL_TARGET
	fmov	v${_}.d[1], xzr
	ret
.size	abi_test_clobber_v${_}_upper,.-abi_test_clobber_v${_}_upper
____
}

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


#!/usr/bin/env perl
# Copyright (c) 2019, Google Inc.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# This file defines helper functions for crypto/test/abi_test.h on ppc64le. See
# that header for details on how to use this.
#
# For convenience, this file is linked into libcrypto, where consuming builds
# already support architecture-specific sources. The static linker should drop
# this code in non-test binaries. This includes a shared library build of
# libcrypto, provided --gc-sections or equivalent is used.
#
# References:
#
# ELFv2: http://openpowerfoundation.org/wp-content/uploads/resources/leabi/leabi-20170510.pdf

use strict;

my $flavour = shift;
my $output  = shift;

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

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

unless ($flavour =~ /linux.*64le/) {
    die "This file only supports the ELFv2 ABI, used by ppc64le";
}

my $code = "";

sub load_or_store_regs {
  # $op is "l" or "st".
  my ($op, $base_reg, $base_offset) = @_;
  # Vector registers.
  foreach (20..31) {
    my $offset = $base_offset + ($_ - 20) * 16;
    # Vector registers only support indexed register addressing.
    $code .= "\tli\tr11, $offset\n";
    $code .= "\t${op}vx\tv$_, r11, $base_reg\n";
  }
  # Save general registers.
  foreach (14..31) {
    my $offset = $base_offset + 192 + ($_ - 14) * 8;
    $code .= "\t${op}d\tr$_, $offset($base_reg)\n";
  }
  # Save floating point registers.
  foreach (14..31) {
    my $offset = $base_offset + 336 + ($_ - 14) * 8;
    $code .= "\t${op}fd\tf$_, $offset($base_reg)\n";
  }
}

sub load_regs {
  my ($base_reg, $base_offset) = @_;
  load_or_store_regs("l", $base_reg, $base_offset);
}

sub store_regs {
  my ($base_reg, $base_offset) = @_;
  load_or_store_regs("st", $base_reg, $base_offset);
}

my ($func, $state, $argv, $argc) = ("r3", "r4", "r5", "r6");
$code .= <<____;
.machine	"any"
.text

# abi_test_trampoline loads callee-saved registers from |state|, calls |func|
# with |argv|, then saves the callee-saved registers into |state|. It returns
# the result of |func|. The |unwind| argument is unused.
# uint64_t abi_test_trampoline(void (*func)(...), CallerState *state,
#                              const uint64_t *argv, size_t argc,
#                              uint64_t unwind);
.globl	abi_test_trampoline
.align	5
abi_test_trampoline:
	# LR is saved into the caller's stack frame.
	mflr	r0
	std	r0, 16(r1)

	# Allocate 66*8 = 528 bytes of stack frame. From the top of the stack
	# to the bottom, the stack frame is:
	#
	#     0(r1) - Back chain pointer
	#     8(r1) - CR save area
	#    16(r1) - LR save area (for |func|)
	#    24(r1) - TOC pointer save area
	#    32(r1) - Saved copy of |state|
	#    40(r1) - Padding
	#    48(r1) - Vector register save area (v20-v31, 12 registers)
	#   240(r1) - General register save area (r14-r31, 18 registers)
	#   384(r1) - Floating point register save area (f14-f31, 18 registers)
	#
	# Note the layouts of the register save areas and CallerState match.
	#
	# In the ELFv2 ABI, the parameter save area is optional if the function
	# is non-variadic and all parameters fit in registers. We only support
	# such functions, so we omit it to test that |func| does not rely on it.
	stdu	r1, -528(r1)

	mfcr	r0
	std	r0, 8(r1)	# Save CR
	std	r2, 24(r1)	# Save TOC
	std	$state, 32(r1)	# Save |state|
____
# Save registers to the stack.
store_regs("r1", 48);
# Load registers from the caller.
load_regs($state, 0);
$code .= <<____;
	# Load CR from |state|.
	ld	r0, 480($state)
	mtcr	r0

	# Move parameters into temporary registers so they are not clobbered.
	addi	r11, $argv, -8	# Adjust for ldu below
	mr	r12, $func

	# Load parameters into registers.
	cmpdi	$argc, 0
	beq	.Largs_done
	mtctr	$argc
	ldu	r3, 8(r11)
	bdz	.Largs_done
	ldu	r4, 8(r11)
	bdz	.Largs_done
	ldu	r5, 8(r11)
	bdz	.Largs_done
	ldu	r6, 8(r11)
	bdz	.Largs_done
	ldu	r7, 8(r11)
	bdz	.Largs_done
	ldu	r8, 8(r11)
	bdz	.Largs_done
	ldu	r9, 8(r11)
	bdz	.Largs_done
	ldu	r10, 8(r11)

.Largs_done:
	li	r2, 0		# Clear TOC to test |func|'s global entry point
	mtctr	r12
	bctrl
	ld	r2, 24(r1)	# Restore TOC

	ld	$state, 32(r1)	# Reload |state|
____
# Output resulting registers to the caller.
store_regs($state, 0);
# Restore registers from the stack.
load_regs("r1", 48);
$code .= <<____;
	mfcr	r0
	std	r0, 480($state)	# Output CR to caller
	ld	r0, 8(r1)
	mtcrf	0b00111000, r0	# Restore CR2-CR4
	addi	r1, r1, 528
	ld	r0, 16(r1)	# Restore LR
	mtlr	r0
	blr
.size	abi_test_trampoline,.-abi_test_trampoline
____

# abi_test_clobber_* clobbers the corresponding register. These are used to test
# the ABI-testing framework.
foreach (0..31) {
  # r1 is the stack pointer. r13 is the thread pointer.
  next if ($_ == 1 || $_ == 13);
  $code .= <<____;
.globl	abi_test_clobber_r$_
.align	5
abi_test_clobber_r$_:
	li	r$_, 0
	blr
.size	abi_test_clobber_r$_,.-abi_test_clobber_r$_
____
}

foreach (0..31) {
  $code .= <<____;
.globl	abi_test_clobber_f$_
.align	4
abi_test_clobber_f$_:
	li	r0, 0
	# Use the red zone.
	std	r0, -8(r1)
	lfd	f$_, -8(r1)
	blr
.size	abi_test_clobber_f$_,.-abi_test_clobber_f$_
____
}

foreach (0..31) {
  $code .= <<____;
.globl	abi_test_clobber_v$_
.align	4
abi_test_clobber_v$_:
	vxor	v$_, v$_, v$_
	blr
.size	abi_test_clobber_v$_,.-abi_test_clobber_v$_
____
}

foreach (0..7) {
  # PPC orders CR fields in big-endian, so the mask is reversed from what one
  # would expect.
  my $mask = 1 << (7 - $_);
  $code .= <<____;
.globl	abi_test_clobber_cr$_
.align	4
abi_test_clobber_cr$_:
	# Flip the bits on cr$_ rather than setting to zero. With a four-bit
	# register, zeroing it will do nothing 1 in 16 times.
	mfcr	r0
	not	r0, r0
	mtcrf	$mask, r0
	blr
.size	abi_test_clobber_cr$_,.-abi_test_clobber_cr$_
____
}

$code .= <<____;
.globl	abi_test_clobber_ctr
.align	4
abi_test_clobber_ctr:
	li	r0, 0
	mtctr	r0
	blr
.size	abi_test_clobber_ctr,.-abi_test_clobber_ctr

.globl	abi_test_clobber_lr
.align	4
abi_test_clobber_lr:
	mflr	r0
	mtctr	r0
	li	r0, 0
	mtlr	r0
	bctr
.size	abi_test_clobber_lr,.-abi_test_clobber_lr

____

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


#!/usr/bin/env perl
# Copyright (c) 2018, Google Inc.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# This file defines helper functions for crypto/test/abi_test.h on x86. See
# that header for details on how to use this.
#
# For convenience, this file is linked into libcrypto, where consuming builds
# already support architecture-specific sources. The static linker should drop
# this code in non-test binaries. This includes a shared library build of
# libcrypto, provided --gc-sections (ELF), -dead_strip (Mac), or equivalent is
# used.
#
# References:
#
# SysV ABI: https://uclibc.org/docs/psABI-i386.pdf
# Win32 ABI: https://docs.microsoft.com/en-us/cpp/cpp/argument-passing-and-naming-conventions?view=vs-2017

use strict;

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

my $output = $ARGV[1];
open STDOUT, ">$output";

&asm_init($ARGV[0]);

# abi_test_trampoline loads callee-saved registers from |state|, calls |func|
# with |argv|, then saves the callee-saved registers into |state|. It returns
# the result of |func|. |unwind| is ignored.
# uint32_t abi_test_trampoline(void (*func)(...), CallerState *state,
#                              const uint32_t *argv, size_t argc,
#                              int unwind);
&function_begin("abi_test_trampoline")
	# Load registers from |state|. Note |function_begin| (as opposed to
	# |function_begin_B|) automatically saves all callee-saved registers, so we
	# may freely clobber them.
	&mov("ecx", &wparam(1));
	&mov("esi", &DWP(4*0, "ecx"));
	&mov("edi", &DWP(4*1, "ecx"));
	&mov("ebx", &DWP(4*2, "ecx"));
	&mov("ebp", &DWP(4*3, "ecx"));

	# Use a fixed stack allocation so |wparam| continues to work. abi_test.h
	# supports at most 10 arguments. The SysV ABI requires a 16-byte-aligned
	# stack on process entry, so round up to 3 (mod 4).
	&stack_push(11);

	# Copy parameters to stack.
	&mov("eax", &wparam(2));
	&xor("ecx", "ecx");
&set_label("loop");
	&cmp("ecx", &wparam(3));
	&jae(&label("loop_done"));
	&mov("edx", &DWP(0, "eax", "ecx", 4));
	&mov(&DWP(0, "esp", "ecx", 4), "edx");
	&add("ecx", 1);
	&jmp(&label("loop"));

&set_label("loop_done");
	&call_ptr(&wparam(0));

	&stack_pop(11);

	# Save registers back into |state|.
	&mov("ecx", &wparam(1));
	&mov(&DWP(4*0, "ecx"), "esi");
	&mov(&DWP(4*1, "ecx"), "edi");
	&mov(&DWP(4*2, "ecx"), "ebx");
	&mov(&DWP(4*3, "ecx"), "ebp");
&function_end("abi_test_trampoline")

# abi_test_get_and_clear_direction_flag clears the direction flag. If the flag
# was previously set, it returns one. Otherwise, it returns zero.
# int abi_test_get_and_clear_direction_flag(void);
&function_begin_B("abi_test_get_and_clear_direction_flag");
	&pushf();
	&pop("eax");
	&and("eax", 0x400);
	&shr("eax", 10);
	&cld();
	&ret();
&function_end_B("abi_test_get_and_clear_direction_flag");

# abi_test_set_direction_flag sets the direction flag.
# void abi_test_set_direction_flag(void);
&function_begin_B("abi_test_set_direction_flag");
	&std();
	&ret();
&function_end_B("abi_test_set_direction_flag");

# abi_test_clobber_* zeros the corresponding register. These are used to test
# the ABI-testing framework.
foreach ("eax", "ebx", "ecx", "edx", "edi", "esi", "ebp") {
&function_begin_B("abi_test_clobber_$_");
	&xor($_, $_);
	&ret();
&function_end_B("abi_test_clobber_$_");
}
foreach (0..7) {
&function_begin_B("abi_test_clobber_xmm$_");
	&pxor("xmm$_", "xmm$_");
	&ret();
&function_end_B("abi_test_clobber_xmm$_");
}

&asm_finish();

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


#!/usr/bin/env perl
# Copyright (c) 2018, Google Inc.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# This file defines helper functions for crypto/test/abi_test.h on x86_64. See
# that header for details on how to use this.
#
# For convenience, this file is linked into libcrypto, where consuming builds
# already support architecture-specific sources. The static linker should drop
# this code in non-test binaries. This includes a shared library build of
# libcrypto, provided --gc-sections (ELF), -dead_strip (Mac), or equivalent is
# used.
#
# References:
#
# SysV ABI: https://github.com/hjl-tools/x86-psABI/wiki/x86-64-psABI-1.0.pdf
# Win64 ABI: https://docs.microsoft.com/en-us/cpp/build/x64-software-conventions?view=vs-2017

use strict;

my $flavour = shift;
my $output  = shift;

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

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

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

# @inp is the registers used for function inputs, in order.
my @inp = $win64 ? ("%rcx", "%rdx", "%r8", "%r9") :
                   ("%rdi", "%rsi", "%rdx", "%rcx", "%r8", "%r9");

# @caller_state is the list of registers that the callee must preserve for the
# caller. This must match the definition of CallerState in abi_test.h.
my @caller_state = ("%rbx", "%rbp", "%r12", "%r13", "%r14", "%r15");
if ($win64) {
  @caller_state = ("%rbx", "%rbp", "%rdi", "%rsi", "%r12", "%r13", "%r14",
                   "%r15", "%xmm6", "%xmm7", "%xmm8", "%xmm9", "%xmm10",
                   "%xmm11", "%xmm12", "%xmm13", "%xmm14", "%xmm15");
}

# $caller_state_size is the size of CallerState, in bytes.
my $caller_state_size = 0;
foreach (@caller_state) {
  if (/^%r/) {
    $caller_state_size += 8;
  } elsif (/^%xmm/) {
    $caller_state_size += 16;
  } else {
    die "unknown register $_";
  }
}

# load_caller_state returns code which loads a CallerState structure at
# $off($reg) into the respective registers. No other registers are touched, but
# $reg may not be a register in CallerState. $cb is an optional callback to
# add extra lines after each movq or movdqa. $cb is passed the offset, relative
# to $reg, and name of each register.
sub load_caller_state {
  my ($off, $reg, $cb) = @_;
  my $ret = "";
  foreach (@caller_state) {
    my $old_off = $off;
    if (/^%r/) {
      $ret .= "\tmovq\t$off($reg), $_\n";
      $off += 8;
    } elsif (/^%xmm/) {
      $ret .= "\tmovdqa\t$off($reg), $_\n";
      $off += 16;
    } else {
      die "unknown register $_";
    }
    $ret .= $cb->($old_off, $_) if (defined($cb));
  }
  return $ret;
}

# store_caller_state behaves like load_caller_state, except that it writes the
# current values of the registers into $off($reg).
sub store_caller_state {
  my ($off, $reg, $cb) = @_;
  my $ret = "";
  foreach (@caller_state) {
    my $old_off = $off;
    if (/^%r/) {
      $ret .= "\tmovq\t$_, $off($reg)\n";
      $off += 8;
    } elsif (/^%xmm/) {
      $ret .= "\tmovdqa\t$_, $off($reg)\n";
      $off += 16;
    } else {
      die "unknown register $_";
    }
    $ret .= $cb->($old_off, $_) if (defined($cb));
  }
  return $ret;
}

# $max_params is the maximum number of parameters abi_test_trampoline supports.
my $max_params = 10;

# Windows reserves stack space for the register-based parameters, while SysV
# only reserves space for the overflow ones.
my $stack_params_skip = $win64 ? scalar(@inp) : 0;
my $num_stack_params = $win64 ? $max_params : $max_params - scalar(@inp);

my ($func, $state, $argv, $argc, $unwind) = @inp;
my $code = <<____;
.text

# abi_test_trampoline loads callee-saved registers from |state|, calls |func|
# with |argv|, then saves the callee-saved registers into |state|. It returns
# the result of |func|. If |unwind| is non-zero, this function triggers unwind
# instrumentation.
# uint64_t abi_test_trampoline(void (*func)(...), CallerState *state,
#                              const uint64_t *argv, size_t argc,
#                              int unwind);
.type	abi_test_trampoline, \@abi-omnipotent
.globl	abi_test_trampoline
.align	16
abi_test_trampoline:
.cfi_startproc
.seh_startproc
	# Stack layout:
	#   8 bytes - align
	#   $caller_state_size bytes - saved caller registers
	#   8 bytes - scratch space
	#   8 bytes - saved copy of \$unwind (SysV-only)
	#   8 bytes - saved copy of \$state
	#   8 bytes - saved copy of \$func
	#   8 bytes - if needed for stack alignment
	#   8*$num_stack_params bytes - parameters for \$func
____
my $stack_alloc_size = 8 + $caller_state_size + 8*3 + 8*$num_stack_params;
if (!$win64) {
  $stack_alloc_size += 8;
}
# SysV and Windows both require the stack to be 16-byte-aligned. The call
# instruction offsets it by 8, so stack allocations must be 8 mod 16.
if ($stack_alloc_size % 16 != 8) {
  $num_stack_params++;
  $stack_alloc_size += 8;
}
my $stack_params_offset = 8 * $stack_params_skip;
my $func_offset = 8 * $num_stack_params;
my $state_offset = $func_offset + 8;
# On Win64, unwind is already passed in memory. On SysV, it is passed in as
# register and we must reserve stack space for it.
my ($unwind_offset, $scratch_offset);
if ($win64) {
  $unwind_offset = $stack_alloc_size + 5*8;
  $scratch_offset = $state_offset + 8;
} else {
  $unwind_offset = $state_offset + 8;
  $scratch_offset = $unwind_offset + 8;
}
my $caller_state_offset = $scratch_offset + 8;
$code .= <<____;
	subq	\$$stack_alloc_size, %rsp
.cfi_adjust_cfa_offset	$stack_alloc_size
.seh_allocstack	$stack_alloc_size
____
$code .= <<____ if (!$win64);
	movq	$unwind, $unwind_offset(%rsp)
____
# Store our caller's state. This is needed because we modify it ourselves, and
# also to isolate the test infrastruction from the function under test failing
# to save some register.
$code .= store_caller_state($caller_state_offset, "%rsp", sub {
  my ($off, $reg) = @_;
  $reg = substr($reg, 1);
  # SEH records offsets relative to %rsp (when there is no frame pointer), while
  # CFI records them relative to the CFA, the value of the parent's stack
  # pointer just before the call.
  my $cfi_off = $off - $stack_alloc_size - 8;
  my $seh_dir = ".seh_savereg";
  $seh_dir = ".seh_savexmm128" if ($reg =~ /^xmm/);
  return <<____;
.cfi_offset	$reg, $cfi_off
$seh_dir	\%$reg, $off
____
});

$code .= load_caller_state(0, $state);
$code .= <<____;
	# Stash \$func and \$state, so they are available after the call returns.
	movq	$func, $func_offset(%rsp)
	movq	$state, $state_offset(%rsp)

	# Load parameters. Note this will clobber \$argv and \$argc, so we can
	# only use non-parameter volatile registers. There are three, and they
	# are the same between SysV and Win64: %rax, %r10, and %r11.
	movq	$argv, %r10
	movq	$argc, %r11
____
foreach (@inp) {
  $code .= <<____;
	dec	%r11
	js	.Largs_done
	movq	(%r10), $_
	addq	\$8, %r10
____
}
$code .= <<____;
	leaq	$stack_params_offset(%rsp), %rax
.Largs_loop:
	dec	%r11
	js	.Largs_done

	# This block should be:
	#    movq (%r10), %rtmp
	#    movq %rtmp, (%rax)
	# There are no spare registers available, so we spill into the scratch
	# space.
	movq	%r11, $scratch_offset(%rsp)
	movq	(%r10), %r11
	movq	%r11, (%rax)
	movq	$scratch_offset(%rsp), %r11

	addq	\$8, %r10
	addq	\$8, %rax
	jmp	.Largs_loop

.Largs_done:
	movq	$func_offset(%rsp), %rax
	movq	$unwind_offset(%rsp), %r10
	testq	%r10, %r10
	jz	.Lno_unwind

	# Set the trap flag.
	pushfq
	orq	\$0x100, 0(%rsp)
	popfq

	# Run an instruction to trigger a breakpoint immediately before the
	# call.
	nop
.globl	abi_test_unwind_start
abi_test_unwind_start:

	call	*%rax
.globl	abi_test_unwind_return
abi_test_unwind_return:

	# Clear the trap flag. Note this assumes the trap flag was clear on
	# entry. We do not support instrumenting an unwind-instrumented
	# |abi_test_trampoline|.
	pushfq
	andq	\$-0x101, 0(%rsp)	# -0x101 is ~0x100
	popfq
.globl	abi_test_unwind_stop
abi_test_unwind_stop:

	jmp	.Lcall_done

.Lno_unwind:
	call	*%rax

.Lcall_done:
	# Store what \$func did our state, so our caller can check.
	movq  $state_offset(%rsp), $state
____
$code .= store_caller_state(0, $state);

# Restore our caller's state.
$code .= load_caller_state($caller_state_offset, "%rsp", sub {
  my ($off, $reg) = @_;
  $reg = substr($reg, 1);
  return ".cfi_restore\t$reg\n";
});
$code .= <<____;
	addq	\$$stack_alloc_size, %rsp
.cfi_adjust_cfa_offset	-$stack_alloc_size

	# %rax already contains \$func's return value, unmodified.
	ret
.cfi_endproc
.seh_endproc
.size	abi_test_trampoline,.-abi_test_trampoline
____

# abi_test_clobber_* zeros the corresponding register. These are used to test
# the ABI-testing framework.
foreach ("ax", "bx", "cx", "dx", "di", "si", "bp", 8..15) {
  $code .= <<____;
.type	abi_test_clobber_r$_, \@abi-omnipotent
.globl	abi_test_clobber_r$_
.align	16
abi_test_clobber_r$_:
	xorq	%r$_, %r$_
	ret
.size	abi_test_clobber_r$_,.-abi_test_clobber_r$_
____
}

foreach (0..15) {
  $code .= <<____;
.type	abi_test_clobber_xmm$_, \@abi-omnipotent
.globl	abi_test_clobber_xmm$_
.align	16
abi_test_clobber_xmm$_:
	pxor	%xmm$_, %xmm$_
	ret
.size	abi_test_clobber_xmm$_,.-abi_test_clobber_xmm$_
____
}

$code .= <<____;
# abi_test_bad_unwind_wrong_register preserves the ABI, but annotates the wrong
# register in unwind metadata.
# void abi_test_bad_unwind_wrong_register(void);
.type	abi_test_bad_unwind_wrong_register, \@abi-omnipotent
.globl	abi_test_bad_unwind_wrong_register
.align	16
abi_test_bad_unwind_wrong_register:
.cfi_startproc
.seh_startproc
	pushq	%r12
.cfi_push	%r13	# This should be %r13
.seh_pushreg	%r13	# This should be %r13
	# Windows evaluates epilogs directly in the unwinder, rather than using
	# unwind codes. Add a nop so there is one non-epilog point (immediately
	# before the nop) where the unwinder can observe the mistake.
	nop
	popq	%r12
.cfi_pop	%r12
	ret
.seh_endproc
.cfi_endproc
.size	abi_test_bad_unwind_wrong_register,.-abi_test_bad_unwind_wrong_register

# abi_test_bad_unwind_temporary preserves the ABI, but temporarily corrupts the
# storage space for a saved register, breaking unwind.
# void abi_test_bad_unwind_temporary(void);
.type	abi_test_bad_unwind_temporary, \@abi-omnipotent
.globl	abi_test_bad_unwind_temporary
.align	16
abi_test_bad_unwind_temporary:
.cfi_startproc
.seh_startproc
	pushq	%r12
.cfi_push	%r12
.seh_pushreg	%r12

	movq	%r12, %rax
	inc	%rax
	movq	%rax, (%rsp)
	# Unwinding from here is incorrect. Although %r12 itself has not been
	# changed, the unwind codes say to look in (%rsp) instead.

	movq	%r12, (%rsp)
	# Unwinding is now fixed.

	popq	%r12
.cfi_pop	%r12
	ret
.cfi_endproc
.seh_endproc
.size	abi_test_bad_unwind_temporary,.-abi_test_bad_unwind_temporary

# abi_test_get_and_clear_direction_flag clears the direction flag. If the flag
# was previously set, it returns one. Otherwise, it returns zero.
# int abi_test_get_and_clear_direction_flag(void);
.type	abi_test_set_direction_flag, \@abi-omnipotent
.globl	abi_test_get_and_clear_direction_flag
abi_test_get_and_clear_direction_flag:
	pushfq
	popq	%rax
	andq	\$0x400, %rax
	shrq	\$10, %rax
	cld
	ret
.size abi_test_get_and_clear_direction_flag,.-abi_test_get_and_clear_direction_flag

# abi_test_set_direction_flag sets the direction flag.
# void abi_test_set_direction_flag(void);
.type	abi_test_set_direction_flag, \@abi-omnipotent
.globl	abi_test_set_direction_flag
abi_test_set_direction_flag:
	std
	ret
.size abi_test_set_direction_flag,.-abi_test_set_direction_flag
____

if ($win64) {
  $code .= <<____;
# abi_test_bad_unwind_epilog preserves the ABI, and correctly annotates the
# prolog, but the epilog does not match Win64's rules, breaking unwind during
# the epilog.
# void abi_test_bad_unwind_epilog(void);
.type	abi_test_bad_unwind_epilog, \@abi-omnipotent
.globl	abi_test_bad_unwind_epilog
.align	16
abi_test_bad_unwind_epilog:
.seh_startproc
	pushq	%r12
.seh_pushreg	%r12

	nop

	# The epilog should begin here, but the nop makes it invalid.
	popq	%r12
	nop
	ret
.seh_endproc
.size	abi_test_bad_unwind_epilog,.-abi_test_bad_unwind_epilog
____
}

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


#! /usr/bin/env perl
# Copyright 2015-2020 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (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
#
# File is sourced from openssl/crypto/perlasm/arm-xlate.pl

use strict;

my $flavour = shift;
my $output = shift;
open STDOUT,">$output" || die "can't open $output: $!";

$flavour = "linux32" if (!$flavour or $flavour eq "void");

my %GLOBALS;
my $dotinlocallabels=($flavour=~/linux/)?1:0;

################################################################
# directives which need special treatment on different platforms
################################################################
my $arch = sub {
    if ($flavour =~ /linux/)	{ ".arch\t".join(',',@_); }
    else			{ ""; }
};
my $fpu = sub {
    if ($flavour =~ /linux/)	{ ".fpu\t".join(',',@_); }
    else			{ ""; }
};
my $rodata = sub {
    SWITCH: for ($flavour) {
	/linux/		&& return ".section\t.rodata";
	/ios/		&& return ".section\t__TEXT,__const";
	last;
    }
};
my $hidden = sub {
    if ($flavour =~ /ios/)	{ ".private_extern\t".join(',',@_); }
    else			{ ".hidden\t".join(',',@_); }
};
my $comm = sub {
    my @args = split(/,\s*/,shift);
    my $name = @args[0];
    my $global = \$GLOBALS{$name};
    my $ret;

    if ($flavour =~ /ios32/)	{
	$ret = ".comm\t_$name,@args[1]\n";
	$ret .= ".non_lazy_symbol_pointer\n";
	$ret .= "$name:\n";
	$ret .= ".indirect_symbol\t_$name\n";
	$ret .= ".long\t0";
	$name = "_$name";
    } else			{ $ret = ".comm\t".join(',',@args); }

    $$global = $name;
    $ret;
};
my $globl = sub {
    my $name = shift;
    my $global = \$GLOBALS{$name};
    my $ret;

    SWITCH: for ($flavour) {
	/ios/		&& do { $name = "_$name";
				last;
			      };
    }

    $ret = ".globl	$name" if (!$ret);
    $$global = $name;
    $ret;
};
my $global = $globl;
my $extern = sub {
    &$globl(@_);
    return;	# return nothing
};
my $type = sub {
    if ($flavour =~ /linux/)	{ ".type\t".join(',',@_); }
    elsif ($flavour =~ /ios32/)	{ if (join(',',@_) =~ /(\w+),%function/) {
					"#ifdef __thumb2__\n".
					".thumb_func	$1\n".
					"#endif";
				  }
			        }
    else			{ ""; }
};
my $size = sub {
    if ($flavour =~ /linux/)	{ ".size\t".join(',',@_); }
    else			{ ""; }
};
my $inst = sub {
    if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
    else                        { ".long\t".join(',',@_); }
};
my $asciz = sub {
    my $line = join(",",@_);
    if ($line =~ /^"(.*)"$/)
    {	".byte	" . join(",",unpack("C*",$1),0) . "\n.align	2";	}
    else
    {	"";	}
};

my $adrp = sub {
    my ($args,$comment) = split(m|\s*//|,shift);
    "\tadrp\t$args\@PAGE";
} if ($flavour =~ /ios64/);

sub range {
  my ($r,$sfx,$start,$end) = @_;

    join(",",map("$r$_$sfx",($start..$end)));
}

sub expand_line {
  my $line = shift;
  my @ret = ();

    pos($line)=0;

    while ($line =~ m/\G[^@\/\{\"]*/g) {
	if ($line =~ m/\G(@|\/\/|$)/gc) {
	    last;
	}
	elsif ($line =~ m/\G\{/gc) {
	    my $saved_pos = pos($line);
	    $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
	    pos($line) = $saved_pos;
	    $line =~ m/\G[^\}]*\}/g;
	}
	elsif ($line =~ m/\G\"/gc) {
	    $line =~ m/\G[^\"]*\"/g;
	}
    }

    $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;

    if ($flavour =~ /ios64/) {
	$line =~ s/#:lo12:(\w+)/$1\@PAGEOFF/;
    }

    return $line;
}

while(my $line=<>) {

    if ($line =~ m/^\s*(#|@|\/\/)/)	{ print $line; next; }

    $line =~ s|/\*.*\*/||;	# get rid of C-style comments...
    $line =~ s|^\s+||;		# ... and skip whitespace in beginning...
    $line =~ s|\s+$||;		# ... and at the end

    {
	$line =~ s|[\b\.]L(\w{2,})|L$1|g;	# common denominator for Locallabel
	$line =~ s|\bL(\w{2,})|\.L$1|g	if ($dotinlocallabels);
    }

    {
	$line =~ s|(^[\.\w]+)\:\s*||;
	my $label = $1;
	if ($label) {
	    printf "%s:",($GLOBALS{$label} or $label);
	}
    }

    if ($line !~ m/^[#@]/) {
	$line =~ s|^\s*(\.?)(\S+)\s*||;
	my $c = $1; $c = "\t" if ($c eq "");
	my $mnemonic = $2;
	my $opcode;
	if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
	    $opcode = eval("\$$1_$2");
	} else {
	    $opcode = eval("\$$mnemonic");
	}

	my $arg=expand_line($line);

	if (ref($opcode) eq 'CODE') {
		$line = &$opcode($arg);
	} elsif ($mnemonic)         {
		$line = $c.$mnemonic;
		$line.= "\t$arg" if ($arg ne "");
	}
    }

    print $line if ($line);
    print "\n";
}

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