1 files changed, 166 insertions, 0 deletions

diff --git a/src/lib/libcrypto/perlasm/x86nasm.pl b/src/lib/libcrypto/perlasm/x86nasm.pl
new file mode 100644
index 0000000000..ce2bed9bb2
--- /dev/null
+++ b/src/lib/libcrypto/perlasm/x86nasm.pl
@@ -0,0 +1,166 @@
+#!/usr/bin/env perl
+
+package x86nasm;
+
+*out=\@::out;
+
+$::lbdecor="L\$";               # local label decoration
+$nmdecor=$::netware?"":"_";     # external name decoration
+$drdecor=$::mwerks?".":"";      # directive decoration
+
+$initseg="";
+
+sub ::generic
+{ my $opcode=shift;
+  my $tmp;
+
+    if (!$::mwerks)
+    {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
+        {   $_[0] = "NEAR $_[0]";       }
+        elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
+        {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
+    }
+    &::emit($opcode,@_);
+  1;
+}
+#
+# opcodes not covered by ::generic above, mostly inconsistent namings...
+#
+sub ::call      { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
+sub ::call_ptr  { &::emit("call",@_);   }
+sub ::jmp_ptr   { &::emit("jmp",@_);    }
+
+sub get_mem
+{ my($size,$addr,$reg1,$reg2,$idx)=@_;
+  my($post,$ret);
+
+    if ($size ne "")
+    {   $ret .= "$size";
+        $ret .= " PTR" if ($::mwerks);
+        $ret .= " ";
+    }
+    $ret .= "[";
+
+    $addr =~ s/^\s+//;
+    # prepend global references with optional underscore
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
+    # put address arithmetic expression in parenthesis
+    $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
+
+    if (($addr ne "") && ($addr ne 0))
+    {   if ($addr !~ /^-/)      { $ret .= "$addr+"; }
+        else                    { $post=$addr;      }
+    }
+
+    if ($reg2 ne "")
+    {   $idx!=0 or $idx=1;
+        $ret .= "$reg2*$idx";
+        $ret .= "+$reg1" if ($reg1 ne "");
+    }
+    else
+    {   $ret .= "$reg1";   }
+
+    $ret .= "$post]";
+    $ret =~ s/\+\]/]/; # in case $addr was the only argument
+
+  $ret;
+}
+sub ::BP        { &get_mem("BYTE",@_);  }
+sub ::DWP       { &get_mem("DWORD",@_); }
+sub ::QWP       { &get_mem("",@_);      }
+sub ::BC        { (($::mwerks)?"":"BYTE ")."@_";  }
+sub ::DWC       { (($::mwerks)?"":"DWORD ")."@_"; }
+
+sub ::file
+{   if ($::mwerks)      { push(@out,".section\t.text,64\n"); }
+    else
+    { my $tmp=<<___;
+%ifidn __OUTPUT_FORMAT__,obj
+section code    use32 class=code align=64
+%elifidn __OUTPUT_FORMAT__,win32
+\$\@feat.00 equ 1
+section .text   code align=64
+%else
+section .text   code
+%endif
+___
+        push(@out,$tmp);
+    }
+}
+
+sub ::function_begin_B
+{ my $func=shift;
+  my $global=($func !~ /^_/);
+  my $begin="${::lbdecor}_${func}_begin";
+
+    $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);
+    push(@out,"${drdecor}align  16\n");
+    push(@out,"$func:\n");
+    push(@out,"$begin:\n")                      if ($global);
+    $::stack=4;
+}
+
+sub ::function_end_B
+{   $::stack=0;
+    &::wipe_labels();
+}
+
+sub ::file_end
+{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
+    {   my $comm=<<___;
+${drdecor}segment       .bss
+${drdecor}common        ${nmdecor}OPENSSL_ia32cap_P 4
+___
+        # comment out OPENSSL_ia32cap_P declarations
+        grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
+        push (@out,$comm)
+    }
+    push (@out,$initseg) if ($initseg);         
+}
+
+sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
+
+sub ::external_label
+{   foreach(@_)
+    {   push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n");   }
+}
+
+sub ::public_label
+{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
+
+sub ::data_byte
+{   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
+
+sub ::data_word
+{   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
+
+sub ::align
+{   push(@out,"${drdecor}align\t$_[0]\n");      }
+
+sub ::picmeup
+{ my($dst,$sym)=@_;
+    &::lea($dst,&::DWP($sym));
+}
+
+sub ::initseg
+{ my $f=$nmdecor.shift;
+    if ($::win32)
+    {   $initseg=<<___;
+segment .CRT\$XCU data align=4
+extern  $f
+dd      $f
+___
+    }
+}
+
+sub ::dataseg
+{   if ($mwerks)        { push(@out,".section\t.data,4\n");   }
+    else                { push(@out,"section\t.data align=4\n"); }
+}
+
+1;