Alexandre Savard | 1b09e31 | 2012-08-07 20:33:29 -0400 | [diff] [blame] | 1 | #!/usr/bin/env perl |
| 2 | |
| 3 | # require 'x86asm.pl'; |
| 4 | # &asm_init(<flavor>,"des-586.pl"[,$i386only]); |
| 5 | # &function_begin("foo"); |
| 6 | # ... |
| 7 | # &function_end("foo"); |
| 8 | # &asm_finish |
| 9 | |
| 10 | $out=(); |
| 11 | $i386=0; |
| 12 | |
| 13 | # AUTOLOAD is this context has quite unpleasant side effect, namely |
| 14 | # that typos in function calls effectively go to assembler output, |
| 15 | # but on the pros side we don't have to implement one subroutine per |
| 16 | # each opcode... |
| 17 | sub ::AUTOLOAD |
| 18 | { my $opcode = $AUTOLOAD; |
| 19 | |
| 20 | die "more than 4 arguments passed to $opcode" if ($#_>3); |
| 21 | |
| 22 | $opcode =~ s/.*:://; |
| 23 | if ($opcode =~ /^push/) { $stack+=4; } |
| 24 | elsif ($opcode =~ /^pop/) { $stack-=4; } |
| 25 | |
| 26 | &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD"; |
| 27 | } |
| 28 | |
| 29 | sub ::emit |
| 30 | { my $opcode=shift; |
| 31 | |
| 32 | if ($#_==-1) { push(@out,"\t$opcode\n"); } |
| 33 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } |
| 34 | } |
| 35 | |
| 36 | sub ::LB |
| 37 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; |
| 38 | $1."l"; |
| 39 | } |
| 40 | sub ::HB |
| 41 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; |
| 42 | $1."h"; |
| 43 | } |
| 44 | sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } |
| 45 | sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } |
| 46 | sub ::blindpop { &pop($_[0]); $stack+=4; } |
| 47 | sub ::wparam { &DWP($stack+4*$_[0],"esp"); } |
| 48 | sub ::swtmp { &DWP(4*$_[0],"esp"); } |
| 49 | |
| 50 | sub ::bswap |
| 51 | { if ($i386) # emulate bswap for i386 |
| 52 | { &comment("bswap @_"); |
| 53 | &xchg(&HB(@_),&LB(@_)); |
| 54 | &ror (@_,16); |
| 55 | &xchg(&HB(@_),&LB(@_)); |
| 56 | } |
| 57 | else |
| 58 | { &generic("bswap",@_); } |
| 59 | } |
| 60 | # These are made-up opcodes introduced over the years essentially |
| 61 | # by ignorance, just alias them to real ones... |
| 62 | sub ::movb { &mov(@_); } |
| 63 | sub ::xorb { &xor(@_); } |
| 64 | sub ::rotl { &rol(@_); } |
| 65 | sub ::rotr { &ror(@_); } |
| 66 | sub ::exch { &xchg(@_); } |
| 67 | sub ::halt { &hlt; } |
| 68 | sub ::movz { &movzx(@_); } |
| 69 | sub ::pushf { &pushfd; } |
| 70 | sub ::popf { &popfd; } |
| 71 | |
| 72 | # 3 argument instructions |
| 73 | sub ::movq |
| 74 | { my($p1,$p2,$optimize)=@_; |
| 75 | |
| 76 | if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) |
| 77 | # movq between mmx registers can sink Intel CPUs |
| 78 | { &::pshufw($p1,$p2,0xe4); } |
| 79 | else |
| 80 | { &::generic("movq",@_); } |
| 81 | } |
| 82 | |
Alexandre Savard | 1b09e31 | 2012-08-07 20:33:29 -0400 | [diff] [blame] | 83 | # label management |
| 84 | $lbdecor="L"; # local label decoration, set by package |
| 85 | $label="000"; |
| 86 | |
| 87 | sub ::islabel # see is argument is a known label |
| 88 | { my $i; |
| 89 | foreach $i (values %label) { return $i if ($i eq $_[0]); } |
| 90 | $label{$_[0]}; # can be undef |
| 91 | } |
| 92 | |
| 93 | sub ::label # instantiate a function-scope label |
| 94 | { if (!defined($label{$_[0]})) |
| 95 | { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } |
| 96 | $label{$_[0]}; |
| 97 | } |
| 98 | |
| 99 | sub ::LABEL # instantiate a file-scope label |
| 100 | { $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); |
| 101 | $label{$_[0]}; |
| 102 | } |
| 103 | |
| 104 | sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } |
| 105 | |
| 106 | sub ::set_label_B { push(@out,"@_:\n"); } |
| 107 | sub ::set_label |
| 108 | { my $label=&::label($_[0]); |
| 109 | &::align($_[1]) if ($_[1]>1); |
| 110 | &::set_label_B($label); |
| 111 | $label; |
| 112 | } |
| 113 | |
| 114 | sub ::wipe_labels # wipes function-scope labels |
| 115 | { foreach $i (keys %label) |
| 116 | { delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); } |
| 117 | } |
| 118 | |
| 119 | # subroutine management |
| 120 | sub ::function_begin |
| 121 | { &function_begin_B(@_); |
| 122 | $stack=4; |
| 123 | &push("ebp"); |
| 124 | &push("ebx"); |
| 125 | &push("esi"); |
| 126 | &push("edi"); |
| 127 | } |
| 128 | |
| 129 | sub ::function_end |
| 130 | { &pop("edi"); |
| 131 | &pop("esi"); |
| 132 | &pop("ebx"); |
| 133 | &pop("ebp"); |
| 134 | &ret(); |
| 135 | &function_end_B(@_); |
| 136 | $stack=0; |
| 137 | &wipe_labels(); |
| 138 | } |
| 139 | |
| 140 | sub ::function_end_A |
| 141 | { &pop("edi"); |
| 142 | &pop("esi"); |
| 143 | &pop("ebx"); |
| 144 | &pop("ebp"); |
| 145 | &ret(); |
| 146 | $stack+=16; # readjust esp as if we didn't pop anything |
| 147 | } |
| 148 | |
| 149 | sub ::asciz |
| 150 | { my @str=unpack("C*",shift); |
| 151 | push @str,0; |
| 152 | while ($#str>15) { |
| 153 | &data_byte(@str[0..15]); |
| 154 | foreach (0..15) { shift @str; } |
| 155 | } |
| 156 | &data_byte(@str) if (@str); |
| 157 | } |
| 158 | |
| 159 | sub ::asm_finish |
| 160 | { &file_end(); |
| 161 | print @out; |
| 162 | } |
| 163 | |
| 164 | sub ::asm_init |
| 165 | { my ($type,$fn,$cpu)=@_; |
| 166 | |
| 167 | $filename=$fn; |
| 168 | $i386=$cpu; |
| 169 | |
Alexandre Savard | 7541067 | 2012-08-08 09:50:01 -0400 | [diff] [blame] | 170 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=0; |
Alexandre Savard | 1b09e31 | 2012-08-07 20:33:29 -0400 | [diff] [blame] | 171 | if (($type eq "elf")) |
| 172 | { $elf=1; require "x86gas.pl"; } |
| 173 | elsif (($type eq "a\.out")) |
| 174 | { $aout=1; require "x86gas.pl"; } |
| 175 | elsif (($type eq "coff" or $type eq "gaswin")) |
| 176 | { $coff=1; require "x86gas.pl"; } |
| 177 | elsif (($type eq "win32n")) |
| 178 | { $win32=1; require "x86nasm.pl"; } |
| 179 | elsif (($type eq "nw-nasm")) |
| 180 | { $netware=1; require "x86nasm.pl"; } |
| 181 | #elsif (($type eq "nw-mwasm")) |
| 182 | #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } |
| 183 | elsif (($type eq "win32")) |
| 184 | { $win32=1; require "x86masm.pl"; } |
| 185 | elsif (($type eq "macosx")) |
| 186 | { $aout=1; $macosx=1; require "x86gas.pl"; } |
Alexandre Savard | 1b09e31 | 2012-08-07 20:33:29 -0400 | [diff] [blame] | 187 | else |
| 188 | { print STDERR <<"EOF"; |
| 189 | Pick one target type from |
| 190 | elf - Linux, FreeBSD, Solaris x86, etc. |
| 191 | a.out - DJGPP, elder OpenBSD, etc. |
| 192 | coff - GAS/COFF such as Win32 targets |
| 193 | win32n - Windows 95/Windows NT NASM format |
| 194 | nw-nasm - NetWare NASM format |
| 195 | macosx - Mac OS X |
| 196 | EOF |
| 197 | exit(1); |
| 198 | } |
| 199 | |
| 200 | $pic=0; |
| 201 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } |
| 202 | |
| 203 | $filename =~ s/\.pl$//; |
| 204 | &file($filename); |
| 205 | } |
| 206 | |
| 207 | 1; |