diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm')
| -rwxr-xr-x | src/lib/libcrypto/perlasm/x86_64-xlate.pl | 224 | ||||
| -rw-r--r-- | src/lib/libcrypto/perlasm/x86asm.pl | 69 | ||||
| -rw-r--r-- | src/lib/libcrypto/perlasm/x86gas.pl | 46 | ||||
| -rw-r--r-- | src/lib/libcrypto/perlasm/x86masm.pl | 184 | ||||
| -rw-r--r-- | src/lib/libcrypto/perlasm/x86nasm.pl | 166 |
5 files changed, 427 insertions, 262 deletions
diff --git a/src/lib/libcrypto/perlasm/x86_64-xlate.pl b/src/lib/libcrypto/perlasm/x86_64-xlate.pl index 56d9b64b6f..68b4c1ca80 100755 --- a/src/lib/libcrypto/perlasm/x86_64-xlate.pl +++ b/src/lib/libcrypto/perlasm/x86_64-xlate.pl | |||
| @@ -62,8 +62,12 @@ my $flavour = shift; | |||
| 62 | my $output = shift; | 62 | my $output = shift; |
| 63 | if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } | 63 | if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } |
| 64 | 64 | ||
| 65 | open STDOUT,">$output" || die "can't open $output: $!" | 65 | { my ($stddev,$stdino,@junk)=stat(STDOUT); |
| 66 | if (defined($output)); | 66 | my ($outdev,$outino,@junk)=stat($output); |
| 67 | |||
| 68 | open STDOUT,">$output" || die "can't open $output: $!" | ||
| 69 | if (1 || $stddev!=$outdev || $stdino!=$outino); | ||
| 70 | } | ||
| 67 | 71 | ||
| 68 | my $gas=1; $gas=0 if ($output =~ /\.asm$/); | 72 | my $gas=1; $gas=0 if ($output =~ /\.asm$/); |
| 69 | my $elf=1; $elf=0 if (!$gas); | 73 | my $elf=1; $elf=0 if (!$gas); |
| @@ -112,16 +116,12 @@ my %globals; | |||
| 112 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 116 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
| 113 | 117 | ||
| 114 | undef $self->{sz}; | 118 | undef $self->{sz}; |
| 115 | if ($self->{op} =~ /^(movz)x?([bw]).*/) { # movz is pain... | 119 | if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... |
| 116 | $self->{op} = $1; | 120 | $self->{op} = $1; |
| 117 | $self->{sz} = $2; | 121 | $self->{sz} = "b"; |
| 118 | } elsif ($self->{op} =~ /call|jmp/) { | 122 | } elsif ($self->{op} =~ /call|jmp/) { |
| 119 | $self->{sz} = ""; | 123 | $self->{sz} = ""; |
| 120 | } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn | 124 | } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op)/) { # 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; |
| @@ -215,7 +215,8 @@ my %globals; | |||
| 215 | undef $ret; | 215 | undef $ret; |
| 216 | 216 | ||
| 217 | # optional * ---vvv--- appears in indirect jmp/call | 217 | # optional * ---vvv--- appears in indirect jmp/call |
| 218 | if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) { | 218 | if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/ && |
| 219 | !($line =~ /^PIC_(GOT|PLT)/)) { | ||
| 219 | $self->{asterisk} = $1; | 220 | $self->{asterisk} = $1; |
| 220 | $self->{label} = $2; | 221 | $self->{label} = $2; |
| 221 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$3); | 222 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$3); |
| @@ -246,39 +247,35 @@ my %globals; | |||
| 246 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 247 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
| 247 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 248 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
| 248 | 249 | ||
| 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 | |||
| 256 | if ($gas) { | 250 | if ($gas) { |
| 251 | # Solaris /usr/ccs/bin/as can't handle multiplications | ||
| 252 | # in $self->{label}, new gas requires sign extension... | ||
| 253 | use integer; | ||
| 254 | $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi; | ||
| 255 | $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; | ||
| 256 | $self->{label} =~ s/([0-9]+)/$1<<32>>32/eg; | ||
| 257 | $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64"); | 257 | $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64"); |
| 258 | 258 | ||
| 259 | if (defined($self->{index})) { | 259 | if (defined($self->{index})) { |
| 260 | sprintf "%s%s(%s,%%%s,%d)",$self->{asterisk}, | 260 | sprintf "%s%s(%%%s,%%%s,%d)",$self->{asterisk}, |
| 261 | $self->{label}, | 261 | $self->{label},$self->{base}, |
| 262 | $self->{base}?"%$self->{base}":"", | ||
| 263 | $self->{index},$self->{scale}; | 262 | $self->{index},$self->{scale}; |
| 264 | } else { | 263 | } else { |
| 265 | sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base}; | 264 | sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base}; |
| 266 | } | 265 | } |
| 267 | } else { | 266 | } else { |
| 268 | %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", | 267 | %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", q=>"QWORD$PTR" ); |
| 269 | q=>"QWORD$PTR",o=>"OWORD$PTR",x=>"XMMWORD$PTR" ); | ||
| 270 | 268 | ||
| 271 | $self->{label} =~ s/\./\$/g; | 269 | $self->{label} =~ s/\./\$/g; |
| 272 | $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig; | 270 | $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig; |
| 273 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); | 271 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); |
| 274 | $sz="q" if ($self->{asterisk} || opcode->mnemonic() eq "movq"); | 272 | $sz="q" if ($self->{asterisk}); |
| 275 | $sz="l" if (opcode->mnemonic() eq "movd"); | ||
| 276 | 273 | ||
| 277 | if (defined($self->{index})) { | 274 | if (defined($self->{index})) { |
| 278 | sprintf "%s[%s%s*%d%s]",$szmap{$sz}, | 275 | sprintf "%s[%s%s*%d+%s]",$szmap{$sz}, |
| 279 | $self->{label}?"$self->{label}+":"", | 276 | $self->{label}?"$self->{label}+":"", |
| 280 | $self->{index},$self->{scale}, | 277 | $self->{index},$self->{scale}, |
| 281 | $self->{base}?"+$self->{base}":""; | 278 | $self->{base}; |
| 282 | } elsif ($self->{base} eq "rip") { | 279 | } elsif ($self->{base} eq "rip") { |
| 283 | sprintf "%s[%s]",$szmap{$sz},$self->{label}; | 280 | sprintf "%s[%s]",$szmap{$sz},$self->{label}; |
| 284 | } else { | 281 | } else { |
| @@ -510,12 +507,6 @@ my %globals; | |||
| 510 | } | 507 | } |
| 511 | } elsif ($dir =~ /\.(text|data)/) { | 508 | } elsif ($dir =~ /\.(text|data)/) { |
| 512 | $current_segment=".$1"; | 509 | $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"); | ||
| 519 | } | 510 | } |
| 520 | $line = ""; | 511 | $line = ""; |
| 521 | return $self; | 512 | return $self; |
| @@ -565,8 +556,7 @@ my %globals; | |||
| 565 | $v.=" READONLY"; | 556 | $v.=" READONLY"; |
| 566 | $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); | 557 | $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); |
| 567 | } elsif ($line=~/\.CRT\$/i) { | 558 | } elsif ($line=~/\.CRT\$/i) { |
| 568 | $v.=" READONLY "; | 559 | $v.=" READONLY DWORD"; |
| 569 | $v.=$masm>=$masmref ? "ALIGN(8)" : "DWORD"; | ||
| 570 | } | 560 | } |
| 571 | } | 561 | } |
| 572 | $current_segment = $line; | 562 | $current_segment = $line; |
| @@ -588,7 +578,7 @@ my %globals; | |||
| 588 | $self->{value}="${decor}SEH_end_$current_function->{name}:"; | 578 | $self->{value}="${decor}SEH_end_$current_function->{name}:"; |
| 589 | $self->{value}.=":\n" if($masm); | 579 | $self->{value}.=":\n" if($masm); |
| 590 | } | 580 | } |
| 591 | $self->{value}.="$current_function->{name}\tENDP" if($masm && $current_function->{name}); | 581 | $self->{value}.="$current_function->{name}\tENDP" if($masm); |
| 592 | undef $current_function; | 582 | undef $current_function; |
| 593 | } | 583 | } |
| 594 | last; | 584 | last; |
| @@ -624,19 +614,6 @@ my %globals; | |||
| 624 | .join(",",@str) if (@str); | 614 | .join(",",@str) if (@str); |
| 625 | last; | 615 | last; |
| 626 | }; | 616 | }; |
| 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 | }; | ||
| 640 | } | 617 | } |
| 641 | $line = ""; | 618 | $line = ""; |
| 642 | } | 619 | } |
| @@ -649,133 +626,11 @@ my %globals; | |||
| 649 | } | 626 | } |
| 650 | } | 627 | } |
| 651 | 628 | ||
| 652 | sub rex { | 629 | print "#include <machine/asm.h>\n"; |
| 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 | ||
| 662 | my %regrm = ( "%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3, | ||
| 663 | "%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7 ); | ||
| 664 | |||
| 665 | my $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 | |||
| 687 | my $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 | |||
| 705 | my $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 | |||
| 723 | my $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 | |||
| 735 | my $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 | |||
| 748 | my $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 | |||
| 762 | my $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 | 630 | ||
| 775 | if ($nasm) { | 631 | if ($nasm) { |
| 776 | print <<___; | 632 | print <<___; |
| 777 | default rel | 633 | default rel |
| 778 | %define XMMWORD | ||
| 779 | ___ | 634 | ___ |
| 780 | } elsif ($masm) { | 635 | } elsif ($masm) { |
| 781 | print <<___; | 636 | print <<___; |
| @@ -792,22 +647,14 @@ while($line=<>) { | |||
| 792 | 647 | ||
| 793 | undef $label; | 648 | undef $label; |
| 794 | undef $opcode; | 649 | undef $opcode; |
| 650 | undef $sz; | ||
| 795 | undef @args; | 651 | undef @args; |
| 796 | 652 | ||
| 797 | if ($label=label->re(\$line)) { print $label->out(); } | 653 | if ($label=label->re(\$line)) { print $label->out(); } |
| 798 | 654 | ||
| 799 | if (directive->re(\$line)) { | 655 | if (directive->re(\$line)) { |
| 800 | printf "%s",directive->out(); | 656 | printf "%s",directive->out(); |
| 801 | } elsif ($opcode=opcode->re(\$line)) { | 657 | } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: while (1) { |
| 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) { | ||
| 811 | my $arg; | 658 | my $arg; |
| 812 | 659 | ||
| 813 | if ($arg=register->re(\$line)) { opcode->size($arg->size()); } | 660 | if ($arg=register->re(\$line)) { opcode->size($arg->size()); } |
| @@ -823,26 +670,19 @@ while($line=<>) { | |||
| 823 | $line =~ s/^,\s*//; | 670 | $line =~ s/^,\s*//; |
| 824 | } # ARGUMENT: | 671 | } # ARGUMENT: |
| 825 | 672 | ||
| 673 | $sz=opcode->size(); | ||
| 674 | |||
| 826 | if ($#args>=0) { | 675 | if ($#args>=0) { |
| 827 | my $insn; | 676 | my $insn; |
| 828 | my $sz=opcode->size(); | ||
| 829 | |||
| 830 | if ($gas) { | 677 | if ($gas) { |
| 831 | $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz); | 678 | $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz); |
| 832 | @args = map($_->out($sz),@args); | ||
| 833 | printf "\t%s\t%s",$insn,join(",",@args); | ||
| 834 | } else { | 679 | } else { |
| 835 | $insn = $opcode->out(); | 680 | $insn = $opcode->out(); |
| 836 | foreach (@args) { | 681 | $insn .= $sz if (map($_->out() =~ /x?mm/,@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 | } | ||
| 842 | @args = reverse(@args); | 682 | @args = reverse(@args); |
| 843 | undef $sz if ($nasm && $opcode->mnemonic() eq "lea"); | 683 | undef $sz if ($nasm && $opcode->mnemonic() eq "lea"); |
| 844 | printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args)); | ||
| 845 | } | 684 | } |
| 685 | printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args)); | ||
| 846 | } else { | 686 | } else { |
| 847 | printf "\t%s",$opcode->out(); | 687 | printf "\t%s",$opcode->out(); |
| 848 | } | 688 | } |
diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl index eb543db2f6..4756a28e59 100644 --- a/src/lib/libcrypto/perlasm/x86asm.pl +++ b/src/lib/libcrypto/perlasm/x86asm.pl | |||
| @@ -33,6 +33,13 @@ sub ::emit | |||
| 33 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } | 33 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } |
| 34 | } | 34 | } |
| 35 | 35 | ||
| 36 | sub ::emitraw | ||
| 37 | { my $opcode=shift; | ||
| 38 | |||
| 39 | if ($#_==-1) { push(@out,"$opcode\n"); } | ||
| 40 | else { push(@out,"$opcode\t".join(',',@_)."\n"); } | ||
| 41 | } | ||
| 42 | |||
| 36 | sub ::LB | 43 | sub ::LB |
| 37 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; | 44 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; |
| 38 | $1."l"; | 45 | $1."l"; |
| @@ -80,57 +87,6 @@ sub ::movq | |||
| 80 | { &::generic("movq",@_); } | 87 | { &::generic("movq",@_); } |
| 81 | } | 88 | } |
| 82 | 89 | ||
| 83 | # SSE>2 instructions | ||
| 84 | my %regrm = ( "eax"=>0, "ecx"=>1, "edx"=>2, "ebx"=>3, | ||
| 85 | "esp"=>4, "ebp"=>5, "esi"=>6, "edi"=>7 ); | ||
| 86 | sub ::pextrd | ||
| 87 | { my($dst,$src,$imm)=@_; | ||
| 88 | if ("$dst:$src" =~ /(e[a-dsd][ixp]):xmm([0-7])/) | ||
| 89 | { &::data_byte(0x66,0x0f,0x3a,0x16,0xc0|($2<<3)|$regrm{$1},$imm); } | ||
| 90 | else | ||
| 91 | { &::generic("pextrd",@_); } | ||
| 92 | } | ||
| 93 | |||
| 94 | sub ::pinsrd | ||
| 95 | { my($dst,$src,$imm)=@_; | ||
| 96 | if ("$dst:$src" =~ /xmm([0-7]):(e[a-dsd][ixp])/) | ||
| 97 | { &::data_byte(0x66,0x0f,0x3a,0x22,0xc0|($1<<3)|$regrm{$2},$imm); } | ||
| 98 | else | ||
| 99 | { &::generic("pinsrd",@_); } | ||
| 100 | } | ||
| 101 | |||
| 102 | sub ::pshufb | ||
| 103 | { my($dst,$src)=@_; | ||
| 104 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) | ||
| 105 | { &data_byte(0x66,0x0f,0x38,0x00,0xc0|($1<<3)|$2); } | ||
| 106 | else | ||
| 107 | { &::generic("pshufb",@_); } | ||
| 108 | } | ||
| 109 | |||
| 110 | sub ::palignr | ||
| 111 | { my($dst,$src,$imm)=@_; | ||
| 112 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) | ||
| 113 | { &::data_byte(0x66,0x0f,0x3a,0x0f,0xc0|($1<<3)|$2,$imm); } | ||
| 114 | else | ||
| 115 | { &::generic("palignr",@_); } | ||
| 116 | } | ||
| 117 | |||
| 118 | sub ::pclmulqdq | ||
| 119 | { my($dst,$src,$imm)=@_; | ||
| 120 | if ("$dst:$src" =~ /xmm([0-7]):xmm([0-7])/) | ||
| 121 | { &::data_byte(0x66,0x0f,0x3a,0x44,0xc0|($1<<3)|$2,$imm); } | ||
| 122 | else | ||
| 123 | { &::generic("pclmulqdq",@_); } | ||
| 124 | } | ||
| 125 | |||
| 126 | sub ::rdrand | ||
| 127 | { my ($dst)=@_; | ||
| 128 | if ($dst =~ /(e[a-dsd][ixp])/) | ||
| 129 | { &::data_byte(0x0f,0xc7,0xf0|$regrm{$dst}); } | ||
| 130 | else | ||
| 131 | { &::generic("rdrand",@_); } | ||
| 132 | } | ||
| 133 | |||
| 134 | # label management | 90 | # label management |
| 135 | $lbdecor="L"; # local label decoration, set by package | 91 | $lbdecor="L"; # local label decoration, set by package |
| 136 | $label="000"; | 92 | $label="000"; |
| @@ -218,7 +174,7 @@ sub ::asm_init | |||
| 218 | $filename=$fn; | 174 | $filename=$fn; |
| 219 | $i386=$cpu; | 175 | $i386=$cpu; |
| 220 | 176 | ||
| 221 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$android=0; | 177 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=0; |
| 222 | if (($type eq "elf")) | 178 | if (($type eq "elf")) |
| 223 | { $elf=1; require "x86gas.pl"; } | 179 | { $elf=1; require "x86gas.pl"; } |
| 224 | elsif (($type eq "a\.out")) | 180 | elsif (($type eq "a\.out")) |
| @@ -235,8 +191,10 @@ sub ::asm_init | |||
| 235 | { $win32=1; require "x86masm.pl"; } | 191 | { $win32=1; require "x86masm.pl"; } |
| 236 | elsif (($type eq "macosx")) | 192 | elsif (($type eq "macosx")) |
| 237 | { $aout=1; $macosx=1; require "x86gas.pl"; } | 193 | { $aout=1; $macosx=1; require "x86gas.pl"; } |
| 238 | elsif (($type eq "android")) | 194 | elsif (($type eq "openbsd-elf")) |
| 239 | { $elf=1; $android=1; require "x86gas.pl"; } | 195 | { $openbsd=$elf=1; require "x86gas.pl"; } |
| 196 | elsif (($type eq "openbsd-a.out")) | ||
| 197 | { $openbsd=1; require "x86gas.pl"; } | ||
| 240 | else | 198 | else |
| 241 | { print STDERR <<"EOF"; | 199 | { print STDERR <<"EOF"; |
| 242 | Pick one target type from | 200 | Pick one target type from |
| @@ -244,6 +202,8 @@ Pick one target type from | |||
| 244 | a.out - DJGPP, elder OpenBSD, etc. | 202 | a.out - DJGPP, elder OpenBSD, etc. |
| 245 | coff - GAS/COFF such as Win32 targets | 203 | coff - GAS/COFF such as Win32 targets |
| 246 | win32n - Windows 95/Windows NT NASM format | 204 | win32n - Windows 95/Windows NT NASM format |
| 205 | openbsd-elf - OpenBSD elf | ||
| 206 | openbsd-a.out - OpenBSD a.out | ||
| 247 | nw-nasm - NetWare NASM format | 207 | nw-nasm - NetWare NASM format |
| 248 | macosx - Mac OS X | 208 | macosx - Mac OS X |
| 249 | EOF | 209 | EOF |
| @@ -253,6 +213,7 @@ EOF | |||
| 253 | $pic=0; | 213 | $pic=0; |
| 254 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } | 214 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } |
| 255 | 215 | ||
| 216 | ::emitraw("#include <machine/asm.h>\n") if $openbsd; | ||
| 256 | $filename =~ s/\.pl$//; | 217 | $filename =~ s/\.pl$//; |
| 257 | &file($filename); | 218 | &file($filename); |
| 258 | } | 219 | } |
diff --git a/src/lib/libcrypto/perlasm/x86gas.pl b/src/lib/libcrypto/perlasm/x86gas.pl index 682a3a3163..9a1cce026e 100644 --- a/src/lib/libcrypto/perlasm/x86gas.pl +++ b/src/lib/libcrypto/perlasm/x86gas.pl | |||
| @@ -45,8 +45,9 @@ sub ::generic | |||
| 45 | undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o); | 45 | undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o); |
| 46 | 46 | ||
| 47 | if ($#_==0) { &::emit($opcode); } | 47 | if ($#_==0) { &::emit($opcode); } |
| 48 | elsif ($#_==1 && $opcode =~ m/^(call|clflush|j|loop|set)/o) | 48 | elsif ($opcode =~ m/^j/o && $#_==1) { &::emit($opcode,@arg); } |
| 49 | { &::emit($opcode,@arg); } | 49 | elsif ($opcode eq "call" && $#_==1) { &::emit($opcode,@arg); } |
| 50 | elsif ($opcode =~ m/^set/&& $#_==1) { &::emit($opcode,@arg); } | ||
| 50 | else { &::emit($opcode.$suffix,@arg);} | 51 | else { &::emit($opcode.$suffix,@arg);} |
| 51 | 52 | ||
| 52 | 1; | 53 | 1; |
| @@ -90,7 +91,6 @@ sub ::DWP | |||
| 90 | } | 91 | } |
| 91 | sub ::QWP { &::DWP(@_); } | 92 | sub ::QWP { &::DWP(@_); } |
| 92 | sub ::BP { &::DWP(@_); } | 93 | sub ::BP { &::DWP(@_); } |
| 93 | sub ::WP { &::DWP(@_); } | ||
| 94 | sub ::BC { @_; } | 94 | sub ::BC { @_; } |
| 95 | sub ::DWC { @_; } | 95 | sub ::DWC { @_; } |
| 96 | 96 | ||
| @@ -149,24 +149,22 @@ sub ::public_label | |||
| 149 | { push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | 149 | { push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } |
| 150 | 150 | ||
| 151 | sub ::file_end | 151 | sub ::file_end |
| 152 | { if ($::macosx) | 152 | { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) { |
| 153 | my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,4"; | ||
| 154 | if ($::elf) { push (@out,"$tmp,4\n"); } | ||
| 155 | else { push (@out,"$tmp\n"); } | ||
| 156 | } | ||
| 157 | if ($::macosx) | ||
| 153 | { if (%non_lazy_ptr) | 158 | { if (%non_lazy_ptr) |
| 154 | { push(@out,".section __IMPORT,__pointers,non_lazy_symbol_pointers\n"); | 159 | { push(@out,".section __IMPORT,__pointers,non_lazy_symbol_pointers\n"); |
| 155 | foreach $i (keys %non_lazy_ptr) | 160 | foreach $i (keys %non_lazy_ptr) |
| 156 | { push(@out,"$non_lazy_ptr{$i}:\n.indirect_symbol\t$i\n.long\t0\n"); } | 161 | { push(@out,"$non_lazy_ptr{$i}:\n.indirect_symbol\t$i\n.long\t0\n"); } |
| 157 | } | 162 | } |
| 158 | } | 163 | } |
| 159 | if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) { | ||
| 160 | my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,8"; | ||
| 161 | if ($::macosx) { push (@out,"$tmp,2\n"); } | ||
| 162 | elsif ($::elf) { push (@out,"$tmp,4\n"); } | ||
| 163 | else { push (@out,"$tmp\n"); } | ||
| 164 | } | ||
| 165 | push(@out,$initseg) if ($initseg); | 164 | push(@out,$initseg) if ($initseg); |
| 166 | } | 165 | } |
| 167 | 166 | ||
| 168 | sub ::data_byte { push(@out,".byte\t".join(',',@_)."\n"); } | 167 | sub ::data_byte { push(@out,".byte\t".join(',',@_)."\n"); } |
| 169 | sub ::data_short{ push(@out,".value\t".join(',',@_)."\n"); } | ||
| 170 | sub ::data_word { push(@out,".long\t".join(',',@_)."\n"); } | 168 | sub ::data_word { push(@out,".long\t".join(',',@_)."\n"); } |
| 171 | 169 | ||
| 172 | sub ::align | 170 | sub ::align |
| @@ -182,7 +180,16 @@ sub ::align | |||
| 182 | sub ::picmeup | 180 | sub ::picmeup |
| 183 | { my($dst,$sym,$base,$reflabel)=@_; | 181 | { my($dst,$sym,$base,$reflabel)=@_; |
| 184 | 182 | ||
| 185 | if (($::pic && ($::elf || $::aout)) || $::macosx) | 183 | if ($::openbsd) |
| 184 | { &::emitraw("#if defined(PIC) || defined(__PIC__)"); | ||
| 185 | &::emitraw("PIC_PROLOGUE"); | ||
| 186 | &::mov($dst, &::DWP("PIC_GOT($sym)")); | ||
| 187 | &::emitraw("PIC_EPILOGUE"); | ||
| 188 | &::emitraw("#else /* PIC */"); | ||
| 189 | &::lea($dst,&::DWP($sym)); | ||
| 190 | &::emitraw("#endif /* PIC */"); | ||
| 191 | } | ||
| 192 | elsif ($::pic && ($::elf || $::aout)) | ||
| 186 | { if (!defined($base)) | 193 | { if (!defined($base)) |
| 187 | { &::call(&::label("PIC_me_up")); | 194 | { &::call(&::label("PIC_me_up")); |
| 188 | &::set_label("PIC_me_up"); | 195 | &::set_label("PIC_me_up"); |
| @@ -208,17 +215,24 @@ sub ::picmeup | |||
| 208 | sub ::initseg | 215 | sub ::initseg |
| 209 | { my $f=$nmdecor.shift; | 216 | { my $f=$nmdecor.shift; |
| 210 | 217 | ||
| 211 | if ($::android) | 218 | if ($::openbsd) |
| 212 | { $initseg.=<<___; | 219 | { $initseg.=<<___; |
| 213 | .section .init_array | 220 | .section .init |
| 214 | .align 4 | 221 | PIC_PROLOGUE |
| 215 | .long $f | 222 | call PIC_PLT($f) |
| 223 | PIC_EPILOGUE | ||
| 224 | jmp .Linitalign | ||
| 225 | .align $align | ||
| 226 | .Linitalign: | ||
| 216 | ___ | 227 | ___ |
| 217 | } | 228 | } |
| 218 | elsif ($::elf) | 229 | elsif ($::elf) |
| 219 | { $initseg.=<<___; | 230 | { $initseg.=<<___; |
| 220 | .section .init | 231 | .section .init |
| 221 | call $f | 232 | call $f |
| 233 | jmp .Linitalign | ||
| 234 | .align $align | ||
| 235 | .Linitalign: | ||
| 222 | ___ | 236 | ___ |
| 223 | } | 237 | } |
| 224 | elsif ($::coff) | 238 | elsif ($::coff) |
diff --git a/src/lib/libcrypto/perlasm/x86masm.pl b/src/lib/libcrypto/perlasm/x86masm.pl new file mode 100644 index 0000000000..3d50e4a786 --- /dev/null +++ b/src/lib/libcrypto/perlasm/x86masm.pl | |||
| @@ -0,0 +1,184 @@ | |||
| 1 | #!/usr/bin/env perl | ||
| 2 | |||
| 3 | package x86masm; | ||
| 4 | |||
| 5 | *out=\@::out; | ||
| 6 | |||
| 7 | $::lbdecor="\$L"; # local label decoration | ||
| 8 | $nmdecor="_"; # external name decoration | ||
| 9 | |||
| 10 | $initseg=""; | ||
| 11 | $segment=""; | ||
| 12 | |||
| 13 | sub ::generic | ||
| 14 | { my ($opcode,@arg)=@_; | ||
| 15 | |||
| 16 | # fix hexadecimal constants | ||
| 17 | for (@arg) { s/0x([0-9a-f]+)/0$1h/oi; } | ||
| 18 | |||
| 19 | if ($opcode !~ /movq/) | ||
| 20 | { # fix xmm references | ||
| 21 | $arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[1]=~/\bxmm[0-7]\b/i); | ||
| 22 | $arg[1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i); | ||
| 23 | } | ||
| 24 | |||
| 25 | &::emit($opcode,@arg); | ||
| 26 | 1; | ||
| 27 | } | ||
| 28 | # | ||
| 29 | # opcodes not covered by ::generic above, mostly inconsistent namings... | ||
| 30 | # | ||
| 31 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } | ||
| 32 | sub ::call_ptr { &::emit("call",@_); } | ||
| 33 | sub ::jmp_ptr { &::emit("jmp",@_); } | ||
| 34 | |||
| 35 | sub get_mem | ||
| 36 | { my($size,$addr,$reg1,$reg2,$idx)=@_; | ||
| 37 | my($post,$ret); | ||
| 38 | |||
| 39 | $ret .= "$size PTR " if ($size ne ""); | ||
| 40 | |||
| 41 | $addr =~ s/^\s+//; | ||
| 42 | # prepend global references with optional underscore | ||
| 43 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; | ||
| 44 | # put address arithmetic expression in parenthesis | ||
| 45 | $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); | ||
| 46 | |||
| 47 | if (($addr ne "") && ($addr ne 0)) | ||
| 48 | { if ($addr !~ /^-/) { $ret .= "$addr"; } | ||
| 49 | else { $post=$addr; } | ||
| 50 | } | ||
| 51 | $ret .= "["; | ||
| 52 | |||
| 53 | if ($reg2 ne "") | ||
| 54 | { $idx!=0 or $idx=1; | ||
| 55 | $ret .= "$reg2*$idx"; | ||
| 56 | $ret .= "+$reg1" if ($reg1 ne ""); | ||
| 57 | } | ||
| 58 | else | ||
| 59 | { $ret .= "$reg1"; } | ||
| 60 | |||
| 61 | $ret .= "$post]"; | ||
| 62 | $ret =~ s/\+\]/]/; # in case $addr was the only argument | ||
| 63 | $ret =~ s/\[\s*\]//; | ||
| 64 | |||
| 65 | $ret; | ||
| 66 | } | ||
| 67 | sub ::BP { &get_mem("BYTE",@_); } | ||
| 68 | sub ::DWP { &get_mem("DWORD",@_); } | ||
| 69 | sub ::QWP { &get_mem("QWORD",@_); } | ||
| 70 | sub ::BC { "@_"; } | ||
| 71 | sub ::DWC { "@_"; } | ||
| 72 | |||
| 73 | sub ::file | ||
| 74 | { my $tmp=<<___; | ||
| 75 | TITLE $_[0].asm | ||
| 76 | IF \@Version LT 800 | ||
| 77 | ECHO MASM version 8.00 or later is strongly recommended. | ||
| 78 | ENDIF | ||
| 79 | .486 | ||
| 80 | .MODEL FLAT | ||
| 81 | OPTION DOTNAME | ||
| 82 | IF \@Version LT 800 | ||
| 83 | .text\$ SEGMENT PAGE 'CODE' | ||
| 84 | ELSE | ||
| 85 | .text\$ SEGMENT ALIGN(64) 'CODE' | ||
| 86 | ENDIF | ||
| 87 | ___ | ||
| 88 | push(@out,$tmp); | ||
| 89 | $segment = ".text\$"; | ||
| 90 | } | ||
| 91 | |||
| 92 | sub ::function_begin_B | ||
| 93 | { my $func=shift; | ||
| 94 | my $global=($func !~ /^_/); | ||
| 95 | my $begin="${::lbdecor}_${func}_begin"; | ||
| 96 | |||
| 97 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); | ||
| 98 | $func="ALIGN\t16\n".$nmdecor.$func."\tPROC"; | ||
| 99 | |||
| 100 | if ($global) { $func.=" PUBLIC\n${begin}::\n"; } | ||
| 101 | else { $func.=" PRIVATE\n"; } | ||
| 102 | push(@out,$func); | ||
| 103 | $::stack=4; | ||
| 104 | } | ||
| 105 | sub ::function_end_B | ||
| 106 | { my $func=shift; | ||
| 107 | |||
| 108 | push(@out,"$nmdecor$func ENDP\n"); | ||
| 109 | $::stack=0; | ||
| 110 | &::wipe_labels(); | ||
| 111 | } | ||
| 112 | |||
| 113 | sub ::file_end | ||
| 114 | { my $xmmheader=<<___; | ||
| 115 | .686 | ||
| 116 | .XMM | ||
| 117 | IF \@Version LT 800 | ||
| 118 | XMMWORD STRUCT 16 | ||
| 119 | DQ 2 dup (?) | ||
| 120 | XMMWORD ENDS | ||
| 121 | ENDIF | ||
| 122 | ___ | ||
| 123 | if (grep {/\b[x]?mm[0-7]\b/i} @out) { | ||
| 124 | grep {s/\.[3-7]86/$xmmheader/} @out; | ||
| 125 | } | ||
| 126 | |||
| 127 | push(@out,"$segment ENDS\n"); | ||
| 128 | |||
| 129 | if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) | ||
| 130 | { my $comm=<<___; | ||
| 131 | .bss SEGMENT 'BSS' | ||
| 132 | COMM ${nmdecor}OPENSSL_ia32cap_P:DWORD | ||
| 133 | .bss ENDS | ||
| 134 | ___ | ||
| 135 | # comment out OPENSSL_ia32cap_P declarations | ||
| 136 | grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; | ||
| 137 | push (@out,$comm); | ||
| 138 | } | ||
| 139 | push (@out,$initseg) if ($initseg); | ||
| 140 | push (@out,"END\n"); | ||
| 141 | } | ||
| 142 | |||
| 143 | sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } | ||
| 144 | |||
| 145 | *::set_label_B = sub | ||
| 146 | { my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; | ||
| 147 | |||
| 148 | sub ::external_label | ||
| 149 | { foreach(@_) | ||
| 150 | { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } | ||
| 151 | } | ||
| 152 | |||
| 153 | sub ::public_label | ||
| 154 | { push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | ||
| 155 | |||
| 156 | sub ::data_byte | ||
| 157 | { push(@out,("DB\t").join(',',@_)."\n"); } | ||
| 158 | |||
| 159 | sub ::data_word | ||
| 160 | { push(@out,("DD\t").join(',',@_)."\n"); } | ||
| 161 | |||
| 162 | sub ::align | ||
| 163 | { push(@out,"ALIGN\t$_[0]\n"); } | ||
| 164 | |||
| 165 | sub ::picmeup | ||
| 166 | { my($dst,$sym)=@_; | ||
| 167 | &::lea($dst,&::DWP($sym)); | ||
| 168 | } | ||
| 169 | |||
| 170 | sub ::initseg | ||
| 171 | { my $f=$nmdecor.shift; | ||
| 172 | |||
| 173 | $initseg.=<<___; | ||
| 174 | .CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' | ||
| 175 | EXTERN $f:NEAR | ||
| 176 | DD $f | ||
| 177 | .CRT\$XCU ENDS | ||
| 178 | ___ | ||
| 179 | } | ||
| 180 | |||
| 181 | sub ::dataseg | ||
| 182 | { push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } | ||
| 183 | |||
| 184 | 1; | ||
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 @@ | |||
| 1 | #!/usr/bin/env perl | ||
| 2 | |||
| 3 | package x86nasm; | ||
| 4 | |||
| 5 | *out=\@::out; | ||
| 6 | |||
| 7 | $::lbdecor="L\$"; # local label decoration | ||
| 8 | $nmdecor=$::netware?"":"_"; # external name decoration | ||
| 9 | $drdecor=$::mwerks?".":""; # directive decoration | ||
| 10 | |||
| 11 | $initseg=""; | ||
| 12 | |||
| 13 | sub ::generic | ||
| 14 | { my $opcode=shift; | ||
| 15 | my $tmp; | ||
| 16 | |||
| 17 | if (!$::mwerks) | ||
| 18 | { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps | ||
| 19 | { $_[0] = "NEAR $_[0]"; } | ||
| 20 | elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea | ||
| 21 | { $_[1] =~ s/^[^\[]*\[/\[/o; } | ||
| 22 | } | ||
| 23 | &::emit($opcode,@_); | ||
| 24 | 1; | ||
| 25 | } | ||
| 26 | # | ||
| 27 | # opcodes not covered by ::generic above, mostly inconsistent namings... | ||
| 28 | # | ||
| 29 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } | ||
| 30 | sub ::call_ptr { &::emit("call",@_); } | ||
| 31 | sub ::jmp_ptr { &::emit("jmp",@_); } | ||
| 32 | |||
| 33 | sub get_mem | ||
| 34 | { my($size,$addr,$reg1,$reg2,$idx)=@_; | ||
| 35 | my($post,$ret); | ||
| 36 | |||
| 37 | if ($size ne "") | ||
| 38 | { $ret .= "$size"; | ||
| 39 | $ret .= " PTR" if ($::mwerks); | ||
| 40 | $ret .= " "; | ||
| 41 | } | ||
| 42 | $ret .= "["; | ||
| 43 | |||
| 44 | $addr =~ s/^\s+//; | ||
| 45 | # prepend global references with optional underscore | ||
| 46 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; | ||
| 47 | # put address arithmetic expression in parenthesis | ||
| 48 | $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); | ||
| 49 | |||
| 50 | if (($addr ne "") && ($addr ne 0)) | ||
| 51 | { if ($addr !~ /^-/) { $ret .= "$addr+"; } | ||
| 52 | else { $post=$addr; } | ||
| 53 | } | ||
| 54 | |||
| 55 | if ($reg2 ne "") | ||
| 56 | { $idx!=0 or $idx=1; | ||
| 57 | $ret .= "$reg2*$idx"; | ||
| 58 | $ret .= "+$reg1" if ($reg1 ne ""); | ||
| 59 | } | ||
| 60 | else | ||
| 61 | { $ret .= "$reg1"; } | ||
| 62 | |||
| 63 | $ret .= "$post]"; | ||
| 64 | $ret =~ s/\+\]/]/; # in case $addr was the only argument | ||
| 65 | |||
| 66 | $ret; | ||
| 67 | } | ||
| 68 | sub ::BP { &get_mem("BYTE",@_); } | ||
| 69 | sub ::DWP { &get_mem("DWORD",@_); } | ||
| 70 | sub ::QWP { &get_mem("",@_); } | ||
| 71 | sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } | ||
| 72 | sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } | ||
| 73 | |||
| 74 | sub ::file | ||
| 75 | { if ($::mwerks) { push(@out,".section\t.text,64\n"); } | ||
| 76 | else | ||
| 77 | { my $tmp=<<___; | ||
| 78 | %ifidn __OUTPUT_FORMAT__,obj | ||
| 79 | section code use32 class=code align=64 | ||
| 80 | %elifidn __OUTPUT_FORMAT__,win32 | ||
| 81 | \$\@feat.00 equ 1 | ||
| 82 | section .text code align=64 | ||
| 83 | %else | ||
| 84 | section .text code | ||
| 85 | %endif | ||
| 86 | ___ | ||
| 87 | push(@out,$tmp); | ||
| 88 | } | ||
| 89 | } | ||
| 90 | |||
| 91 | sub ::function_begin_B | ||
| 92 | { my $func=shift; | ||
| 93 | my $global=($func !~ /^_/); | ||
| 94 | my $begin="${::lbdecor}_${func}_begin"; | ||
| 95 | |||
| 96 | $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops | ||
| 97 | |||
| 98 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); | ||
| 99 | $func=$nmdecor.$func; | ||
| 100 | |||
| 101 | push(@out,"${drdecor}global $func\n") if ($global); | ||
| 102 | push(@out,"${drdecor}align 16\n"); | ||
| 103 | push(@out,"$func:\n"); | ||
| 104 | push(@out,"$begin:\n") if ($global); | ||
| 105 | $::stack=4; | ||
| 106 | } | ||
| 107 | |||
| 108 | sub ::function_end_B | ||
| 109 | { $::stack=0; | ||
| 110 | &::wipe_labels(); | ||
| 111 | } | ||
| 112 | |||
| 113 | sub ::file_end | ||
| 114 | { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) | ||
| 115 | { my $comm=<<___; | ||
| 116 | ${drdecor}segment .bss | ||
| 117 | ${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 4 | ||
| 118 | ___ | ||
| 119 | # comment out OPENSSL_ia32cap_P declarations | ||
| 120 | grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; | ||
| 121 | push (@out,$comm) | ||
| 122 | } | ||
| 123 | push (@out,$initseg) if ($initseg); | ||
| 124 | } | ||
| 125 | |||
| 126 | sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } | ||
| 127 | |||
| 128 | sub ::external_label | ||
| 129 | { foreach(@_) | ||
| 130 | { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } | ||
| 131 | } | ||
| 132 | |||
| 133 | sub ::public_label | ||
| 134 | { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | ||
| 135 | |||
| 136 | sub ::data_byte | ||
| 137 | { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } | ||
| 138 | |||
| 139 | sub ::data_word | ||
| 140 | { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } | ||
| 141 | |||
| 142 | sub ::align | ||
| 143 | { push(@out,"${drdecor}align\t$_[0]\n"); } | ||
| 144 | |||
| 145 | sub ::picmeup | ||
| 146 | { my($dst,$sym)=@_; | ||
| 147 | &::lea($dst,&::DWP($sym)); | ||
| 148 | } | ||
| 149 | |||
| 150 | sub ::initseg | ||
| 151 | { my $f=$nmdecor.shift; | ||
| 152 | if ($::win32) | ||
| 153 | { $initseg=<<___; | ||
| 154 | segment .CRT\$XCU data align=4 | ||
| 155 | extern $f | ||
| 156 | dd $f | ||
| 157 | ___ | ||
| 158 | } | ||
| 159 | } | ||
| 160 | |||
| 161 | sub ::dataseg | ||
| 162 | { if ($mwerks) { push(@out,".section\t.data,4\n"); } | ||
| 163 | else { push(@out,"section\t.data align=4\n"); } | ||
| 164 | } | ||
| 165 | |||
| 166 | 1; | ||
