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