1#! /usr/bin/env perl
2# Copyright 1995-2018 The OpenSSL Project Authors. All Rights Reserved.
3#
4# Licensed under the Apache License, Version 2.0 (the "License");
5# you may not use this file except in compliance with the License.
6# You may obtain a copy of the License at
7#
8#     https://www.apache.org/licenses/LICENSE-2.0
9#
10# Unless required by applicable law or agreed to in writing, software
11# distributed under the License is distributed on an "AS IS" BASIS,
12# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13# See the License for the specific language governing permissions and
14# limitations under the License.
15
16
17# require 'x86asm.pl';
18# &asm_init(<flavor>[,$i386only]);
19# &function_begin("foo");
20# ...
21# &function_end("foo");
22# &asm_finish
23
24$out=();
25$i386=0;
26
27# AUTOLOAD is this context has quite unpleasant side effect, namely
28# that typos in function calls effectively go to assembler output,
29# but on the pros side we don't have to implement one subroutine per
30# each opcode...
31sub ::AUTOLOAD
32{ my $opcode = $AUTOLOAD;
33
34    die "more than 4 arguments passed to $opcode" if ($#_>3);
35
36    $opcode =~ s/.*:://;
37    if    ($opcode =~ /^push/) { $stack+=4; }
38    elsif ($opcode =~ /^pop/)  { $stack-=4; }
39
40    &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
41}
42
43# record_function_hit(int) writes a byte with value one to the given offset of
44# |BORINGSSL_function_hit|, but only if BORINGSSL_DISPATCH_TEST is defined.
45# This is used in impl_dispatch_test.cc to test whether the expected assembly
46# functions are triggered by high-level API calls.
47sub ::record_function_hit
48{ my($index)=@_;
49    &preprocessor_ifdef("BORINGSSL_DISPATCH_TEST");
50    &push("ebx");
51    &push("edx");
52    &call(&label("pic_for_function_hit"));
53    &set_label("pic_for_function_hit");
54    &blindpop("ebx");
55    &lea("ebx",&DWP("BORINGSSL_function_hit+$index"."-".&label("pic_for_function_hit"),"ebx"));
56    &mov("edx", 1);
57    &movb(&BP(0, "ebx"), "dl");
58    &pop("edx");
59    &pop("ebx");
60    &preprocessor_endif();
61}
62
63sub ::emit
64{ my $opcode=shift;
65
66    if ($#_==-1)    { push(@out,"\t$opcode\n");				}
67    else            { push(@out,"\t$opcode\t".join(',',@_)."\n");	}
68}
69
70sub ::LB
71{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
72  $1."l";
73}
74sub ::HB
75{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
76  $1."h";
77}
78sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num);	}
79sub ::stack_pop	{ my $num=$_[0]*4; $stack-=$num; &add("esp",$num);	}
80sub ::blindpop	{ &pop($_[0]); $stack+=4;				}
81sub ::wparam	{ &DWP($stack+4*$_[0],"esp");				}
82sub ::swtmp	{ &DWP(4*$_[0],"esp");					}
83
84sub ::bswap
85{   if ($i386)	# emulate bswap for i386
86    {	&comment("bswap @_");
87	&xchg(&HB(@_),&LB(@_));
88	&ror (@_,16);
89	&xchg(&HB(@_),&LB(@_));
90    }
91    else
92    {	&generic("bswap",@_);	}
93}
94# These are made-up opcodes introduced over the years essentially
95# by ignorance, just alias them to real ones...
96sub ::movb	{ &mov(@_);	}
97sub ::xorb	{ &xor(@_);	}
98sub ::rotl	{ &rol(@_);	}
99sub ::rotr	{ &ror(@_);	}
100sub ::exch	{ &xchg(@_);	}
101sub ::halt	{ &hlt;		}
102sub ::movz	{ &movzx(@_);	}
103sub ::pushf	{ &pushfd;	}
104sub ::popf	{ &popfd;	}
105
106# 3 argument instructions
107sub ::movq
108{ my($p1,$p2,$optimize)=@_;
109
110    if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
111    # movq between mmx registers can sink Intel CPUs
112    {	&::pshufw($p1,$p2,0xe4);		}
113    else
114    {	&::generic("movq",@_);			}
115}
116
117# SSE>2 instructions
118my %regrm = (	"eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3,
119		"esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7	);
120sub ::pextrd
121{ my($dst,$src,$imm)=@_;
122    if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/)
123    {	&::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm);	}
124    else
125    {	&::generic("pextrd",@_);		}
126}
127
128sub ::pinsrd
129{ my($dst,$src,$imm)=@_;
130    if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/)
131    {	&::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm);	}
132    else
133    {	&::generic("pinsrd",@_);		}
134}
135
136sub ::pshufb
137{ my($dst,$src)=@_;
138    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
139    {	&data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2);	}
140    else
141    {	&::generic("pshufb",@_);		}
142}
143
144sub ::palignr
145{ my($dst,$src,$imm)=@_;
146    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
147    {	&::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm);	}
148    else
149    {	&::generic("palignr",@_);		}
150}
151
152sub ::pclmulqdq
153{ my($dst,$src,$imm)=@_;
154    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
155    {	&::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm);	}
156    else
157    {	&::generic("pclmulqdq",@_);		}
158}
159
160sub ::rdrand
161{ my ($dst)=@_;
162    if ($dst =~ /(e[a-dsd][ixp])/)
163    {	&::data_byte(0x0f,0xc7,0xf0|$regrm{$dst});	}
164    else
165    {	&::generic("rdrand",@_);	}
166}
167
168sub ::rdseed
169{ my ($dst)=@_;
170    if ($dst =~ /(e[a-dsd][ixp])/)
171    {	&::data_byte(0x0f,0xc7,0xf8|$regrm{$dst});	}
172    else
173    {	&::generic("rdrand",@_);	}
174}
175
176sub rxb {
177 local *opcode=shift;
178 my ($dst,$src1,$src2,$rxb)=@_;
179
180   $rxb|=0x7<<5;
181   $rxb&=~(0x04<<5) if($dst>=8);
182   $rxb&=~(0x01<<5) if($src1>=8);
183   $rxb&=~(0x02<<5) if($src2>=8);
184   push @opcode,$rxb;
185}
186
187sub ::vprotd
188{ my $args=join(',',@_);
189    if ($args =~ /xmm([0-7]),xmm([0-7]),([x0-9a-f]+)/)
190    { my @opcode=(0x8f);
191	rxb(\@opcode,$1,$2,-1,0x08);
192	push @opcode,0x78,0xc2;
193	push @opcode,0xc0|($2&7)|(($1&7)<<3);		# ModR/M
194	my $c=$3;
195	push @opcode,$c=~/^0/?oct($c):$c;
196	&::data_byte(@opcode);
197    }
198    else
199    {	&::generic("vprotd",@_);	}
200}
201
202sub ::endbranch
203{
204    &::data_byte(0xf3,0x0f,0x1e,0xfb);
205}
206
207# label management
208$lbdecor="L";		# local label decoration, set by package
209$label="000";
210
211sub ::islabel		# see is argument is a known label
212{ my $i;
213    foreach $i (values %label) { return $i if ($i eq $_[0]); }
214  $label{$_[0]};	# can be undef
215}
216
217sub ::label		# instantiate a function-scope label
218{   if (!defined($label{$_[0]}))
219    {	$label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
220  $label{$_[0]};
221}
222
223sub ::LABEL		# instantiate a file-scope label
224{   $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
225  $label{$_[0]};
226}
227
228sub ::static_label	{ &::LABEL($_[0],$lbdecor.$_[0]); }
229
230sub ::set_label_B	{ push(@out,"@_:\n"); }
231sub ::set_label
232{ my $label=&::label($_[0]);
233    &::align($_[1]) if ($_[1]>1);
234    &::set_label_B($label);
235  $label;
236}
237
238sub ::wipe_labels	# wipes function-scope labels
239{   foreach $i (keys %label)
240    {	delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/);	}
241}
242
243# subroutine management
244sub ::function_begin
245{   &function_begin_B(@_);
246    $stack=4;
247    &push("ebp");
248    &push("ebx");
249    &push("esi");
250    &push("edi");
251}
252
253sub ::function_end
254{   &pop("edi");
255    &pop("esi");
256    &pop("ebx");
257    &pop("ebp");
258    &ret();
259    &function_end_B(@_);
260    $stack=0;
261    &wipe_labels();
262}
263
264sub ::function_end_A
265{   &pop("edi");
266    &pop("esi");
267    &pop("ebx");
268    &pop("ebp");
269    &ret();
270    $stack+=16;	# readjust esp as if we didn't pop anything
271}
272
273sub ::asciz
274{ my @str=unpack("C*",shift);
275    push @str,0;
276    while ($#str>15) {
277	&data_byte(@str[0..15]);
278	foreach (0..15) { shift @str; }
279    }
280    &data_byte(@str) if (@str);
281}
282
283sub ::asm_finish
284{   &file_end();
285    my $comment = "//";
286    $comment = ";" if ($win32);
287    print <<___;
288$comment This file is generated from a similarly-named Perl script in the BoringSSL
289$comment source tree. Do not edit by hand.
290
291___
292    if ($win32) {
293        print <<___ unless $masm;
294\%ifdef BORINGSSL_PREFIX
295\%include "boringssl_prefix_symbols_nasm.inc"
296\%endif
297\%ifidn __OUTPUT_FORMAT__, win32
298___
299        print @out;
300        print <<___ unless $masm;
301\%else
302; Work around https://bugzilla.nasm.us/show_bug.cgi?id=3392738
303ret
304\%endif
305___
306    } else {
307        my $target;
308        if ($elf) {
309            $target = "defined(__ELF__)";
310        } elsif ($macosx) {
311            $target = "defined(__APPLE__)";
312        } else {
313            die "unknown target";
314        }
315
316        print <<___;
317#include <openssl/asm_base.h>
318
319#if !defined(OPENSSL_NO_ASM) && defined(OPENSSL_X86) && $target
320___
321        print @out;
322        print <<___;
323#endif  // !defined(OPENSSL_NO_ASM) && defined(OPENSSL_X86) && $target
324___
325    }
326}
327
328sub ::asm_init
329{ my ($type,$cpu)=@_;
330
331    $i386=$cpu;
332
333    $elf=$cpp=$coff=$aout=$macosx=$win32=$mwerks=$android=0;
334    if    (($type eq "elf"))
335    {	$elf=1;			require "x86gas.pl";	}
336    elsif (($type eq "elf-1"))
337    {	$elf=-1;		require "x86gas.pl";	}
338    elsif (($type eq "a\.out"))
339    {	$aout=1;		require "x86gas.pl";	}
340    elsif (($type eq "coff" or $type eq "gaswin"))
341    {	$coff=1;		require "x86gas.pl";	}
342    elsif (($type eq "win32n"))
343    {	$win32=1;		require "x86nasm.pl";	}
344    elsif (($type eq "win32"))
345    {	$win32=1; $masm=1;	require "x86masm.pl";	}
346    elsif (($type eq "macosx"))
347    {	$aout=1; $macosx=1;	require "x86gas.pl";	}
348    elsif (($type eq "android"))
349    {	$elf=1; $android=1;	require "x86gas.pl";	}
350    else
351    {	print STDERR <<"EOF";
352Pick one target type from
353	elf	- Linux, FreeBSD, Solaris x86, etc.
354	a.out	- DJGPP, elder OpenBSD, etc.
355	coff	- GAS/COFF such as Win32 targets
356	win32n	- Windows 95/Windows NT NASM format
357	macosx	- Mac OS X
358EOF
359	exit(1);
360    }
361
362    $pic=0;
363    for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
364
365    &file();
366}
367
368sub ::hidden {}
369
3701;
371