1 #! /usr/bin/env perl 2 # Copyright 1995-2016 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... 24 sub ::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 NDEBUG is not defined. This is used in 38 # impl_dispatch_test.cc to test whether the expected assembly functions are 39 # triggered by high-level API calls. 40 sub ::record_function_hit 41 { my($index)=@_; 42 &preprocessor_ifndef("NDEBUG"); 43 &push("ebx"); 44 &push("edx"); 45 &call(&label("pic")); 46 &set_label("pic"); 47 &blindpop("ebx"); 48 &lea("ebx",&DWP("BORINGSSL_function_hit+$index"."-".&label("pic"),"ebx")); 49 &mov("edx", 1); 50 &movb(&BP(0, "ebx"), "dl"); 51 &pop("edx"); 52 &pop("ebx"); 53 &preprocessor_endif(); 54 } 55 56 sub ::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 63 sub ::LB 64 { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; 65 $1."l"; 66 } 67 sub ::HB 68 { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; 69 $1."h"; 70 } 71 sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } 72 sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } 73 sub ::blindpop { &pop($_[0]); $stack+=4; } 74 sub ::wparam { &DWP($stack+4*$_[0],"esp"); } 75 sub ::swtmp { &DWP(4*$_[0],"esp"); } 76 77 sub ::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... 89 sub ::movb { &mov(@_); } 90 sub ::xorb { &xor(@_); } 91 sub ::rotl { &rol(@_); } 92 sub ::rotr { &ror(@_); } 93 sub ::exch { &xchg(@_); } 94 sub ::halt { &hlt; } 95 sub ::movz { &movzx(@_); } 96 sub ::pushf { &pushfd; } 97 sub ::popf { &popfd; } 98 99 # 3 argument instructions 100 sub ::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 111 my %regrm = ( "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3, 112 "esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7 ); 113 sub ::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 121 sub ::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 129 sub ::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 137 sub ::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 145 sub ::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 153 sub ::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 161 sub ::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 169 sub 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 180 sub ::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 195 sub ::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 204 sub ::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 210 sub ::label # instantiate a function-scope label 211 { if (!defined($label{$_[0]})) 212 { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } 213 $label{$_[0]}; 214 } 215 216 sub ::LABEL # instantiate a file-scope label 217 { $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); 218 $label{$_[0]}; 219 } 220 221 sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } 222 223 sub ::set_label_B { push(@out,"@_:\n"); } 224 sub ::set_label 225 { my $label=&::label($_[0]); 226 &::align($_[1]) if ($_[1]>1); 227 &::set_label_B($label); 228 $label; 229 } 230 231 sub ::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 237 sub ::function_begin 238 { &function_begin_B(@_); 239 $stack=4; 240 &push("ebp"); 241 &push("ebx"); 242 &push("esi"); 243 &push("edi"); 244 } 245 246 sub ::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 257 sub ::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 266 sub ::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 276 sub ::asm_finish 277 { &file_end(); 278 my $comment = "#"; 279 $comment = ";" if ($win32 || $netware); 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 || $netware) { 286 print <<___ unless $masm; 287 %ifdef BORINGSSL_PREFIX 288 %include "boringssl_prefix_symbols_nasm.inc" 289 %endif 290 ___ 291 } else { 292 print <<___; 293 #if defined(__i386__) 294 #if defined(BORINGSSL_PREFIX) 295 #include <boringssl_prefix_symbols_asm.h> 296 #endif 297 ___ 298 } 299 print @out; 300 print "#endif\n" unless ($win32 || $netware); 301 } 302 303 sub ::asm_init 304 { my ($type,$cpu)=@_; 305 306 $i386=$cpu; 307 308 $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$android=0; 309 if (($type eq "elf")) 310 { $elf=1; require "x86gas.pl"; } 311 elsif (($type eq "elf-1")) 312 { $elf=-1; require "x86gas.pl"; } 313 elsif (($type eq "a\.out")) 314 { $aout=1; require "x86gas.pl"; } 315 elsif (($type eq "coff" or $type eq "gaswin")) 316 { $coff=1; require "x86gas.pl"; } 317 elsif (($type eq "win32n")) 318 { $win32=1; require "x86nasm.pl"; } 319 elsif (($type eq "nw-nasm")) 320 { $netware=1; require "x86nasm.pl"; } 321 #elsif (($type eq "nw-mwasm")) 322 #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } 323 elsif (($type eq "win32")) 324 { $win32=1; $masm=1; require "x86masm.pl"; } 325 elsif (($type eq "macosx")) 326 { $aout=1; $macosx=1; require "x86gas.pl"; } 327 elsif (($type eq "android")) 328 { $elf=1; $android=1; require "x86gas.pl"; } 329 else 330 { print STDERR <<"EOF"; 331 Pick one target type from 332 elf - Linux, FreeBSD, Solaris x86, etc. 333 a.out - DJGPP, elder OpenBSD, etc. 334 coff - GAS/COFF such as Win32 targets 335 win32n - Windows 95/Windows NT NASM format 336 nw-nasm - NetWare NASM format 337 macosx - Mac OS X 338 EOF 339 exit(1); 340 } 341 342 $pic=0; 343 for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } 344 345 &file(); 346 } 347 348 sub ::hidden {} 349 350 1; 351
