crypto/perlasm/x86nasm.pl

   1 #!/usr/bin/env perl
   2
   3 package x86nasm;
   4
   5 *out=\@::out;
   6
   7 $lprfx="\@L";
   8 $label="000";
   9 $under=($::netware)?'':'_';
  10
  11 sub ::generic
  12 { my $opcode=shift;
  13   my $tmp;
  14
  15     if (!$::mwerks)
  16     {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
  17         {   $_[0] = "NEAR $_[0]";       }
  18         elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
  19         {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
  20     }
  21     &::emit($opcode,@_);
  22   1;
  23 }
  24 #
  25 # opcodes not covered by ::generic above, mostly inconsistent namings...
  26 #
  27 sub ::movz      { &::movzx(@_);         }
  28 sub ::pushf     { &::pushfd;            }
  29 sub ::popf      { &::popfd;             }
  30
  31 sub ::call      { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); }
  32 sub ::call_ptr  { &::emit("call",@_);   }
  33 sub ::jmp_ptr   { &::emit("jmp",@_);    }
  34
  35 # chosen SSE instructions
  36 sub ::movq
  37 { my($p1,$p2,$optimize)=@_;
  38
  39     if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
  40     # movq between mmx registers can sink Intel CPUs
  41     {   &::pshufw($p1,$p2,0xe4);                }
  42     else
  43     {   &::emit("movq",@_);                     }
  44 }
  45 sub ::pshufw { &::emit("pshufw",@_); }
  46
  47 sub get_mem
  48 { my($size,$addr,$reg1,$reg2,$idx)=@_;
  49   my($post,$ret);
  50
  51     if ($size ne "")
  52     {   $ret .= "$size";
  53         $ret .= " PTR" if ($::mwerks);
  54         $ret .= " ";
  55     }
  56     $ret .= "[";
  57
  58     $addr =~ s/^\s+//;
  59     # prepend global references with optional underscore
  60     $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
  61     # put address arithmetic expression in parenthesis
  62     $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
  63
  64     if (($addr ne "") && ($addr ne 0))
  65     {   if ($addr !~ /^-/)      { $ret .= "$addr+"; }
  66         else                    { $post=$addr;      }
  67     }
  68
  69     if ($reg2 ne "")
  70     {   $idx!=0 or $idx=1;
  71         $ret .= "$reg2*$idx";
  72         $ret .= "+$reg1" if ($reg1 ne "");
  73     }
  74     else
  75     {   $ret .= "$reg1";   }
  76
  77     $ret .= "$post]";
  78     $ret =~ s/\+\]/]/; # in case $addr was the only argument
  79
  80   $ret;
  81 }
  82 sub ::BP        { &get_mem("BYTE",@_);  }
  83 sub ::DWP       { &get_mem("DWORD",@_); }
  84 sub ::QWP       { &get_mem("",@_);      }
  85 sub ::BC        { (($::mwerks)?"":"BYTE ")."@_";  }
  86 sub ::DWC       { (($::mwerks)?"":"DWORD ")."@_"; }
  87
  88 sub ::file
  89 {   if ($::mwerks)      { push(@out,".section\t.text\n"); }
  90     else
  91     { my $tmp=<<___;
  92 %ifdef __omf__
  93 section code    use32 class=code align=64
  94 %else
  95 section .text   code align=64
  96 %endif
  97 ___
  98         push(@out,$tmp);
  99     }
 100 }
 101
 102 sub ::function_begin_B
 103 { my $func=$under.shift;
 104   my $tmp=<<___;
 105 global  $func
 106 align   16
 107 $func:
 108 ___
 109     push(@out,$tmp);
 110     $::stack=4;
 111 }
 112 sub ::function_end_B
 113 { my $i;
 114     foreach $i (%label) { undef $label{$i} if ($label{$i} =~ /^$prfx/);  }
 115     $::stack=0;
 116 }
 117
 118 sub ::file_end
 119 {   # try to detect if SSE2 or MMX extensions were used on Win32...
 120     if ($::win32 && grep {/\s+[x]*mm[0-7]/i} @out)
 121     {   # One can argue that it's wasteful to craft every
 122         # SSE/MMX module with this snippet... Well, it's 72
 123         # bytes long and for the moment we have two modules.
 124         # Let's argue when we have 7 modules or so...
 125         #
 126         # $1<<10 sets a reserved bit to signal that variable
 127         # was initialized already...
 128         my $tmp=<<___;
 129 align   16
 130 ${lprfx}OPENSSL_ia32cap_init:
 131         lea     edx,[${under}OPENSSL_ia32cap_P]
 132         cmp     DWORD [edx],0
 133         jne     NEAR ${lprfx}nocpuid
 134         mov     DWORD [edx],1<<10
 135         pushfd
 136         pop     eax
 137         mov     ecx,eax
 138         xor     eax,1<<21
 139         push    eax
 140         popfd
 141         pushfd
 142         pop     eax
 143         xor     eax,ecx
 144         bt      eax,21
 145         jnc     NEAR ${lprfx}nocpuid
 146         push    edi
 147         push    ebx
 148         mov     edi,edx
 149         mov     eax,1
 150         cpuid
 151         or      edx,1<<10
 152         mov     DWORD [edi],edx
 153         pop     ebx
 154         pop     edi
 155 ${lprfx}nocpuid:
 156         ret
 157
 158 segment .CRT\$XCU data align=4
 159 dd      ${lprfx}OPENSSL_ia32cap_init
 160 segment .bss
 161 common  ${under}OPENSSL_ia32cap_P 4
 162 ___
 163         # comment out OPENSSL_ia32cap_P declarations
 164         grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out;
 165         push (@out,$tmp);
 166     }
 167 }
 168
 169 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 170
 171 sub islabel     # see is argument is known label
 172 { my $i;
 173     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
 174   undef;
 175 }
 176
 177 sub ::external_label
 178 {   push(@labels,@_);
 179     foreach (@_)
 180     {   push(@out,".") if ($::mwerks);
 181         push(@out, "extern\t${under}$_\n");
 182     }
 183 }
 184
 185 sub ::public_label
 186 {   $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
 187     push(@out,"global\t$label{$_[0]}\n");
 188 }
 189
 190 sub ::label
 191 {   if (!defined($label{$_[0]}))
 192     {   $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++;   }
 193   $label{$_[0]};
 194 }
 195
 196 sub ::set_label
 197 { my $label=&::label($_[0]);
 198     &::align($_[1]) if ($_[1]>1);
 199     push(@out,"$label{$_[0]}:\n");
 200 }
 201
 202 sub ::data_byte
 203 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
 204
 205 sub ::data_word
 206 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
 207
 208 sub ::align
 209 {   push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); }
 210
 211 sub ::picmeup
 212 { my($dst,$sym)=@_;
 213     &::lea($dst,&::DWP($sym));
 214 }
 215
 216 sub ::initseg
 217 { my($f)=$under.shift;
 218     if ($::win32)
 219     { my($tmp)=<<___;
 220 segment .CRT\$XCU rdata align=4
 221 extern  $f
 222 dd      $f
 223 ___
 224         push(@out,$tmp);
 225     }
 226 }
 227
 228 1;