David Benjamin | c895d6b | 2016-08-11 13:26:41 -0400 | [diff] [blame] | 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 | |
Adam Langley | d9e397b | 2015-01-22 14:27:53 -0800 | [diff] [blame] | 9 | |
| 10 | # require 'x86asm.pl'; |
| 11 | # &asm_init(<flavor>,"des-586.pl"[,$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 | sub ::emit |
| 37 | { my $opcode=shift; |
| 38 | |
| 39 | if ($#_==-1) { push(@out,"\t$opcode\n"); } |
| 40 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } |
| 41 | } |
| 42 | |
| 43 | sub ::LB |
| 44 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; |
| 45 | $1."l"; |
| 46 | } |
| 47 | sub ::HB |
| 48 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; |
| 49 | $1."h"; |
| 50 | } |
| 51 | sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } |
| 52 | sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } |
| 53 | sub ::blindpop { &pop($_[0]); $stack+=4; } |
| 54 | sub ::wparam { &DWP($stack+4*$_[0],"esp"); } |
| 55 | sub ::swtmp { &DWP(4*$_[0],"esp"); } |
| 56 | |
| 57 | sub ::bswap |
| 58 | { if ($i386) # emulate bswap for i386 |
| 59 | { &comment("bswap @_"); |
| 60 | &xchg(&HB(@_),&LB(@_)); |
| 61 | &ror (@_,16); |
| 62 | &xchg(&HB(@_),&LB(@_)); |
| 63 | } |
| 64 | else |
| 65 | { &generic("bswap",@_); } |
| 66 | } |
| 67 | # These are made-up opcodes introduced over the years essentially |
| 68 | # by ignorance, just alias them to real ones... |
| 69 | sub ::movb { &mov(@_); } |
| 70 | sub ::xorb { &xor(@_); } |
| 71 | sub ::rotl { &rol(@_); } |
| 72 | sub ::rotr { &ror(@_); } |
| 73 | sub ::exch { &xchg(@_); } |
| 74 | sub ::halt { &hlt; } |
| 75 | sub ::movz { &movzx(@_); } |
| 76 | sub ::pushf { &pushfd; } |
| 77 | sub ::popf { &popfd; } |
| 78 | |
| 79 | # 3 argument instructions |
| 80 | sub ::movq |
| 81 | { my($p1,$p2,$optimize)=@_; |
| 82 | |
| 83 | if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) |
| 84 | # movq between mmx registers can sink Intel CPUs |
| 85 | { &::pshufw($p1,$p2,0xe4); } |
| 86 | else |
| 87 | { &::generic("movq",@_); } |
| 88 | } |
| 89 | |
| 90 | # SSE>2 instructions |
| 91 | my %regrm = ( "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3, |
| 92 | "esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7 ); |
| 93 | sub ::pextrd |
| 94 | { my($dst,$src,$imm)=@_; |
| 95 | if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/) |
| 96 | { &::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm); } |
| 97 | else |
| 98 | { &::generic("pextrd",@_); } |
| 99 | } |
| 100 | |
| 101 | sub ::pinsrd |
| 102 | { my($dst,$src,$imm)=@_; |
| 103 | if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/) |
| 104 | { &::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm); } |
| 105 | else |
| 106 | { &::generic("pinsrd",@_); } |
| 107 | } |
| 108 | |
| 109 | sub ::pshufb |
| 110 | { my($dst,$src)=@_; |
| 111 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) |
| 112 | { &data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2); } |
| 113 | else |
| 114 | { &::generic("pshufb",@_); } |
| 115 | } |
| 116 | |
| 117 | sub ::palignr |
| 118 | { my($dst,$src,$imm)=@_; |
| 119 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) |
| 120 | { &::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm); } |
| 121 | else |
| 122 | { &::generic("palignr",@_); } |
| 123 | } |
| 124 | |
| 125 | sub ::pclmulqdq |
| 126 | { my($dst,$src,$imm)=@_; |
| 127 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) |
| 128 | { &::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm); } |
| 129 | else |
| 130 | { &::generic("pclmulqdq",@_); } |
| 131 | } |
| 132 | |
| 133 | sub ::rdrand |
| 134 | { my ($dst)=@_; |
| 135 | if ($dst =~ /(e[a-dsd][ixp])/) |
| 136 | { &::data_byte(0x0f,0xc7,0xf0|$regrm{$dst}); } |
| 137 | else |
| 138 | { &::generic("rdrand",@_); } |
| 139 | } |
| 140 | |
David Benjamin | c895d6b | 2016-08-11 13:26:41 -0400 | [diff] [blame] | 141 | sub ::rdseed |
| 142 | { my ($dst)=@_; |
| 143 | if ($dst =~ /(e[a-dsd][ixp])/) |
| 144 | { &::data_byte(0x0f,0xc7,0xf8|$regrm{$dst}); } |
| 145 | else |
| 146 | { &::generic("rdrand",@_); } |
| 147 | } |
| 148 | |
Adam Langley | d9e397b | 2015-01-22 14:27:53 -0800 | [diff] [blame] | 149 | sub rxb { |
| 150 | local *opcode=shift; |
| 151 | my ($dst,$src1,$src2,$rxb)=@_; |
| 152 | |
| 153 | $rxb|=0x7<<5; |
| 154 | $rxb&=~(0x04<<5) if($dst>=8); |
| 155 | $rxb&=~(0x01<<5) if($src1>=8); |
| 156 | $rxb&=~(0x02<<5) if($src2>=8); |
| 157 | push @opcode,$rxb; |
| 158 | } |
| 159 | |
| 160 | sub ::vprotd |
| 161 | { my $args=join(',',@_); |
| 162 | if ($args =~ /xmm([0-7]),xmm([0-7]),([x0-9a-f]+)/) |
| 163 | { my @opcode=(0x8f); |
| 164 | rxb(\@opcode,$1,$2,-1,0x08); |
| 165 | push @opcode,0x78,0xc2; |
| 166 | push @opcode,0xc0|($2&7)|(($1&7)<<3); # ModR/M |
| 167 | my $c=$3; |
| 168 | push @opcode,$c=~/^0/?oct($c):$c; |
| 169 | &::data_byte(@opcode); |
| 170 | } |
| 171 | else |
| 172 | { &::generic("vprotd",@_); } |
| 173 | } |
| 174 | |
David Benjamin | c895d6b | 2016-08-11 13:26:41 -0400 | [diff] [blame] | 175 | sub ::endbranch |
| 176 | { |
| 177 | &::data_byte(0xf3,0x0f,0x1e,0xfb); |
| 178 | } |
| 179 | |
Adam Langley | d9e397b | 2015-01-22 14:27:53 -0800 | [diff] [blame] | 180 | # label management |
| 181 | $lbdecor="L"; # local label decoration, set by package |
| 182 | $label="000"; |
| 183 | |
| 184 | sub ::islabel # see is argument is a known label |
| 185 | { my $i; |
| 186 | foreach $i (values %label) { return $i if ($i eq $_[0]); } |
| 187 | $label{$_[0]}; # can be undef |
| 188 | } |
| 189 | |
| 190 | sub ::label # instantiate a function-scope label |
| 191 | { if (!defined($label{$_[0]})) |
| 192 | { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } |
| 193 | $label{$_[0]}; |
| 194 | } |
| 195 | |
| 196 | sub ::LABEL # instantiate a file-scope label |
| 197 | { $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); |
| 198 | $label{$_[0]}; |
| 199 | } |
| 200 | |
| 201 | sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } |
| 202 | |
| 203 | sub ::set_label_B { push(@out,"@_:\n"); } |
| 204 | sub ::set_label |
| 205 | { my $label=&::label($_[0]); |
| 206 | &::align($_[1]) if ($_[1]>1); |
| 207 | &::set_label_B($label); |
| 208 | $label; |
| 209 | } |
| 210 | |
| 211 | sub ::wipe_labels # wipes function-scope labels |
| 212 | { foreach $i (keys %label) |
| 213 | { delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); } |
| 214 | } |
| 215 | |
| 216 | # subroutine management |
| 217 | sub ::function_begin |
| 218 | { &function_begin_B(@_); |
| 219 | $stack=4; |
| 220 | &push("ebp"); |
| 221 | &push("ebx"); |
| 222 | &push("esi"); |
| 223 | &push("edi"); |
| 224 | } |
| 225 | |
| 226 | sub ::function_end |
| 227 | { &pop("edi"); |
| 228 | &pop("esi"); |
| 229 | &pop("ebx"); |
| 230 | &pop("ebp"); |
| 231 | &ret(); |
| 232 | &function_end_B(@_); |
| 233 | $stack=0; |
| 234 | &wipe_labels(); |
| 235 | } |
| 236 | |
| 237 | sub ::function_end_A |
| 238 | { &pop("edi"); |
| 239 | &pop("esi"); |
| 240 | &pop("ebx"); |
| 241 | &pop("ebp"); |
| 242 | &ret(); |
| 243 | $stack+=16; # readjust esp as if we didn't pop anything |
| 244 | } |
| 245 | |
| 246 | sub ::asciz |
| 247 | { my @str=unpack("C*",shift); |
| 248 | push @str,0; |
| 249 | while ($#str>15) { |
| 250 | &data_byte(@str[0..15]); |
| 251 | foreach (0..15) { shift @str; } |
| 252 | } |
| 253 | &data_byte(@str) if (@str); |
| 254 | } |
| 255 | |
| 256 | sub ::asm_finish |
| 257 | { &file_end(); |
| 258 | print "#if defined(__i386__)\n" unless $win32; |
| 259 | print @out; |
| 260 | print "#endif\n" unless $win32; |
| 261 | } |
| 262 | |
| 263 | sub ::asm_init |
| 264 | { my ($type,$fn,$cpu)=@_; |
| 265 | |
| 266 | $filename=$fn; |
| 267 | $i386=$cpu; |
| 268 | |
| 269 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$android=0; |
| 270 | if (($type eq "elf")) |
| 271 | { $elf=1; require "x86gas.pl"; } |
| 272 | elsif (($type eq "elf-1")) |
| 273 | { $elf=-1; require "x86gas.pl"; } |
| 274 | elsif (($type eq "a\.out")) |
| 275 | { $aout=1; require "x86gas.pl"; } |
| 276 | elsif (($type eq "coff" or $type eq "gaswin")) |
| 277 | { $coff=1; require "x86gas.pl"; } |
| 278 | elsif (($type eq "win32n")) |
| 279 | { $win32=1; require "x86nasm.pl"; } |
| 280 | elsif (($type eq "nw-nasm")) |
| 281 | { $netware=1; require "x86nasm.pl"; } |
| 282 | #elsif (($type eq "nw-mwasm")) |
| 283 | #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } |
| 284 | elsif (($type eq "win32")) |
| 285 | { $win32=1; require "x86masm.pl"; } |
| 286 | elsif (($type eq "macosx")) |
| 287 | { $aout=1; $macosx=1; require "x86gas.pl"; } |
| 288 | elsif (($type eq "android")) |
| 289 | { $elf=1; $android=1; require "x86gas.pl"; } |
| 290 | else |
| 291 | { print STDERR <<"EOF"; |
| 292 | Pick one target type from |
| 293 | elf - Linux, FreeBSD, Solaris x86, etc. |
| 294 | a.out - DJGPP, elder OpenBSD, etc. |
| 295 | coff - GAS/COFF such as Win32 targets |
| 296 | win32n - Windows 95/Windows NT NASM format |
| 297 | nw-nasm - NetWare NASM format |
| 298 | macosx - Mac OS X |
| 299 | EOF |
| 300 | exit(1); |
| 301 | } |
| 302 | |
| 303 | $pic=0; |
| 304 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } |
| 305 | |
| 306 | $filename =~ s/\.pl$//; |
| 307 | &file($filename); |
| 308 | } |
| 309 | |
| 310 | sub ::hidden {} |
| 311 | |
| 312 | 1; |