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=shift;
 105   my $begin="${lprfx}_${func}_begin";
 106   my $tmp=<<___;
 107 global  $func
 108 align   16
 109 $under$func:
 110 $begin:
 111 ___
 112     $label{$func}=$begin;
 113     push(@out,$tmp);
 114     $::stack=4;
 115 }
 116 sub ::function_end_B
 117 { my $i;
 118     foreach $i (keys %label) { delete $label{$i} if ($label{$i} =~ /^${lprfx}[0-9]{3}/);  }
 119     $::stack=0;
 120 }
 121
 122 sub ::file_end
 123 {   # try to detect if SSE2 or MMX extensions were used on Win32...
 124     if ($::win32 && grep {/\b[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out)
 125     {   # $1<<10 sets a reserved bit to signal that variable
 126         # was initialized already...
 127         my $code=<<___;
 128 align   16
 129 ${lprfx}OPENSSL_ia32cap_init:
 130         lea     edx,[${under}OPENSSL_ia32cap_P]
 131         cmp     DWORD [edx],0
 132         jne     NEAR ${lprfx}nocpuid
 133         mov     DWORD [edx],1<<10
 134         pushfd
 135         pop     eax
 136         mov     ecx,eax
 137         xor     eax,1<<21
 138         push    eax
 139         popfd
 140         pushfd
 141         pop     eax
 142         xor     eax,ecx
 143         bt      eax,21
 144         jnc     NEAR ${lprfx}nocpuid
 145         push    ebp
 146         push    edi
 147         push    ebx
 148         mov     edi,edx
 149         xor     eax,eax
 150         cpuid
 151         xor     eax,eax
 152         cmp     ebx,'Genu'
 153         setne   al
 154         mov     ebp,eax
 155         cmp     edx,'ineI'
 156         setne   al
 157         or      ebp,eax
 158         cmp     eax,'ntel'
 159         setne   al
 160         or      ebp,eax
 161         mov     eax,1
 162         cpuid
 163         cmp     ebp,0
 164         jne     ${lprfx}notP4
 165         and     ah,15
 166         cmp     ah,15
 167         jne     ${lprfx}notP4
 168         or      edx,1<<20
 169 ${lprfx}notP4:
 170         bt      edx,28
 171         jnc     ${lprfx}done
 172         shr     ebx,16
 173         cmp     bl,1
 174         ja      ${lprfx}done
 175         and     edx,0xefffffff
 176 ${lprfx}done:
 177         or      edx,1<<10
 178         mov     DWORD [edi],edx
 179         pop     ebx
 180         pop     edi
 181         pop     ebp
 182 ${lprfx}nocpuid:
 183         ret
 184 segment .CRT\$XCU data align=4
 185 dd      ${lprfx}OPENSSL_ia32cap_init
 186 ___
 187         my $data=<<___;
 188 segment .bss
 189 common  ${under}OPENSSL_ia32cap_P 4
 190 ___
 191
 192         #<not needed in OpenSSL context>#push (@out,$code);
 193
 194         # comment out OPENSSL_ia32cap_P declarations
 195         grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out;
 196         push (@out,$data)
 197     }
 198     push (@out,$initseg) if ($initseg);
 199 }
 200
 201 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 202
 203 sub islabel     # see is argument is known label
 204 { my $i;
 205     foreach $i (values %label) { return $i if ($i eq $_[0]); }
 206   $label{$_[0]};        # can be undef
 207 }
 208
 209 sub ::external_label
 210 {   push(@labels,@_);
 211     foreach (@_)
 212     {   push(@out,".") if ($::mwerks);
 213         push(@out, "extern\t${under}$_\n");
 214     }
 215 }
 216
 217 sub ::public_label
 218 {   $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
 219     push(@out,"global\t$label{$_[0]}\n");
 220 }
 221
 222 sub ::label
 223 {   if (!defined($label{$_[0]}))
 224     {   $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++;   }
 225   $label{$_[0]};
 226 }
 227
 228 sub ::set_label
 229 { my $label=&::label($_[0]);
 230     &::align($_[1]) if ($_[1]>1);
 231     push(@out,"$label{$_[0]}:\n");
 232 }
 233
 234 sub ::data_byte
 235 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
 236
 237 sub ::data_word
 238 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
 239
 240 sub ::align
 241 {   push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); }
 242
 243 sub ::picmeup
 244 { my($dst,$sym)=@_;
 245     &::lea($dst,&::DWP($sym));
 246 }
 247
 248 sub ::initseg
 249 { my($f)=$under.shift;
 250     if ($::win32)
 251     {   $initseg=<<___;
 252 segment .CRT\$XCU data align=4
 253 extern  $f
 254 dd      $f
 255 ___
 256     }
 257 }
 258
 259 1;