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 rdata align=4
 159 dd      ${lprfx}OPENSSL_ia32cap_init
 160 segment .bss
 161 common  ${under}OPENSSL_ia32cap_P 4
 162 ___
 163         grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out;
 164         push (@out,$tmp);
 165     }
 166 }
 167
 168 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 169
 170 sub islabel     # see is argument is known label
 171 { my $i;
 172     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
 173   undef;
 174 }
 175
 176 sub ::external_label
 177 {   push(@labels,@_);
 178     foreach (@_)
 179     {   push(@out,".") if ($::mwerks);
 180         push(@out, "extern\t${under}$_\n");
 181     }
 182 }
 183
 184 sub ::public_label
 185 {   $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
 186     push(@out,"global\t$label{$_[0]}\n");
 187 }
 188
 189 sub ::label
 190 {   if (!defined($label{$_[0]}))
 191     {   $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++;   }
 192   $label{$_[0]};
 193 }
 194
 195 sub ::set_label
 196 { my $label=&::label($_[0]);
 197     &::align($_[1]) if ($_[1]>1);
 198     push(@out,"$label{$_[0]}:\n");
 199 }
 200
 201 sub ::data_byte
 202 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
 203
 204 sub ::data_word
 205 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
 206
 207 sub ::align
 208 {   push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); }
 209
 210 sub ::picmeup
 211 { my($dst,$sym)=@_;
 212     &::lea($dst,&::DWP($sym));
 213 }
 214
 215 sub ::initseg
 216 { my($f)=$under.shift;
 217     if ($::win32)
 218     { my($tmp)=<<___;
 219 segment .CRT\$XCU rdata align=4
 220 extern  $f
 221 dd      $f
 222 ___
 223         push(@out,$tmp);
 224     }
 225 }
 226
 227 1;