x86[_64] perlasm: pull-in from HEAD. (4a46dc6e) · Commits · CYBER - Cyber Security / TS 103 523 MSP / TLMSP / TLMSP OpenSSL

crypto/perlasm/x86_64-xlate.pl

+175 −12

Original line number	Diff line number	Diff line
		@@ -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));
		}
		} else {
		printf "\t%s",$opcode->out();
		}

crypto/perlasm/x86asm.pl

+51 −0

Original line number	Diff line number	Diff line
		@@ -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";

crypto/perlasm/x86gas.pl

+9 −6

Original line number	Diff line number	Diff line
		@@ -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

crypto/perlasm/x86masm.pl

+5 −1

Original line number	Diff line number	Diff line
		@@ -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"); }

crypto/perlasm/x86nasm.pl

+5 −1

Original line number	Diff line number	Diff line
		@@ -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"); }