X-Git-Url: https://git.librecmc.org/?a=blobdiff_plain;f=crypto%2Fperlasm%2Fx86_64-xlate.pl;h=425cd292e7deec2c086f69f0ee108e5514b19b4f;hb=c62ee12574e661a111238954b07ea1d5f0786bec;hp=646f68058cec4da54336bfe79cb0b8f0ac677cc0;hpb=c25278db8e4c21772a0cd81f7873e767cbc6d219;p=oweals%2Fopenssl.git diff --git a/crypto/perlasm/x86_64-xlate.pl b/crypto/perlasm/x86_64-xlate.pl index 646f68058c..425cd292e7 100755 --- a/crypto/perlasm/x86_64-xlate.pl +++ b/crypto/perlasm/x86_64-xlate.pl @@ -170,8 +170,8 @@ my %globals; if ($self->{op} eq "ret") { $self->{op} = ""; if ($win64 && $current_function->{abi} eq "svr4") { - $self->{op} = "mov rdi,QWORD${PTR}[8+rsp]\t;WIN64 epilogue\n\t". - "mov rsi,QWORD${PTR}[16+rsp]\n\t"; + $self->{op} = "mov rdi,QWORD$PTR\[8+rsp\]\t;WIN64 epilogue\n\t". + "mov rsi,QWORD$PTR\[16+rsp\]\n\t"; } $self->{op} .= "DB\t0F3h,0C3h\t\t;repret"; } elsif ($self->{op} =~ /^(pop|push)f/) { @@ -210,6 +210,7 @@ my %globals; # Solaris /usr/ccs/bin/as can't handle multiplications # in $self->{value} my $value = $self->{value}; + no warnings; # oct might complain about overflow, ignore here... $value =~ s/(?{value} = $value; @@ -227,7 +228,7 @@ my %globals; my $self = {}; my $ret; - # optional * ---vvv--- appears in indirect jmp/call + # optional * ----vvv--- appears in indirect jmp/call if ($$line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) { bless $self, $class; $self->{asterisk} = $1; @@ -261,11 +262,18 @@ my %globals; $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; # Solaris /usr/ccs/bin/as can't handle multiplications - # in $self->{label}, new gas requires sign extension... + # in $self->{label}... use integer; $self->{label} =~ s/(?{label} =~ s/\b([0-9]+\s*[\*\/\%]\s*[0-9]+)\b/eval($1)/eg; - $self->{label} =~ s/\b([0-9]+)\b/$1<<32>>32/eg; + + # Some assemblers insist on signed presentation of 32-bit + # offsets, but sign extension is a tricky business in perl... + if ((1<<31)<<1) { + $self->{label} =~ s/\b([0-9]+)\b/$1<<32>>32/eg; + } else { + $self->{label} =~ s/\b([0-9]+)\b/$1>>0/eg; + } if (!$self->{label} && $self->{index} && $self->{scale}==1 && $self->{base} =~ /(rbp|r13)/) { @@ -317,15 +325,16 @@ my %globals; } { package register; # pick up registers, which start with %. sub re { - my ($class, $line) = @_; + my ($class, $line, $opcode) = @_; my $self = {}; my $ret; - # optional * ---vvv--- appears in indirect jmp/call + # optional * ----vvv--- appears in indirect jmp/call if ($$line =~ /^(\*?)%(\w+)/) { bless $self,$class; $self->{asterisk} = $1; $self->{value} = $2; + $opcode->size($self->size()); $ret = $self; $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; } @@ -399,8 +408,8 @@ my %globals; my $func = "$current_function->{name}" . ($nasm ? ":" : "\tPROC $current_function->{scope}") . "\n"; - $func .= " mov QWORD${PTR}[8+rsp],rdi\t;WIN64 prologue\n"; - $func .= " mov QWORD${PTR}[16+rsp],rsi\n"; + $func .= " mov QWORD$PTR\[8+rsp\],rdi\t;WIN64 prologue\n"; + $func .= " mov QWORD$PTR\[16+rsp\],rsi\n"; $func .= " mov rax,rsp\n"; $func .= "${decor}SEH_begin_$current_function->{name}:"; $func .= ":" if ($masm); @@ -411,8 +420,8 @@ my %globals; $func .= " mov rsi,rdx\n" if ($narg>1); $func .= " mov rdx,r8\n" if ($narg>2); $func .= " mov rcx,r9\n" if ($narg>3); - $func .= " mov r8,QWORD${PTR}[40+rsp]\n" if ($narg>4); - $func .= " mov r9,QWORD${PTR}[48+rsp]\n" if ($narg>5); + $func .= " mov r8,QWORD$PTR\[40+rsp\]\n" if ($narg>4); + $func .= " mov r9,QWORD$PTR\[48+rsp\]\n" if ($narg>5); $func .= "\n"; } else { "$current_function->{name}". @@ -420,7 +429,7 @@ my %globals; } } } -{ package expr; # pick up expressioins +{ package expr; # pick up expressions sub re { my ($class, $line, $opcode) = @_; my $self = {}; @@ -691,7 +700,13 @@ sub rex { push @$opcode,($rex|0x40) if ($rex); } -# older gas and ml64 don't handle SSE>2 instructions +# Upon initial x86_64 introduction SSE>2 extensions were not introduced +# yet. In order not to be bothered by tracing exact assembler versions, +# but at the same time to provide a bare security minimum of AES-NI, we +# hard-code some instructions. Extensions past AES-NI on the other hand +# are traced by examining assembler version in individual perlasm +# modules... + my %regrm = ( "%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3, "%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7 ); @@ -797,7 +812,7 @@ my $rdrand = sub { my @opcode=(); my $dst=$1; if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; } - rex(\@opcode,0,$1,8); + rex(\@opcode,0,$dst,8); push @opcode,0x0f,0xc7,0xf0|($dst&7); @opcode; } else { @@ -810,7 +825,7 @@ my $rdseed = sub { my @opcode=(); my $dst=$1; if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; } - rex(\@opcode,0,$1,8); + rex(\@opcode,0,$dst,8); push @opcode,0x0f,0xc7,0xf8|($dst&7); @opcode; } else { @@ -857,6 +872,10 @@ my $vprotq = sub { } }; +my $endbranch = sub { + (0xf3,0x0f,0x1e,0xfa); +}; + if ($nasm) { print <<___; default rel @@ -892,19 +911,19 @@ while(defined(my $line=<>)) { my @args; ARGUMENT: while (1) { - my $arg; + my $arg; - if ($arg=register->re(\$line)) { $opcode->size($arg->size()); } - elsif ($arg=const->re(\$line)) { } - elsif ($arg=ea->re(\$line, $opcode)) { } - elsif ($arg=expr->re(\$line, $opcode)) { } - else { last ARGUMENT; } + ($arg=register->re(\$line, $opcode))|| + ($arg=const->re(\$line)) || + ($arg=ea->re(\$line, $opcode)) || + ($arg=expr->re(\$line, $opcode)) || + last ARGUMENT; - push @args,$arg; + push @args,$arg; - last ARGUMENT if ($line !~ /^,/); + last ARGUMENT if ($line !~ /^,/); - $line =~ s/^,\s*//; + $line =~ s/^,\s*//; } # ARGUMENT: if ($#args>=0) { @@ -985,7 +1004,7 @@ close STDOUT; # the area above user stack pointer in true asynchronous manner... # # All the above means that if assembler programmer adheres to Unix -# register and stack layout, but disregards the "red zone" existense, +# register and stack layout, but disregards the "red zone" existence, # it's possible to use following prologue and epilogue to "gear" from # Unix to Win64 ABI in leaf functions with not more than 6 arguments. #