x86[_64] perlasm: pull-in from HEAD.

diff --git a/crypto/perlasm/x86_64-xlate.pl b/crypto/perlasm/x86_64-xlate.pl
index e47116b74b7ee1c21d0189b09bf1bfe09e1948a3..dd600be7b8ccf5646e411d4d41df160b8270e9f8 100755 (executable)
--- a/crypto/perlasm/x86_64-xlate.pl
+++ b/crypto/perlasm/x86_64-xlate.pl
@@ -121,7 +121,11 @@ my %globals;
                $self->{sz} = "b";
            } elsif ($self->{op} =~ /call|jmp/) {
                $self->{sz} = "";
-           } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op)/) { # SSEn
+           } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn
+               $self->{sz} = "";
+           } elsif ($self->{op} =~ /^v/) { # VEX
+               $self->{sz} = "";
+           } elsif ($self->{op} =~ /movq/ && $line =~ /%xmm/) {
                $self->{sz} = "";
            } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) {
                $self->{op} = $1;
@@ -256,14 +260,16 @@ my %globals;
            $self->{label} =~ s/^___imp_/__imp__/   if ($flavour eq "mingw64");
 
            if (defined($self->{index})) {
-               sprintf "%s%s(%%%s,%%%s,%d)",$self->{asterisk},
-                                       $self->{label},$self->{base},
+               sprintf "%s%s(%s,%%%s,%d)",$self->{asterisk},
+                                       $self->{label},
+                                       $self->{base}?"%$self->{base}":"",
                                        $self->{index},$self->{scale};
            } else {
                sprintf "%s%s(%%%s)",   $self->{asterisk},$self->{label},$self->{base};
            }
        } else {
-           %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", q=>"QWORD$PTR" );
+           %szmap = (  b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR",
+                       q=>"QWORD$PTR",o=>"OWORD$PTR",x=>"XMMWORD$PTR" );
 
            $self->{label} =~ s/\./\$/g;
            $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig;
@@ -271,10 +277,10 @@ my %globals;
            $sz="q" if ($self->{asterisk});
 
            if (defined($self->{index})) {
-               sprintf "%s[%s%s*%d+%s]",$szmap{$sz},
+               sprintf "%s[%s%s*%d%s]",$szmap{$sz},
                                        $self->{label}?"$self->{label}+":"",
                                        $self->{index},$self->{scale},
-                                       $self->{base};
+                                       $self->{base}?"+$self->{base}":"";
            } elsif ($self->{base} eq "rip") {
                sprintf "%s[%s]",$szmap{$sz},$self->{label};
            } else {
@@ -506,6 +512,11 @@ my %globals;
                    }
                } elsif ($dir =~ /\.(text|data)/) {
                    $current_segment=".$1";
+               } elsif ($dir =~ /\.hidden/) {
+                   if    ($flavour eq "macosx")  { $self->{value} = ".private_extern\t$prefix$line"; }
+                   elsif ($flavour eq "mingw64") { $self->{value} = ""; }
+               } elsif ($dir =~ /\.comm/) {
+                   $self->{value} = "$dir\t$prefix$line";
                }
                $line = "";
                return $self;
@@ -613,6 +624,19 @@ my %globals;
                                                .join(",",@str) if (@str);
                                    last;
                                  };
+               /\.comm/    && do { my @str=split(/,\s*/,$line);
+                                   my $v=undef;
+                                   if ($nasm) {
+                                       $v.="common     $prefix@str[0] @str[1]";
+                                   } else {
+                                       $v="$current_segment\tENDS\n" if ($current_segment);
+                                       $current_segment = ".data";
+                                       $v.="$current_segment\tSEGMENT\n";
+                                       $v.="COMM       @str[0]:DWORD:".@str[1]/4;
+                                   }
+                                   $self->{value} = $v;
+                                   last;
+                                 };
            }
            $line = "";
        }
@@ -625,9 +649,133 @@ my %globals;
     }
 }
 
