summaryrefslogtreecommitdiff
path: root/src/lib/libcrypto/perlasm/x86_64-xlate.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rwxr-xr-xsrc/lib/libcrypto/perlasm/x86_64-xlate.pl221
1 files changed, 192 insertions, 29 deletions
diff --git a/src/lib/libcrypto/perlasm/x86_64-xlate.pl b/src/lib/libcrypto/perlasm/x86_64-xlate.pl
index e47116b74b..56d9b64b6f 100755
--- a/src/lib/libcrypto/perlasm/x86_64-xlate.pl
+++ b/src/lib/libcrypto/perlasm/x86_64-xlate.pl
@@ -62,12 +62,8 @@ my $flavour = shift;
62my $output = shift; 62my $output = shift;
63if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } 63if ($flavour =~ /\./) { $output = $flavour; undef $flavour; }
64 64
65{ my ($stddev,$stdino,@junk)=stat(STDOUT); 65open STDOUT,">$output" || die "can't open $output: $!"
66 my ($outdev,$outino,@junk)=stat($output); 66 if (defined($output));
67
68 open STDOUT,">$output" || die "can't open $output: $!"
69 if ($stddev!=$outdev || $stdino!=$outino);
70}
71 67
72my $gas=1; $gas=0 if ($output =~ /\.asm$/); 68my $gas=1; $gas=0 if ($output =~ /\.asm$/);
73my $elf=1; $elf=0 if (!$gas); 69my $elf=1; $elf=0 if (!$gas);
@@ -116,12 +112,16 @@ my %globals;
116 $line = substr($line,@+[0]); $line =~ s/^\s+//; 112 $line = substr($line,@+[0]); $line =~ s/^\s+//;
117 113
118 undef $self->{sz}; 114 undef $self->{sz};
119 if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... 115 if ($self->{op} =~ /^(movz)x?([bw]).*/) { # movz is pain...
120 $self->{op} = $1; 116 $self->{op} = $1;
121 $self->{sz} = "b"; 117 $self->{sz} = $2;
122 } elsif ($self->{op} =~ /call|jmp/) { 118 } elsif ($self->{op} =~ /call|jmp/) {
123 $self->{sz} = ""; 119 $self->{sz} = "";
124 } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op)/) { # SSEn 120 } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn
121 $self->{sz} = "";
122 } elsif ($self->{op} =~ /^v/) { # VEX
123 $self->{sz} = "";
124 } elsif ($self->{op} =~ /movq/ && $line =~ /%xmm/) {
125 $self->{sz} = ""; 125 $self->{sz} = "";
126 } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { 126 } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) {
127 $self->{op} = $1; 127 $self->{op} = $1;
@@ -246,35 +246,39 @@ my %globals;
246 $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; 246 $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
247 $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; 247 $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
248 248
249 # Solaris /usr/ccs/bin/as can't handle multiplications
250 # in $self->{label}, new gas requires sign extension...
251 use integer;
252 $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
253 $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg;
254 $self->{label} =~ s/([0-9]+)/$1<<32>>32/eg;
255
249 if ($gas) { 256 if ($gas) {
250 # Solaris /usr/ccs/bin/as can't handle multiplications
251 # in $self->{label}, new gas requires sign extension...
252 use integer;
253 $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
254 $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg;
255 $self->{label} =~ s/([0-9]+)/$1<<32>>32/eg;
256 $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64"); 257 $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64");
257 258
258 if (defined($self->{index})) { 259 if (defined($self->{index})) {
259 sprintf "%s%s(%%%s,%%%s,%d)",$self->{asterisk}, 260 sprintf "%s%s(%s,%%%s,%d)",$self->{asterisk},
260 $self->{label},$self->{base}, 261 $self->{label},
262 $self->{base}?"%$self->{base}":"",
261 $self->{index},$self->{scale}; 263 $self->{index},$self->{scale};
262 } else { 264 } else {
263 sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base}; 265 sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base};
264 } 266 }
265 } else { 267 } else {
266 %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", q=>"QWORD$PTR" ); 268 %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR",
269 q=>"QWORD$PTR",o=>"OWORD$PTR",x=>"XMMWORD$PTR" );
267 270
268 $self->{label} =~ s/\./\$/g; 271 $self->{label} =~ s/\./\$/g;
269 $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig; 272 $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig;
270 $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); 273 $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/);
271 $sz="q" if ($self->{asterisk}); 274 $sz="q" if ($self->{asterisk} || opcode->mnemonic() eq "movq");
275 $sz="l" if (opcode->mnemonic() eq "movd");
272 276
273 if (defined($self->{index})) { 277 if (defined($self->{index})) {
274 sprintf "%s[%s%s*%d+%s]",$szmap{$sz}, 278 sprintf "%s[%s%s*%d%s]",$szmap{$sz},
275 $self->{label}?"$self->{label}+":"", 279 $self->{label}?"$self->{label}+":"",
276 $self->{index},$self->{scale}, 280 $self->{index},$self->{scale},
277 $self->{base}; 281 $self->{base}?"+$self->{base}":"";
278 } elsif ($self->{base} eq "rip") { 282 } elsif ($self->{base} eq "rip") {
279 sprintf "%s[%s]",$szmap{$sz},$self->{label}; 283 sprintf "%s[%s]",$szmap{$sz},$self->{label};
280 } else { 284 } else {
@@ -506,6 +510,12 @@ my %globals;
506 } 510 }
507 } elsif ($dir =~ /\.(text|data)/) { 511 } elsif ($dir =~ /\.(text|data)/) {
508 $current_segment=".$1"; 512 $current_segment=".$1";
513 } elsif ($dir =~ /\.hidden/) {
514 if ($flavour eq "macosx") { $self->{value} = ".private_extern\t$prefix$line"; }
515 elsif ($flavour eq "mingw64") { $self->{value} = ""; }
516 } elsif ($dir =~ /\.comm/) {
517 $self->{value} = "$dir\t$prefix$line";
518 $self->{value} =~ s|,([0-9]+),([0-9]+)$|",$1,".log($2)/log(2)|e if ($flavour eq "macosx");
509 } 519 }
510 $line = ""; 520 $line = "";
511 return $self; 521 return $self;
@@ -555,7 +565,8 @@ my %globals;
555 $v.=" READONLY"; 565 $v.=" READONLY";
556 $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); 566 $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref);
557 } elsif ($line=~/\.CRT\$/i) { 567 } elsif ($line=~/\.CRT\$/i) {
558 $v.=" READONLY DWORD"; 568 $v.=" READONLY ";
569 $v.=$masm>=$masmref ? "ALIGN(8)" : "DWORD";
559 } 570 }
560 } 571 }
561 $current_segment = $line; 572 $current_segment = $line;
@@ -577,7 +588,7 @@ my %globals;
577 $self->{value}="${decor}SEH_end_$current_function->{name}:"; 588 $self->{value}="${decor}SEH_end_$current_function->{name}:";
578 $self->{value}.=":\n" if($masm); 589 $self->{value}.=":\n" if($masm);
579 } 590 }
580 $self->{value}.="$current_function->{name}\tENDP" if($masm); 591 $self->{value}.="$current_function->{name}\tENDP" if($masm && $current_function->{name});
581 undef $current_function; 592 undef $current_function;
582 } 593 }
583 last; 594 last;
@@ -613,6 +624,19 @@ my %globals;
613 .join(",",@str) if (@str); 624 .join(",",@str) if (@str);
614 last; 625 last;
615 }; 626 };
627 /\.comm/ && do { my @str=split(/,\s*/,$line);
628 my $v=undef;
629 if ($nasm) {
630 $v.="common $prefix@str[0] @str[1]";
631 } else {
632 $v="$current_segment\tENDS\n" if ($current_segment);
633 $current_segment = "_DATA";
634 $v.="$current_segment\tSEGMENT\n";
635 $v.="COMM @str[0]:DWORD:".@str[1]/4;
636 }
637 $self->{value} = $v;
638 last;
639 };
616 } 640 }
617 $line = ""; 641 $line = "";
618 } 642 }
@@ -625,9 +649,133 @@ my %globals;
625 } 649 }
626} 650}
627 651
652sub rex {
653 local *opcode=shift;
654 my ($dst,$src,$rex)=@_;
655
656 $rex|=0x04 if($dst>=8);
657 $rex|=0x01 if($src>=8);
658 push @opcode,($rex|0x40) if ($rex);
659}
660
661# older gas and ml64 don't handle SSE>2 instructions
662my %regrm = ( "%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3,
663 "%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7 );
664
665my $movq = sub { # elderly gas can't handle inter-register movq
666 my $arg = shift;
667 my @opcode=(0x66);
668 if ($arg =~ /%xmm([0-9]+),\s*%r(\w+)/) {
669 my ($src,$dst)=($1,$2);
670 if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
671 rex(\@opcode,$src,$dst,0x8);
672 push @opcode,0x0f,0x7e;
673 push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
674 @opcode;
675 } elsif ($arg =~ /%r(\w+),\s*%xmm([0-9]+)/) {
676 my ($src,$dst)=($2,$1);
677 if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
678 rex(\@opcode,$src,$dst,0x8);
679 push @opcode,0x0f,0x6e;
680 push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
681 @opcode;
682 } else {
683 ();
684 }
685};
686
687my $pextrd = sub {
688 if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*(%\w+)/) {
689 my @opcode=(0x66);
690 $imm=$1;
691 $src=$2;
692 $dst=$3;
693 if ($dst =~ /%r([0-9]+)d/) { $dst = $1; }
694 elsif ($dst =~ /%e/) { $dst = $regrm{$dst}; }
695 rex(\@opcode,$src,$dst);
696 push @opcode,0x0f,0x3a,0x16;
697 push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
698 push @opcode,$imm;
699 @opcode;
700 } else {
701 ();
702 }
703};
704
705my $pinsrd = sub {
706 if (shift =~ /\$([0-9]+),\s*(%\w+),\s*%xmm([0-9]+)/) {
707 my @opcode=(0x66);
708 $imm=$1;
709 $src=$2;
710 $dst=$3;
711 if ($src =~ /%r([0-9]+)/) { $src = $1; }
712 elsif ($src =~ /%e/) { $src = $regrm{$src}; }
713 rex(\@opcode,$dst,$src);
714 push @opcode,0x0f,0x3a,0x22;
715 push @opcode,0xc0|(($dst&7)<<3)|($src&7); # ModR/M
716 push @opcode,$imm;
717 @opcode;
718 } else {
719 ();
720 }
721};
722
723my $pshufb = sub {
724 if (shift =~ /%xmm([0-9]+),\s*%xmm([0-9]+)/) {
725 my @opcode=(0x66);
726 rex(\@opcode,$2,$1);
727 push @opcode,0x0f,0x38,0x00;
728 push @opcode,0xc0|($1&7)|(($2&7)<<3); # ModR/M
729 @opcode;
730 } else {
731 ();
732 }
733};
734
735my $palignr = sub {
736 if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
737 my @opcode=(0x66);
738 rex(\@opcode,$3,$2);
739 push @opcode,0x0f,0x3a,0x0f;
740 push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
741 push @opcode,$1;
742 @opcode;
743 } else {
744 ();
745 }
746};
747
748my $pclmulqdq = sub {
749 if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
750 my @opcode=(0x66);
751 rex(\@opcode,$3,$2);
752 push @opcode,0x0f,0x3a,0x44;
753 push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
754 my $c=$1;
755 push @opcode,$c=~/^0/?oct($c):$c;
756 @opcode;
757 } else {
758 ();
759 }
760};
761
762my $rdrand = sub {
763 if (shift =~ /%[er](\w+)/) {
764 my @opcode=();
765 my $dst=$1;
766 if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
767 rex(\@opcode,0,$1,8);
768 push @opcode,0x0f,0xc7,0xf0|($dst&7);
769 @opcode;
770 } else {
771 ();
772 }
773};
774
628if ($nasm) { 775if ($nasm) {
629 print <<___; 776 print <<___;
630default rel 777default rel
778%define XMMWORD
631___ 779___
632} elsif ($masm) { 780} elsif ($masm) {
633 print <<___; 781 print <<___;
@@ -644,14 +792,22 @@ while($line=<>) {
644 792
645 undef $label; 793 undef $label;
646 undef $opcode; 794 undef $opcode;
647 undef $sz;
648 undef @args; 795 undef @args;
649 796
650 if ($label=label->re(\$line)) { print $label->out(); } 797 if ($label=label->re(\$line)) { print $label->out(); }
651 798
652 if (directive->re(\$line)) { 799 if (directive->re(\$line)) {
653 printf "%s",directive->out(); 800 printf "%s",directive->out();
654 } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: while (1) { 801 } elsif ($opcode=opcode->re(\$line)) {
802 my $asm = eval("\$".$opcode->mnemonic());
803 undef @bytes;
804
805 if ((ref($asm) eq 'CODE') && scalar(@bytes=&$asm($line))) {
806 print $gas?".byte\t":"DB\t",join(',',@bytes),"\n";
807 next;
808 }
809
810 ARGUMENT: while (1) {
655 my $arg; 811 my $arg;
656 812
657 if ($arg=register->re(\$line)) { opcode->size($arg->size()); } 813 if ($arg=register->re(\$line)) { opcode->size($arg->size()); }
@@ -667,19 +823,26 @@ while($line=<>) {
667 $line =~ s/^,\s*//; 823 $line =~ s/^,\s*//;
668 } # ARGUMENT: 824 } # ARGUMENT:
669 825
670 $sz=opcode->size();
671
672 if ($#args>=0) { 826 if ($#args>=0) {
673 my $insn; 827 my $insn;
828 my $sz=opcode->size();
829
674 if ($gas) { 830 if ($gas) {
675 $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz); 831 $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz);
832 @args = map($_->out($sz),@args);
833 printf "\t%s\t%s",$insn,join(",",@args);
676 } else { 834 } else {
677 $insn = $opcode->out(); 835 $insn = $opcode->out();
678 $insn .= $sz if (map($_->out() =~ /x?mm/,@args)); 836 foreach (@args) {
837 my $arg = $_->out();
838 # $insn.=$sz compensates for movq, pinsrw, ...
839 if ($arg =~ /^xmm[0-9]+$/) { $insn.=$sz; $sz="x" if(!$sz); last; }
840 if ($arg =~ /^mm[0-9]+$/) { $insn.=$sz; $sz="q" if(!$sz); last; }
841 }
679 @args = reverse(@args); 842 @args = reverse(@args);
680 undef $sz if ($nasm && $opcode->mnemonic() eq "lea"); 843 undef $sz if ($nasm && $opcode->mnemonic() eq "lea");
844 printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
681 } 845 }
682 printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
683 } else { 846 } else {
684 printf "\t%s",$opcode->out(); 847 printf "\t%s",$opcode->out();
685 } 848 }