crypto/perlasm/x86asm.pl

   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 # AUTOLOAD is this context has quite unpleasant side effect, namely
  11 # that typos in function calls effectively go to assembler output,
  12 # but on the pros side we don't have to implement one subroutine per
  13 # each opcode...
  14 sub ::AUTOLOAD
  15 { my $opcode = $AUTOLOAD;
  16
  17     die "more than 2 arguments passed to $opcode" if ($#_>1);
  18
  19     $opcode =~ s/.*:://;
  20     if    ($opcode =~ /^push/) { $stack+=4; }
  21     elsif ($opcode =~ /^pop/)  { $stack-=4; }
  22
  23     &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
  24 }
  25
  26 $out=();
  27 $i386=0;
  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
  69 sub ::function_begin
  70 {   &function_begin_B(@_);
  71     $stack=4;
  72     &push("ebp");
  73     &push("ebx");
  74     &push("esi");
  75     &push("edi");
  76 }
  77
  78 sub ::function_end
  79 {   &pop("edi");
  80     &pop("esi");
  81     &pop("ebx");
  82     &pop("ebp");
  83     &ret();
  84     $stack=0;
  85     &function_end_B(@_);
  86 }
  87
  88 sub ::function_end_A
  89 {   &pop("edi");
  90     &pop("esi");
  91     &pop("ebx");
  92     &pop("ebp");
  93     &ret();
  94     $stack+=16; # readjust esp as if we didn't pop anything
  95 }
  96
  97 sub ::asm_finish
  98 {   &file_end();
  99     print @out;
 100 }
 101
 102 sub ::asm_init
 103 { my ($type,$fn,$cpu)=@_;
 104
 105     $filename=$fn;
 106     $i386=$cpu;
 107
 108     $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;
 109     if    (($type eq "elf"))
 110     {   $elf=1;                 require "x86unix.pl";   }
 111     elsif (($type eq "a\.out"))
 112     {   $aout=1;                require "x86unix.pl";   }
 113     elsif (($type eq "coff" or $type eq "gaswin"))
 114     {   $coff=1;                require "x86unix.pl";   }
 115     elsif (($type eq "win32n"))
 116     {   $win32=1;               require "x86nasm.pl";   }
 117     elsif (($type eq "nw-nasm"))
 118     {   $netware=1;             require "x86nasm.pl";   }
 119     elsif (($type eq "nw-mwasm"))
 120     {   $netware=1; $mwerks=1;  require "x86nasm.pl";   }
 121     else
 122     {   print STDERR <<"EOF";
 123 Pick one target type from
 124         elf     - Linux, FreeBSD, Solaris x86, etc.
 125         a.out   - DJGPP, elder OpenBSD, etc.
 126         coff    - GAS/COFF such as Win32 targets
 127         win32n  - Windows 95/Windows NT NASM format
 128         nw-nasm - NetWare NASM format
 129         nw-mwasm- NetWare Metrowerks Assembler
 130 EOF
 131         exit(1);
 132     }
 133
 134     $pic=0;
 135     for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
 136
 137     $filename =~ s/\.pl$//;
 138     &file($filename);
 139 }
 140
 141 1;