perlasm/x86masm.pl: fix last fix.
[openssl.git] / crypto / perlasm / x86nasm.pl
index 604f58a..ca2511c 100644 (file)
@@ -4,11 +4,10 @@ package x86nasm;
 
 *out=\@::out;
 
-$lbdecor="\@L";                        # local label decoration
+$::lbdecor="L\$";              # local label decoration
 $nmdecor=$::netware?"":"_";    # external name decoration
 $drdecor=$::mwerks?".":"";     # directive decoration
 
-$label="000";
 $initseg="";
 
 sub ::generic
@@ -18,8 +17,10 @@ sub ::generic
     if (!$::mwerks)
     {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
        {   $_[0] = "NEAR $_[0]";       }
-       elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
+       elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
        {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
+       elsif ($opcode eq "clflush" && $#_==0)
+       {   $_[0] =~ s/^[^\[]*\[/\[/o;  }
     }
     &::emit($opcode,@_);
   1;
@@ -27,26 +28,10 @@ sub ::generic
 #
 # opcodes not covered by ::generic above, mostly inconsistent namings...
 #
-sub ::movz     { &::movzx(@_);         }
-sub ::pushf    { &::pushfd;            }
-sub ::popf     { &::popfd;             }
-
-sub ::call     { &::emit("call",(&islabel($_[0]) or "$nmdecor$_[0]")); }
+sub ::call     { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
 sub ::call_ptr { &::emit("call",@_);   }
 sub ::jmp_ptr  { &::emit("jmp",@_);    }
 
-# chosen SSE instructions
-sub ::movq
-{ my($p1,$p2,$optimize)=@_;
-
-    if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
-    # movq between mmx registers can sink Intel CPUs
-    {  &::pshufw($p1,$p2,0xe4);                }
-    else
-    {  &::emit("movq",@_);                     }
-}
-sub ::pshufw { &::emit("pshufw",@_); }
-
 sub get_mem
 { my($size,$addr,$reg1,$reg2,$idx)=@_;
   my($post,$ret);
@@ -60,7 +45,7 @@ sub get_mem
 
     $addr =~ s/^\s+//;
     # prepend global references with optional underscore
-    $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$nmdecor$1"/ige;
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
     # put address arithmetic expression in parenthesis
     $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
 
@@ -84,18 +69,22 @@ sub get_mem
 }
 sub ::BP       { &get_mem("BYTE",@_);  }
 sub ::DWP      { &get_mem("DWORD",@_); }
+sub ::WP       { &get_mem("WORD",@_);  }
 sub ::QWP      { &get_mem("",@_);      }
 sub ::BC       { (($::mwerks)?"":"BYTE ")."@_";  }
 sub ::DWC      { (($::mwerks)?"":"DWORD ")."@_"; }
 
 sub ::file
-{   if ($::mwerks)     { push(@out,".section\t.text\n"); }
+{   if ($::mwerks)     { push(@out,".section\t.text,64\n"); }
     else
     { my $tmp=<<___;
-%ifdef __omf__
+%ifidn __OUTPUT_FORMAT__,obj
 section        code    use32 class=code align=64
-%else
+%elifidn __OUTPUT_FORMAT__,win32
+\$\@feat.00 equ 1
 section        .text   code align=64
+%else
+section        .text   code
 %endif
 ___
        push(@out,$tmp);
@@ -105,9 +94,11 @@ ___
 sub ::function_begin_B
 { my $func=shift;
   my $global=($func !~ /^_/);
-  my $begin="${lbdecor}_${func}_begin";
+  my $begin="${::lbdecor}_${func}_begin";
 
-    $label{$func}=$global?"$begin":"$nmdecor$func";
+    $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops
+
+    &::LABEL($func,$global?"$begin":"$nmdecor$func");
     $func=$nmdecor.$func;
 
     push(@out,"${drdecor}global        $func\n")       if ($global);
@@ -116,126 +107,39 @@ sub ::function_begin_B
     push(@out,"$begin:\n")                     if ($global);
     $::stack=4;
 }
+
 sub ::function_end_B
-{ my $i;
-    foreach $i (keys %label)
-    {  delete $label{$i} if ($label{$i} =~ /^${lbdecor}[0-9]{3}/);     }
-    $::stack=0;
+{   $::stack=0;
+    &::wipe_labels();
 }
 
 sub ::file_end
-{   # try to detect if SSE2 or MMX extensions were used on Win32...
-    if ($::win32 && grep {/\b[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out)
-    {  # $1<<10 sets a reserved bit to signal that variable
-       # was initialized already...
-       my $code=<<___;
-align  16
-${lbdecor}OPENSSL_ia32cap_init:
-       lea     edx,[${nmdecor}OPENSSL_ia32cap_P]
-       cmp     DWORD [edx],0
-       jne     NEAR ${lbdecor}nocpuid
-       mov     DWORD [edx],1<<10
-       pushfd
-       pop     eax
-       mov     ecx,eax
-       xor     eax,1<<21
-       push    eax
-       popfd
-       pushfd
-       pop     eax
-       xor     eax,ecx
-       bt      eax,21
-       jnc     NEAR ${lbdecor}nocpuid
-       push    ebp
-       push    edi
-       push    ebx
-       mov     edi,edx
-       xor     eax,eax
-       cpuid
-       xor     eax,eax
-       cmp     ebx,'Genu'
-       setne   al
-       mov     ebp,eax
-       cmp     edx,'ineI'
-       setne   al
-       or      ebp,eax
-       cmp     eax,'ntel'
-       setne   al
-       or      ebp,eax
-       mov     eax,1
-       cpuid
-       cmp     ebp,0
-       jne     ${lbdecor}notP4
-       and     ah,15
-       cmp     ah,15
-       jne     ${lbdecor}notP4
-       or      edx,1<<20
-${lbdecor}notP4:
-       bt      edx,28
-       jnc     ${lbdecor}done
-       shr     ebx,16
-       cmp     bl,1
-       ja      ${lbdecor}done
-       and     edx,0xefffffff
-${lbdecor}done:
-       or      edx,1<<10
-       mov     DWORD [edi],edx
-       pop     ebx
-       pop     edi
-       pop     ebp
-${lbdecor}nocpuid:
-       ret
-segment        .CRT\$XCU data align=4
-dd     ${lbdecor}OPENSSL_ia32cap_init
+{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
+    {  my $comm=<<___;
+${drdecor}segment      .bss
+${drdecor}common       ${nmdecor}OPENSSL_ia32cap_P 8
 ___
-       my $data=<<___;
-segment        .bss
-common ${nmdecor}OPENSSL_ia32cap_P 4
-___
-
-       #<not needed in OpenSSL context>#push (@out,$code);
-
        # comment out OPENSSL_ia32cap_P declarations
        grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
-       push (@out,$data)
+       push (@out,$comm)
     }
     push (@out,$initseg) if ($initseg);                
 }
 
 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 
-sub islabel    # see is argument is known label
-{ my $i;
-    foreach $i (values %label) { return $i if ($i eq $_[0]); }
-  $label{$_[0]};       # can be undef
-}
-
 sub ::external_label
-{   push(@labels,@_);
-    foreach (@_)
-    {  push(@out, "${drdecor}extern\t${nmdecor}$_\n"); }
+{   foreach(@_)
+    {  push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n");   }
 }
 
 sub ::public_label
-{   $label{$_[0]}="${nmdecor}${_[0]}" if (!defined($label{$_[0]}));
-    push(@out,"${drdecor}global\t$label{$_[0]}\n");
-}
-
-sub ::label
-{   if (!defined($label{$_[0]}))
-    {  $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
-  $label{$_[0]};
-}
-
-sub ::set_label
-{ my $label=&::label($_[0]);
-    &::align($_[1]) if ($_[1]>1);
-    push(@out,"$label{$_[0]}:\n");
-}
+{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
 
 sub ::data_byte
 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");       }
-
+sub ::data_short
+{   push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n");       }
 sub ::data_word
 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");       }
 
@@ -248,7 +152,7 @@ sub ::picmeup
 }
 
 sub ::initseg
-{ my($f)=$nmdecor.shift;
+{ my $f=$nmdecor.shift;
     if ($::win32)
     {  $initseg=<<___;
 segment        .CRT\$XCU data align=4
@@ -258,4 +162,16 @@ ___
     }
 }
 
+sub ::dataseg
+{   if ($mwerks)       { push(@out,".section\t.data,4\n");   }
+    else               { push(@out,"section\t.data align=4\n"); }
+}
+
+sub ::safeseh
+{ my $nm=shift;
+    push(@out,"%if     __NASM_VERSION_ID__ >= 0x02030000\n");
+    push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n");
+    push(@out,"%endif\n");
+}
+
 1;