1238405Sjkim#!/usr/bin/env perl 255714Skris 355714Skris# require 'x86asm.pl'; 4238405Sjkim# &asm_init(<flavor>,"des-586.pl"[,$i386only]); 5238405Sjkim# &function_begin("foo"); 6238405Sjkim# ... 7238405Sjkim# &function_end("foo"); 8238405Sjkim# &asm_finish 955714Skris 10238405Sjkim$out=(); 11238405Sjkim$i386=0; 1255714Skris 13238405Sjkim# AUTOLOAD is this context has quite unpleasant side effect, namely 14238405Sjkim# that typos in function calls effectively go to assembler output, 15238405Sjkim# but on the pros side we don't have to implement one subroutine per 16238405Sjkim# each opcode... 17238405Sjkimsub ::AUTOLOAD 18238405Sjkim{ my $opcode = $AUTOLOAD; 1955714Skris 20238405Sjkim die "more than 4 arguments passed to $opcode" if ($#_>3); 2155714Skris 22238405Sjkim $opcode =~ s/.*:://; 23238405Sjkim if ($opcode =~ /^push/) { $stack+=4; } 24238405Sjkim elsif ($opcode =~ /^pop/) { $stack-=4; } 25111147Snectar 26238405Sjkim &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD"; 27238405Sjkim} 2855714Skris 29238405Sjkimsub ::emit 30238405Sjkim{ my $opcode=shift; 3155714Skris 32238405Sjkim if ($#_==-1) { push(@out,"\t$opcode\n"); } 33238405Sjkim else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } 34238405Sjkim} 3555714Skris 36238405Sjkimsub ::LB 37238405Sjkim{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; 38238405Sjkim $1."l"; 39238405Sjkim} 40238405Sjkimsub ::HB 41238405Sjkim{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; 42238405Sjkim $1."h"; 43238405Sjkim} 44238405Sjkimsub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } 45238405Sjkimsub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } 46238405Sjkimsub ::blindpop { &pop($_[0]); $stack+=4; } 47238405Sjkimsub ::wparam { &DWP($stack+4*$_[0],"esp"); } 48238405Sjkimsub ::swtmp { &DWP(4*$_[0],"esp"); } 4955714Skris 50238405Sjkimsub ::bswap 51238405Sjkim{ if ($i386) # emulate bswap for i386 52238405Sjkim { &comment("bswap @_"); 53238405Sjkim &xchg(&HB(@_),&LB(@_)); 54238405Sjkim &ror (@_,16); 55238405Sjkim &xchg(&HB(@_),&LB(@_)); 56238405Sjkim } 57238405Sjkim else 58238405Sjkim { &generic("bswap",@_); } 59238405Sjkim} 60238405Sjkim# These are made-up opcodes introduced over the years essentially 61238405Sjkim# by ignorance, just alias them to real ones... 62238405Sjkimsub ::movb { &mov(@_); } 63238405Sjkimsub ::xorb { &xor(@_); } 64238405Sjkimsub ::rotl { &rol(@_); } 65238405Sjkimsub ::rotr { &ror(@_); } 66238405Sjkimsub ::exch { &xchg(@_); } 67238405Sjkimsub ::halt { &hlt; } 68238405Sjkimsub ::movz { &movzx(@_); } 69238405Sjkimsub ::pushf { &pushfd; } 70238405Sjkimsub ::popf { &popfd; } 7155714Skris 72238405Sjkim# 3 argument instructions 73238405Sjkimsub ::movq 74238405Sjkim{ my($p1,$p2,$optimize)=@_; 7555714Skris 76238405Sjkim if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) 77238405Sjkim # movq between mmx registers can sink Intel CPUs 78238405Sjkim { &::pshufw($p1,$p2,0xe4); } 79238405Sjkim else 80238405Sjkim { &::generic("movq",@_); } 81238405Sjkim} 8255714Skris 83238405Sjkim# SSE>2 instructions 84238405Sjkimmy %regrm = ( "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3, 85238405Sjkim "esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7 ); 86238405Sjkimsub ::pextrd 87238405Sjkim{ my($dst,$src,$imm)=@_; 88238405Sjkim if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/) 89238405Sjkim { &::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm); } 90238405Sjkim else 91238405Sjkim { &::generic("pextrd",@_); } 92238405Sjkim} 9355714Skris 94238405Sjkimsub ::pinsrd 95238405Sjkim{ my($dst,$src,$imm)=@_; 96238405Sjkim if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/) 97238405Sjkim { &::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm); } 98238405Sjkim else 99238405Sjkim { &::generic("pinsrd",@_); } 100238405Sjkim} 10155714Skris 102238405Sjkimsub ::pshufb 103238405Sjkim{ my($dst,$src)=@_; 104238405Sjkim if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) 105238405Sjkim { &data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2); } 106238405Sjkim else 107238405Sjkim { &::generic("pshufb",@_); } 108238405Sjkim} 10955714Skris 110238405Sjkimsub ::palignr 111238405Sjkim{ my($dst,$src,$imm)=@_; 112238405Sjkim if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) 113238405Sjkim { &::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm); } 114238405Sjkim else 115238405Sjkim { &::generic("palignr",@_); } 116238405Sjkim} 11755714Skris 118238405Sjkimsub ::pclmulqdq 119238405Sjkim{ my($dst,$src,$imm)=@_; 120238405Sjkim if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) 121238405Sjkim { &::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm); } 122238405Sjkim else 123238405Sjkim { &::generic("pclmulqdq",@_); } 124238405Sjkim} 125238405Sjkim 126238405Sjkimsub ::rdrand 127238405Sjkim{ my ($dst)=@_; 128238405Sjkim if ($dst =~ /(e[a-dsd][ixp])/) 129238405Sjkim { &::data_byte(0x0f,0xc7,0xf0|$regrm{$dst}); } 130238405Sjkim else 131238405Sjkim { &::generic("rdrand",@_); } 132238405Sjkim} 133238405Sjkim 134238405Sjkim# label management 135238405Sjkim$lbdecor="L"; # local label decoration, set by package 136238405Sjkim$label="000"; 137238405Sjkim 138238405Sjkimsub ::islabel # see is argument is a known label 139238405Sjkim{ my $i; 140238405Sjkim foreach $i (values %label) { return $i if ($i eq $_[0]); } 141238405Sjkim $label{$_[0]}; # can be undef 142238405Sjkim} 143238405Sjkim 144238405Sjkimsub ::label # instantiate a function-scope label 145238405Sjkim{ if (!defined($label{$_[0]})) 146238405Sjkim { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } 147238405Sjkim $label{$_[0]}; 148238405Sjkim} 149238405Sjkim 150238405Sjkimsub ::LABEL # instantiate a file-scope label 151238405Sjkim{ $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); 152238405Sjkim $label{$_[0]}; 153238405Sjkim} 154238405Sjkim 155238405Sjkimsub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } 156238405Sjkim 157238405Sjkimsub ::set_label_B { push(@out,"@_:\n"); } 158238405Sjkimsub ::set_label 159238405Sjkim{ my $label=&::label($_[0]); 160238405Sjkim &::align($_[1]) if ($_[1]>1); 161238405Sjkim &::set_label_B($label); 162238405Sjkim $label; 163238405Sjkim} 164238405Sjkim 165238405Sjkimsub ::wipe_labels # wipes function-scope labels 166238405Sjkim{ foreach $i (keys %label) 167238405Sjkim { delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); } 168238405Sjkim} 169238405Sjkim 170238405Sjkim# subroutine management 171238405Sjkimsub ::function_begin 172238405Sjkim{ &function_begin_B(@_); 173238405Sjkim $stack=4; 174238405Sjkim &push("ebp"); 175238405Sjkim &push("ebx"); 176238405Sjkim &push("esi"); 177238405Sjkim &push("edi"); 178238405Sjkim} 179238405Sjkim 180238405Sjkimsub ::function_end 181238405Sjkim{ &pop("edi"); 182238405Sjkim &pop("esi"); 183238405Sjkim &pop("ebx"); 184238405Sjkim &pop("ebp"); 185238405Sjkim &ret(); 186238405Sjkim &function_end_B(@_); 187238405Sjkim $stack=0; 188238405Sjkim &wipe_labels(); 189238405Sjkim} 190238405Sjkim 191238405Sjkimsub ::function_end_A 192238405Sjkim{ &pop("edi"); 193238405Sjkim &pop("esi"); 194238405Sjkim &pop("ebx"); 195238405Sjkim &pop("ebp"); 196238405Sjkim &ret(); 197238405Sjkim $stack+=16; # readjust esp as if we didn't pop anything 198238405Sjkim} 199238405Sjkim 200238405Sjkimsub ::asciz 201238405Sjkim{ my @str=unpack("C*",shift); 202238405Sjkim push @str,0; 203238405Sjkim while ($#str>15) { 204238405Sjkim &data_byte(@str[0..15]); 205238405Sjkim foreach (0..15) { shift @str; } 206238405Sjkim } 207238405Sjkim &data_byte(@str) if (@str); 208238405Sjkim} 209238405Sjkim 210238405Sjkimsub ::asm_finish 211238405Sjkim{ &file_end(); 212238405Sjkim print @out; 213238405Sjkim} 214238405Sjkim 215238405Sjkimsub ::asm_init 216238405Sjkim{ my ($type,$fn,$cpu)=@_; 217238405Sjkim 218238405Sjkim $filename=$fn; 219238405Sjkim $i386=$cpu; 220238405Sjkim 221238405Sjkim $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$android=0; 222238405Sjkim if (($type eq "elf")) 223238405Sjkim { $elf=1; require "x86gas.pl"; } 224238405Sjkim elsif (($type eq "a\.out")) 225238405Sjkim { $aout=1; require "x86gas.pl"; } 226238405Sjkim elsif (($type eq "coff" or $type eq "gaswin")) 227238405Sjkim { $coff=1; require "x86gas.pl"; } 228238405Sjkim elsif (($type eq "win32n")) 229238405Sjkim { $win32=1; require "x86nasm.pl"; } 230238405Sjkim elsif (($type eq "nw-nasm")) 231238405Sjkim { $netware=1; require "x86nasm.pl"; } 232238405Sjkim #elsif (($type eq "nw-mwasm")) 233238405Sjkim #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } 234238405Sjkim elsif (($type eq "win32")) 235238405Sjkim { $win32=1; require "x86masm.pl"; } 236238405Sjkim elsif (($type eq "macosx")) 237238405Sjkim { $aout=1; $macosx=1; require "x86gas.pl"; } 238238405Sjkim elsif (($type eq "android")) 239238405Sjkim { $elf=1; $android=1; require "x86gas.pl"; } 240238405Sjkim else 241238405Sjkim { print STDERR <<"EOF"; 242238405SjkimPick one target type from 243238405Sjkim elf - Linux, FreeBSD, Solaris x86, etc. 244238405Sjkim a.out - DJGPP, elder OpenBSD, etc. 245238405Sjkim coff - GAS/COFF such as Win32 targets 246238405Sjkim win32n - Windows 95/Windows NT NASM format 247238405Sjkim nw-nasm - NetWare NASM format 248238405Sjkim macosx - Mac OS X 24955714SkrisEOF 250238405Sjkim exit(1); 251238405Sjkim } 25255714Skris 253238405Sjkim $pic=0; 254238405Sjkim for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } 255238405Sjkim 256238405Sjkim $filename =~ s/\.pl$//; 257238405Sjkim &file($filename); 258238405Sjkim} 259238405Sjkim 260299983Sjkimsub ::hidden {} 261299983Sjkim 26255714Skris1; 263