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