openssl/crypto/perlasm/x86asm.pl
David Benjamin e195c8a256 Remove filename argument to x86 asm_init.
The assembler already knows the actual path to the generated file and,
in other perlasm architectures, is left to manage debug symbols itself.
Notably, in OpenSSL 1.1.x's new build system, which allows a separate
build directory, converting .pl to .s as the scripts currently do result
in the wrong paths.

This also avoids inconsistencies from some of the files using $0 and
some passing in the filename.

Reviewed-by: Richard Levitte <levitte@openssl.org>
Reviewed-by: Andy Polyakov <appro@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/3431)
2017-05-11 17:00:23 -04:00

309 lines
7.2 KiB
Perl

#! /usr/bin/env perl
# Copyright 1995-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
# require 'x86asm.pl';
# &asm_init(<flavor>[,$i386only]);
# &function_begin("foo");
# ...
# &function_end("foo");
# &asm_finish
$out=();
$i386=0;
# AUTOLOAD is this context has quite unpleasant side effect, namely
# that typos in function calls effectively go to assembler output,
# but on the pros side we don't have to implement one subroutine per
# each opcode...
sub ::AUTOLOAD
{ my $opcode = $AUTOLOAD;
die "more than 4 arguments passed to $opcode" if ($#_>3);
$opcode =~ s/.*:://;
if ($opcode =~ /^push/) { $stack+=4; }
elsif ($opcode =~ /^pop/) { $stack-=4; }
&generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
}
sub ::emit
{ my $opcode=shift;
if ($#_==-1) { push(@out,"\t$opcode\n"); }
else { push(@out,"\t$opcode\t".join(',',@_)."\n"); }
}
sub ::LB
{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
$1."l";
}
sub ::HB
{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
$1."h";
}
sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); }
sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); }
sub ::blindpop { &pop($_[0]); $stack+=4; }
sub ::wparam { &DWP($stack+4*$_[0],"esp"); }
sub ::swtmp { &DWP(4*$_[0],"esp"); }
sub ::bswap
{ if ($i386) # emulate bswap for i386
{ &comment("bswap @_");
&xchg(&HB(@_),&LB(@_));
&ror (@_,16);
&xchg(&HB(@_),&LB(@_));
}
else
{ &generic("bswap",@_); }
}
# These are made-up opcodes introduced over the years essentially
# by ignorance, just alias them to real ones...
sub ::movb { &mov(@_); }
sub ::xorb { &xor(@_); }
sub ::rotl { &rol(@_); }
sub ::rotr { &ror(@_); }
sub ::exch { &xchg(@_); }
sub ::halt { &hlt; }
sub ::movz { &movzx(@_); }
sub ::pushf { &pushfd; }
sub ::popf { &popfd; }
# 3 argument instructions
sub ::movq
{ my($p1,$p2,$optimize)=@_;
if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
# movq between mmx registers can sink Intel CPUs
{ &::pshufw($p1,$p2,0xe4); }
else
{ &::generic("movq",@_); }
}
# SSE>2 instructions
my %regrm = ( "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3,
"esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7 );
sub ::pextrd
{ my($dst,$src,$imm)=@_;
if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/)
{ &::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm); }
else
{ &::generic("pextrd",@_); }
}
sub ::pinsrd
{ my($dst,$src,$imm)=@_;
if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/)
{ &::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm); }
else
{ &::generic("pinsrd",@_); }
}
sub ::pshufb
{ my($dst,$src)=@_;
if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
{ &data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2); }
else
{ &::generic("pshufb",@_); }
}
sub ::palignr
{ my($dst,$src,$imm)=@_;
if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
{ &::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm); }
else
{ &::generic("palignr",@_); }
}
sub ::pclmulqdq
{ my($dst,$src,$imm)=@_;
if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
{ &::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm); }
else
{ &::generic("pclmulqdq",@_); }
}
sub ::rdrand
{ my ($dst)=@_;
if ($dst =~ /(e[a-dsd][ixp])/)
{ &::data_byte(0x0f,0xc7,0xf0|$regrm{$dst}); }
else
{ &::generic("rdrand",@_); }
}
sub ::rdseed
{ my ($dst)=@_;
if ($dst =~ /(e[a-dsd][ixp])/)
{ &::data_byte(0x0f,0xc7,0xf8|$regrm{$dst}); }
else
{ &::generic("rdrand",@_); }
}
sub rxb {
local *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;
}
sub ::vprotd
{ my $args=join(',',@_);
if ($args =~ /xmm([0-7]),xmm([0-7]),([x0-9a-f]+)/)
{ my @opcode=(0x8f);
rxb(\@opcode,$1,$2,-1,0x08);
push @opcode,0x78,0xc2;
push @opcode,0xc0|($2&7)|(($1&7)<<3); # ModR/M
my $c=$3;
push @opcode,$c=~/^0/?oct($c):$c;
&::data_byte(@opcode);
}
else
{ &::generic("vprotd",@_); }
}
sub ::endbranch
{
&::data_byte(0xf3,0x0f,0x1e,0xfb);
}
# label management
$lbdecor="L"; # local label decoration, set by package
$label="000";
sub ::islabel # see is argument is a known label
{ my $i;
foreach $i (values %label) { return $i if ($i eq $_[0]); }
$label{$_[0]}; # can be undef
}
sub ::label # instantiate a function-scope label
{ if (!defined($label{$_[0]}))
{ $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; }
$label{$_[0]};
}
sub ::LABEL # instantiate a file-scope label
{ $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
$label{$_[0]};
}
sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); }
sub ::set_label_B { push(@out,"@_:\n"); }
sub ::set_label
{ my $label=&::label($_[0]);
&::align($_[1]) if ($_[1]>1);
&::set_label_B($label);
$label;
}
sub ::wipe_labels # wipes function-scope labels
{ foreach $i (keys %label)
{ delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); }
}
# subroutine management
sub ::function_begin
{ &function_begin_B(@_);
$stack=4;
&push("ebp");
&push("ebx");
&push("esi");
&push("edi");
}
sub ::function_end
{ &pop("edi");
&pop("esi");
&pop("ebx");
&pop("ebp");
&ret();
&function_end_B(@_);
$stack=0;
&wipe_labels();
}
sub ::function_end_A
{ &pop("edi");
&pop("esi");
&pop("ebx");
&pop("ebp");
&ret();
$stack+=16; # readjust esp as if we didn't pop anything
}
sub ::asciz
{ my @str=unpack("C*",shift);
push @str,0;
while ($#str>15) {
&data_byte(@str[0..15]);
foreach (0..15) { shift @str; }
}
&data_byte(@str) if (@str);
}
sub ::asm_finish
{ &file_end();
print @out;
}
sub ::asm_init
{ my ($type,$cpu)=@_;
$i386=$cpu;
$elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$android=0;
if (($type eq "elf"))
{ $elf=1; require "x86gas.pl"; }
elsif (($type eq "elf-1"))
{ $elf=-1; require "x86gas.pl"; }
elsif (($type eq "a\.out"))
{ $aout=1; require "x86gas.pl"; }
elsif (($type eq "coff" or $type eq "gaswin"))
{ $coff=1; require "x86gas.pl"; }
elsif (($type eq "win32n"))
{ $win32=1; require "x86nasm.pl"; }
elsif (($type eq "nw-nasm"))
{ $netware=1; require "x86nasm.pl"; }
#elsif (($type eq "nw-mwasm"))
#{ $netware=1; $mwerks=1; require "x86nasm.pl"; }
elsif (($type eq "win32"))
{ $win32=1; require "x86masm.pl"; }
elsif (($type eq "macosx"))
{ $aout=1; $macosx=1; require "x86gas.pl"; }
elsif (($type eq "android"))
{ $elf=1; $android=1; require "x86gas.pl"; }
else
{ print STDERR <<"EOF";
Pick one target type from
elf - Linux, FreeBSD, Solaris x86, etc.
a.out - DJGPP, elder OpenBSD, etc.
coff - GAS/COFF such as Win32 targets
win32n - Windows 95/Windows NT NASM format
nw-nasm - NetWare NASM format
macosx - Mac OS X
EOF
exit(1);
}
$pic=0;
for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
&file();
}
sub ::hidden {}
1;