+sub rex {
+ local *opcode=shift;
+ my ($dst,$src,$rex)=@_;
+
+   $rex|=0x04 if($dst>=8);
+   $rex|=0x01 if($src>=8);
+   push @opcode,($rex|0x40) if ($rex);
+}
+
+# older gas and ml64 don't handle SSE>2 instructions
+my %regrm = (  "%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3,
+               "%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7      );
+
+my $movq = sub {       # elderly gas can't handle inter-register movq
+  my $arg = shift;
+  my @opcode=(0x66);
+    if ($arg =~ /%xmm([0-9]+),%r(\w+)/) {
+       my ($src,$dst)=($1,$2);
+       if ($dst !~ /[0-9]+/)   { $dst = $regrm{"%e$dst"}; }
+       rex(\@opcode,$src,$dst,0x8);
+       push @opcode,0x0f,0x7e;
+       push @opcode,0xc0|(($src&7)<<3)|($dst&7);       # ModR/M
+       @opcode;
+    } elsif ($arg =~ /%r(\w+),%xmm([0-9]+)/) {
+       my ($src,$dst)=($2,$1);
+       if ($dst !~ /[0-9]+/)   { $dst = $regrm{"%e$dst"}; }
+       rex(\@opcode,$src,$dst,0x8);
+       push @opcode,0x0f,0x6e;
+       push @opcode,0xc0|(($src&7)<<3)|($dst&7);       # ModR/M
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $pextrd = sub {
+    if (shift =~ /\$([0-9]+),%xmm([0-9]+),(%\w+)/) {
+      my @opcode=(0x66);
+       $imm=$1;
+       $src=$2;
+       $dst=$3;
+       if ($dst =~ /%r([0-9]+)d/)      { $dst = $1; }
+       elsif ($dst =~ /%e/)            { $dst = $regrm{$dst}; }
+       rex(\@opcode,$src,$dst);
+       push @opcode,0x0f,0x3a,0x16;
+       push @opcode,0xc0|(($src&7)<<3)|($dst&7);       # ModR/M
+       push @opcode,$imm;
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $pinsrd = sub {
+    if (shift =~ /\$([0-9]+),(%\w+),%xmm([0-9]+)/) {
+      my @opcode=(0x66);
+       $imm=$1;
+       $src=$2;
+       $dst=$3;
+       if ($src =~ /%r([0-9]+)/)       { $src = $1; }
+       elsif ($src =~ /%e/)            { $src = $regrm{$src}; }
+       rex(\@opcode,$dst,$src);
+       push @opcode,0x0f,0x3a,0x22;
+       push @opcode,0xc0|(($dst&7)<<3)|($src&7);       # ModR/M
+       push @opcode,$imm;
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $pshufb = sub {
+    if (shift =~ /%xmm([0-9]+),%xmm([0-9]+)/) {
+      my @opcode=(0x66);
+       rex(\@opcode,$2,$1);
+       push @opcode,0x0f,0x38,0x00;
+       push @opcode,0xc0|($1&7)|(($2&7)<<3);           # ModR/M
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $palignr = sub {
+    if (shift =~ /\$([0-9]+),%xmm([0-9]+),%xmm([0-9]+)/) {
+      my @opcode=(0x66);
+       rex(\@opcode,$3,$2);
+       push @opcode,0x0f,0x3a,0x0f;
+       push @opcode,0xc0|($2&7)|(($3&7)<<3);           # ModR/M
+       push @opcode,$1;
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $pclmulqdq = sub {
+    if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
+      my @opcode=(0x66);
+       rex(\@opcode,$3,$2);
+       push @opcode,0x0f,0x3a,0x44;
+       push @opcode,0xc0|($2&7)|(($3&7)<<3);           # ModR/M
+       my $c=$1;
+       push @opcode,$c=~/^0/?oct($c):$c;
+       @opcode;
+    } else {
+       ();
+    }
+};
+
+my $rdrand = sub {
+    if (shift =~ /%[er](\w+)/) {
+      my @opcode=();
+      my $dst=$1;
+       if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
+       rex(\@opcode,0,$1,8);
+       push @opcode,0x0f,0xc7,0xf0|($dst&7);
+       @opcode;
+    } else {
+       ();
+    }
+};
+
 if ($nasm) {
     print <<___;
 default        rel
+%define XMMWORD
 ___
 } elsif ($masm) {
     print <<___;
@@ -644,14 +792,22 @@ while($line=<>) {
 
     undef $label;
     undef $opcode;
-    undef $sz;
     undef @args;
 
     if ($label=label->re(\$line))      { print $label->out(); }
 
     if (directive->re(\$line)) {
        printf "%s",directive->out();
-    } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: while (1) {
+    } elsif ($opcode=opcode->re(\$line)) {
+       my $asm = eval("\$".$opcode->mnemonic());
+       undef @bytes;
+       
+       if ((ref($asm) eq 'CODE') && scalar(@bytes=&$asm($line))) {
+           print $gas?".byte\t":"DB\t",join(',',@bytes),"\n";
+           next;
+       }
+
+       ARGUMENT: while (1) {
        my $arg;
 
        if ($arg=register->re(\$line))  { opcode->size($arg->size()); }
@@ -667,19 +823,26 @@ while($line=<>) {
        $line =~ s/^,\s*//;
        } # ARGUMENT:
 
-       $sz=opcode->size();
-
        if ($#args>=0) {
            my $insn;
+           my $sz=opcode->size();
+
            if ($gas) {
                $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz);
+               @args = map($_->out($sz),@args);
+               printf "\t%s\t%s",$insn,join(",",@args);
            } else {
                $insn = $opcode->out();
-               $insn .= $sz if (map($_->out() =~ /x?mm/,@args));
+               foreach (@args) {
+                   my $arg = $_->out();
+                   # $insn.=$sz compensates for movq, pinsrw, ...
+                   if ($arg =~ /^xmm[0-9]+$/) { $insn.=$sz; $sz="x" if(!$sz); last; }
+                   if ($arg =~ /^mm[0-9]+$/)  { $insn.=$sz; $sz="q" if(!$sz); last; }
+               }
                @args = reverse(@args);
                undef $sz if ($nasm && $opcode->mnemonic() eq "lea");
+               printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
            }
-           printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
        } else {
            printf "\t%s",$opcode->out();
        }

diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl
index 28080caaa60efbc07741573ca884a394873530f7..b7ddb8137f306011dfe327e3d431c3d213b437f4 100644 (file)
--- a/crypto/perlasm/x86asm.pl
+++ b/crypto/perlasm/x86asm.pl
@@ -80,6 +80,57 @@ sub ::movq
     {  &::generic("movq",@_);                  }
 }
 
+# SSE>2 instructions
+my %regrm = (  "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3,
+               "esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7  );
+sub ::pextrd
+{ my($dst,$src,$imm)=@_;
+    if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/)
+    {  &::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm); }
+    else
+    {  &::generic("pextrd",@_);                }
+}
+
+sub ::pinsrd
+{ my($dst,$src,$imm)=@_;
+    if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/)
+    {  &::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm); }
+    else
+    {  &::generic("pinsrd",@_);                }
+}
+
+sub ::pshufb
+{ my($dst,$src)=@_;
+    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
+    {  &data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2);        }
+    else
+    {  &::generic("pshufb",@_);                }
+}
+
+sub ::palignr
+{ my($dst,$src,$imm)=@_;
+    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
+    {  &::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm); }
+    else
+    {  &::generic("palignr",@_);               }
+}
+
+sub ::pclmulqdq
+{ my($dst,$src,$imm)=@_;
+    if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/)
+    {  &::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm); }
+    else
+    {  &::generic("pclmulqdq",@_);             }
+}
+
+sub ::rdrand
+{ my ($dst)=@_;
+    if ($dst =~ /(e[a-dsd][ixp])/)
+    {  &::data_byte(0x0f,0xc7,0xf0|$regrm{$dst});      }
+    else
+    {  &::generic("rdrand",@_);        }
+}
+
 # label management
 $lbdecor="L";          # local label decoration, set by package
 $label="000";

diff --git a/crypto/perlasm/x86gas.pl b/crypto/perlasm/x86gas.pl
index b47050773042b45f49b7820b075a1a5706d074d1..3a791062983558935d6239d1858b2666acab2ac7 100644 (file)
--- a/crypto/perlasm/x86gas.pl
+++ b/crypto/perlasm/x86gas.pl
@@ -47,6 +47,7 @@ sub ::generic
     if ($#_==0)                                { &::emit($opcode);             }
     elsif ($opcode =~ m/^j/o && $#_==1)        { &::emit($opcode,@arg);        }
     elsif ($opcode eq "call" && $#_==1)        { &::emit($opcode,@arg);        }
+    elsif ($opcode eq "clflush" && $#_==1){ &::emit($opcode,@arg);     }
     elsif ($opcode =~ m/^set/&& $#_==1)        { &::emit($opcode,@arg);        }
     else                               { &::emit($opcode.$suffix,@arg);}
 
@@ -91,6 +92,7 @@ sub ::DWP
 }
 sub ::QWP      { &::DWP(@_);   }
 sub ::BP       { &::DWP(@_);   }
+sub ::WP       { &::DWP(@_);   }
 sub ::BC       { @_;           }
 sub ::DWC      { @_;           }
 
@@ -149,22 +151,23 @@ sub ::public_label
 {   push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
 
 sub ::file_end
-{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) {
-       my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,8";
-       if ($::elf)     { push (@out,"$tmp,4\n"); }
-       else            { push (@out,"$tmp\n"); }
-    }
-    if ($::macosx)
+{   if ($::macosx)
     {  if (%non_lazy_ptr)
        {   push(@out,".section __IMPORT,__pointers,non_lazy_symbol_pointers\n");
            foreach $i (keys %non_lazy_ptr)
            {   push(@out,"$non_lazy_ptr{$i}:\n.indirect_symbol\t$i\n.long\t0\n");   }
        }
     }
+    if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) {
+       my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,8";
+       if ($::elf)     { push (@out,"$tmp,4\n"); }
+       else            { push (@out,"$tmp\n"); }
+    }
     push(@out,$initseg) if ($initseg);
 }
 
 sub ::data_byte        {   push(@out,".byte\t".join(',',@_)."\n");   }
+sub ::data_short{   push(@out,".value\t".join(',',@_)."\n");  }
 sub ::data_word {   push(@out,".long\t".join(',',@_)."\n");   }
 
 sub ::align

diff --git a/crypto/perlasm/x86masm.pl b/crypto/perlasm/x86masm.pl
index 03e7ba66ae31d2fac84c7941dd5216980569d683..279ab29b8c352277372d0e2850c0f534a20a47e2 100644 (file)
--- a/crypto/perlasm/x86masm.pl
+++ b/crypto/perlasm/x86masm.pl
@@ -14,7 +14,7 @@ sub ::generic
 { my ($opcode,@arg)=@_;
 
     # fix hexadecimal constants
-    for (@arg) { s/0x([0-9a-f]+)/0$1h/oi; }
+    for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; }
 
     if ($opcode !~ /movq/)
     {  # fix xmm references
@@ -65,6 +65,7 @@ sub get_mem
   $ret;
 }
 sub ::BP       { &get_mem("BYTE",@_);  }
+sub ::WP       { &get_mem("WORD",@_);  }
 sub ::DWP      { &get_mem("DWORD",@_); }
 sub ::QWP      { &get_mem("QWORD",@_); }
 sub ::BC       { "@_";  }
@@ -156,6 +157,9 @@ sub ::public_label
 sub ::data_byte
 {   push(@out,("DB\t").join(',',@_)."\n");     }
 
+sub ::data_short
+{   push(@out,("DW\t").join(',',@_)."\n");     }
+
 sub ::data_word
 {   push(@out,("DD\t").join(',',@_)."\n");     }
 

diff --git a/crypto/perlasm/x86nasm.pl b/crypto/perlasm/x86nasm.pl
index 1a384582bf176d7823751facbc48782dbd7781f2..23a84ba56355ce0559f93f288fefabfabe6ca94f 100644 (file)
--- a/crypto/perlasm/x86nasm.pl
+++ b/crypto/perlasm/x86nasm.pl
@@ -19,6 +19,8 @@ sub ::generic
        {   $_[0] = "NEAR $_[0]";       }
        elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
        {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
+       elsif ($opcode eq "clflush" && $#_==0)
+       {   $_[0] =~ s/^[^\[]*\[/\[/o;  }
     }
     &::emit($opcode,@_);
   1;
@@ -67,6 +69,7 @@ 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 ")."@_"; }
@@ -135,7 +138,8 @@ sub ::public_label
 
 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");       }