X-Git-Url: https://git.librecmc.org/?a=blobdiff_plain;f=crypto%2Fperlasm%2Fx86_64-xlate.pl;h=425cd292e7deec2c086f69f0ee108e5514b19b4f;hb=c62ee12574e661a111238954b07ea1d5f0786bec;hp=1f138508249151530cb18e8888fb5e43525df45c;hpb=852537726574b0b568a3bd8d12e5c797c5e56c63;p=oweals%2Fopenssl.git diff --git a/crypto/perlasm/x86_64-xlate.pl b/crypto/perlasm/x86_64-xlate.pl index 1f13850824..425cd292e7 100755 --- a/crypto/perlasm/x86_64-xlate.pl +++ b/crypto/perlasm/x86_64-xlate.pl @@ -1,4 +1,11 @@ -#!/usr/bin/env perl +#! /usr/bin/env perl +# Copyright 2005-2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (the "License"). You may not use +# this file except in compliance with the License. You can obtain a copy +# in the file LICENSE in the source distribution or at +# https://www.openssl.org/source/license.html + # Ascetic x86_64 AT&T to MASM/NASM assembler translator by . # @@ -55,22 +62,24 @@ # Win64 prologue copies %rsp value to %rax. For further details # see SEH paragraph at the end. # 9. .init segment is allowed to contain calls to functions only. +# a. If function accepts more than 4 arguments *and* >4th argument +# is declared as non 64-bit value, do clear its upper part. + +use strict; + my $flavour = shift; my $output = shift; if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } -{ my ($stddev,$stdino,@junk)=stat(STDOUT); - my ($outdev,$outino,@junk)=stat($output); - - open STDOUT,">$output" || die "can't open $output: $!" - if ($stddev!=$outdev || $stdino!=$outino); -} +open STDOUT,">$output" || die "can't open $output: $!" + if (defined($output)); my $gas=1; $gas=0 if ($output =~ /\.asm$/); my $elf=1; $elf=0 if (!$gas); my $win64=0; my $prefix=""; +my $decor=".L"; my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005 my $masm=0; @@ -79,10 +88,13 @@ my $PTR=" PTR"; my $nasmref=2.03; my $nasm=0; -if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1; $prefix="_"; } -elsif ($flavour eq "macosx") { $gas=1; $elf=0; $prefix="_"; } -elsif ($flavour eq "masm") { $gas=0; $elf=0; $masm=$masmref; $win64=1; } -elsif ($flavour eq "nasm") { $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $PTR=""; } +if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1; + $prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`; + $prefix =~ s|\R$||; # Better chomp + } +elsif ($flavour eq "macosx") { $gas=1; $elf=0; $prefix="_"; $decor="L\$"; } +elsif ($flavour eq "masm") { $gas=0; $elf=0; $masm=$masmref; $win64=1; $decor="\$L\$"; } +elsif ($flavour eq "nasm") { $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $decor="\$L\$"; $PTR=""; } elsif (!$gas) { if ($ENV{ASM} =~ m/nasm/ && `nasm -v` =~ m/version ([0-9]+)\.([0-9]+)/i) { $nasm = $1 + $2*0.01; $PTR=""; } @@ -91,6 +103,7 @@ elsif (!$gas) die "no assembler found on %PATH" if (!($nasm || $masm)); $win64=1; $elf=0; + $decor="\$L\$"; } my $current_segment; @@ -99,21 +112,28 @@ my %globals; { package opcode; # pick up opcodes sub re { - my $self = shift; # single instance in enough... - local *line = shift; - undef $ret; + my ($class, $line) = @_; + my $self = {}; + my $ret; - if ($line =~ /^([a-z][a-z0-9]*)/i) { + if ($$line =~ /^([a-z][a-z0-9]*)/i) { + bless $self,$class; $self->{op} = $1; $ret = $self; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; undef $self->{sz}; - if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... + if ($self->{op} =~ /^(movz)x?([bw]).*/) { # movz is pain... $self->{op} = $1; - $self->{sz} = "b"; + $self->{sz} = $2; } elsif ($self->{op} =~ /call|jmp/) { - $self->{sz} = "" + $self->{sz} = ""; + } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn + $self->{sz} = ""; + } elsif ($self->{op} =~ /^v/) { # VEX + $self->{sz} = ""; + } elsif ($self->{op} =~ /mov[dq]/ && $$line =~ /%xmm/) { + $self->{sz} = ""; } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { $self->{op} = $1; $self->{sz} = $2; @@ -122,8 +142,7 @@ my %globals; $ret; } sub size { - my $self = shift; - my $sz = shift; + my ($self, $sz) = @_; $self->{sz} = $sz if (defined($sz) && !defined($self->{sz})); $self->{sz}; } @@ -151,83 +170,90 @@ 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/) { $self->{op} .= $self->{sz}; } elsif ($self->{op} eq "call" && $current_segment eq ".CRT\$XCU") { - $self->{op} = "ALIGN\t8\n\tDQ"; + $self->{op} = "\tDQ"; } $self->{op}; } } sub mnemonic { - my $self=shift; - my $op=shift; + my ($self, $op) = @_; $self->{op}=$op if (defined($op)); $self->{op}; } } { package const; # pick up constants, which start with $ sub re { - my $self = shift; # single instance in enough... - local *line = shift; - undef $ret; + my ($class, $line) = @_; + my $self = {}; + my $ret; - if ($line =~ /^\$([^,]+)/) { + if ($$line =~ /^\$([^,]+)/) { + bless $self, $class; $self->{value} = $1; $ret = $self; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; } $ret; } sub out { my $self = shift; + $self->{value} =~ s/\b(0b[0-1]+)/oct($1)/eig; if ($gas) { # Solaris /usr/ccs/bin/as can't handle multiplications # in $self->{value} - $self->{value} =~ s/(?{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; + my $value = $self->{value}; + no warnings; # oct might complain about overflow, ignore here... + $value =~ s/(?{value} = $value; + } sprintf "\$%s",$self->{value}; } else { - $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig; + $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm); sprintf "%s",$self->{value}; } } } { package ea; # pick up effective addresses: expr(%reg,%reg,scale) sub re { - my $self = shift; # single instance in enough... - local *line = shift; - undef $ret; + my ($class, $line, $opcode) = @_; + my $self = {}; + my $ret; - # optional * ---vvv--- appears in indirect jmp/call - if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) { + # optional * ----vvv--- appears in indirect jmp/call + if ($$line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) { + bless $self, $class; $self->{asterisk} = $1; $self->{label} = $2; ($self->{base},$self->{index},$self->{scale})=split(/,/,$3); $self->{scale} = 1 if (!defined($self->{scale})); $ret = $self; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; if ($win64 && $self->{label} =~ s/\@GOTPCREL//) { - die if (opcode->mnemonic() ne "mov"); - opcode->mnemonic("lea"); + die if ($opcode->mnemonic() ne "mov"); + $opcode->mnemonic("lea"); } $self->{base} =~ s/^%//; $self->{index} =~ s/^%// if (defined($self->{index})); + $self->{opcode} = $opcode; } $ret; } sub size {} sub out { - my $self = shift; - my $sz = shift; + my ($self, $sz) = @_; $self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; + $self->{label} =~ s/\.L/$decor/g; # Silently convert all EAs to 64-bit. This is required for # elder GNU assembler and results in more compact code, @@ -235,34 +261,58 @@ my %globals; $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; + # Solaris /usr/ccs/bin/as can't handle multiplications + # in $self->{label}... + use integer; + $self->{label} =~ s/(?{label} =~ s/\b([0-9]+\s*[\*\/\%]\s*[0-9]+)\b/eval($1)/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)/) { + $self->{base} = $self->{index}; $self->{index} = $1; + } + if ($gas) { - # Solaris /usr/ccs/bin/as can't handle multiplications - # in $self->{label} - $self->{label} =~ s/(?{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; - $self->{label} =~ s/\.L/L\$/g if (!$elf); + $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" ); + my %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", + l=>"DWORD$PTR", d=>"DWORD$PTR", + q=>"QWORD$PTR", o=>"OWORD$PTR", + x=>"XMMWORD$PTR", y=>"YMMWORD$PTR", z=>"ZMMWORD$PTR" ); - $self->{label} =~ s/\.L/\$L\$/g; $self->{label} =~ s/\./\$/g; - $self->{label} =~ s/0x([0-9a-f]+)/0$1h/ig; + $self->{label} =~ s/(?{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); - $sz="q" if ($self->{asterisk}); + + my $mnemonic = $self->{opcode}->mnemonic(); + ($self->{asterisk}) && ($sz="q") || + ($mnemonic =~ /^v?mov([qd])$/) && ($sz=$1) || + ($mnemonic =~ /^v?pinsr([qdwb])$/) && ($sz=$1) || + ($mnemonic =~ /^vpbroadcast([qdwb])$/) && ($sz=$1) || + ($mnemonic =~ /^v(?!perm)[a-z]+[fi]128$/) && ($sz="x"); 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 { @@ -275,24 +325,24 @@ my %globals; } { package register; # pick up registers, which start with %. sub re { - my $class = shift; # muliple instances... + my ($class, $line, $opcode) = @_; my $self = {}; - local *line = shift; - undef $ret; + my $ret; - # optional * ---vvv--- appears in indirect jmp/call - if ($line =~ /^(\*?)%(\w+)/) { + # 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+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; } $ret; } sub size { my $self = shift; - undef $ret; + my $ret; if ($self->{value} =~ /^r[\d]+b$/i) { $ret="b"; } elsif ($self->{value} =~ /^r[\d]+w$/i) { $ret="w"; } @@ -313,17 +363,17 @@ my %globals; } { package label; # pick up labels, which end with : sub re { - my $self = shift; # single instance is enough... - local *line = shift; - undef $ret; + my ($class, $line) = @_; + my $self = {}; + my $ret; - if ($line =~ /(^[\.\w]+)\:/) { + if ($$line =~ /(^[\.\w]+)\:/) { + bless $self,$class; $self->{value} = $1; $ret = $self; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; - $self->{value} =~ s/\.L/\$L\$/ if (!$gas); - $self->{value} =~ s/\.L/L\$/ if (!$elf); + $self->{value} =~ s/^\.L/$decor/; } $ret; } @@ -339,7 +389,7 @@ my %globals; $func .= " movq %rdi,8(%rsp)\n"; $func .= " movq %rsi,16(%rsp)\n"; $func .= " movq %rsp,%rax\n"; - $func .= ".LSEH_begin_$current_function->{name}:\n"; + $func .= "${decor}SEH_begin_$current_function->{name}:\n"; my $narg = $current_function->{narg}; $narg=6 if (!defined($narg)); $func .= " movq %rcx,%rdi\n" if ($narg>0); @@ -351,16 +401,17 @@ my %globals; } $func; } elsif ($self->{value} ne "$current_function->{name}") { - $self->{value} .= ":" if ($masm && $ret!~m/^\$/); + # Make all labels in masm global. + $self->{value} .= ":" if ($masm); $self->{value} . ":"; } elsif ($win64 && $current_function->{abi} eq "svr4") { 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 .= "\$L\$SEH_begin_$current_function->{name}:"; + $func .= "${decor}SEH_begin_$current_function->{name}:"; $func .= ":" if ($masm); $func .= "\n"; my $narg = $current_function->{narg}; @@ -369,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}". @@ -378,27 +429,28 @@ my %globals; } } } -{ package expr; # pick up expressioins +{ package expr; # pick up expressions sub re { - my $self = shift; # single instance is enough... - local *line = shift; - undef $ret; + my ($class, $line, $opcode) = @_; + my $self = {}; + my $ret; - if ($line =~ /(^[^,]+)/) { + if ($$line =~ /(^[^,]+)/) { + bless $self,$class; $self->{value} = $1; $ret = $self; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; $self->{value} =~ s/\@PLT// if (!$elf); $self->{value} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; - $self->{value} =~ s/\.L/\$L\$/g if (!$gas); - $self->{value} =~ s/\.L/L\$/g if (!$elf); + $self->{value} =~ s/\.L/$decor/g; + $self->{opcode} = $opcode; } $ret; } sub out { my $self = shift; - if ($nasm && opcode->mnemonic()=~m/^j/) { + if ($nasm && $self->{opcode}->mnemonic()=~m/^j(?![re]cxz)/) { "NEAR ".$self->{value}; } else { $self->{value}; @@ -407,9 +459,9 @@ my %globals; } { package directive; # pick up directives, which start with . sub re { - my $self = shift; # single instance is enough... - local *line = shift; - undef $ret; + my ($class, $line) = @_; + my $self = {}; + my $ret; my $dir; my %opcode = # lea 2f-1f(%rip),%dst; 1: nop; 2: ( "%rax"=>0x01058d48, "%rcx"=>0x010d8d48, @@ -421,25 +473,26 @@ my %globals; "%r12"=>0x01258d4c, "%r13"=>0x012d8d4c, "%r14"=>0x01358d4c, "%r15"=>0x013d8d4c ); - if ($line =~ /^\s*(\.\w+)/) { + if ($$line =~ /^\s*(\.\w+)/) { + bless $self,$class; $dir = $1; $ret = $self; undef $self->{value}; - $line = substr($line,@+[0]); $line =~ s/^\s+//; + $$line = substr($$line,@+[0]); $$line =~ s/^\s+//; SWITCH: for ($dir) { - /\.picmeup/ && do { if ($line =~ /(%r[\w]+)/i) { + /\.picmeup/ && do { if ($$line =~ /(%r[\w]+)/i) { $dir="\t.long"; - $line=sprintf "0x%x,0x90000000",$opcode{$1}; + $$line=sprintf "0x%x,0x90000000",$opcode{$1}; } last; }; /\.global|\.globl|\.extern/ - && do { $globals{$line} = $prefix . $line; - $line = $globals{$line} if ($prefix); + && do { $globals{$$line} = $prefix . $$line; + $$line = $globals{$$line} if ($prefix); last; }; - /\.type/ && do { ($sym,$type,$narg) = split(',',$line); + /\.type/ && do { my ($sym,$type,$narg) = split(',',$$line); if ($type eq "\@function") { undef $current_function; $current_function->{name} = $sym; @@ -451,20 +504,25 @@ my %globals; $current_function->{name} = $sym; $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE"; } - $line =~ s/\@abi\-omnipotent/\@function/; - $line =~ s/\@function.*/\@function/; + $$line =~ s/\@abi\-omnipotent/\@function/; + $$line =~ s/\@function.*/\@function/; last; }; - /\.asciz/ && do { if ($line =~ /^"(.*)"$/) { + /\.asciz/ && do { if ($$line =~ /^"(.*)"$/) { $dir = ".byte"; - $line = join(",",unpack("C*",$1),0); + $$line = join(",",unpack("C*",$1),0); } last; }; + /\.rva|\.long|\.quad/ + && do { $$line =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; + $$line =~ s/\.L/$decor/g; + last; + }; } if ($gas) { - $self->{value} = $dir . "\t" . $line; + $self->{value} = $dir . "\t" . $$line; if ($dir =~ /\.extern/) { $self->{value} = ""; # swallow extern @@ -473,26 +531,32 @@ my %globals; $self->{value} = ".def\t" . ($globals{$1} or $1) . ";\t" . (defined($globals{$1})?".scl 2;":".scl 3;") . "\t.type 32;\t.endef" - if ($win64 && $line =~ /([^,]+),\@function/); + if ($win64 && $$line =~ /([^,]+),\@function/); } elsif (!$elf && $dir =~ /\.size/) { $self->{value} = ""; if (defined($current_function)) { - $self->{value} .= ".LSEH_end_$current_function->{name}:" + $self->{value} .= "${decor}SEH_end_$current_function->{name}:" if ($win64 && $current_function->{abi} eq "svr4"); undef $current_function; } } elsif (!$elf && $dir =~ /\.align/) { - $self->{value} = ".p2align\t" . (log($line)/log(2)); + $self->{value} = ".p2align\t" . (log($$line)/log(2)); } elsif ($dir eq ".section") { - $current_segment=$line; + $current_segment=$$line; if (!$elf && $current_segment eq ".init") { if ($flavour eq "macosx") { $self->{value} = ".mod_init_func"; } elsif ($flavour eq "mingw64") { $self->{value} = ".section\t.ctors"; } } } 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"; + $self->{value} =~ s|,([0-9]+),([0-9]+)$|",$1,".log($2)/log(2)|e if ($flavour eq "macosx"); } - $line = ""; + $$line = ""; return $self; } @@ -505,7 +569,7 @@ my %globals; $v="$current_segment\tENDS\n" if ($current_segment); $current_segment = ".text\$"; $v.="$current_segment\tSEGMENT "; - $v.=$masm>=$masmref ? "ALIGN(64)" : "PAGE"; + $v.=$masm>=$masmref ? "ALIGN(256)" : "PAGE"; $v.=" 'CODE'"; } $self->{value} = $v; @@ -523,54 +587,62 @@ my %globals; last; }; /\.section/ && do { my $v=undef; - $line =~ s/([^,]*).*/$1/; - $line = ".CRT\$XCU" if ($line eq ".init"); + $$line =~ s/([^,]*).*/$1/; + $$line = ".CRT\$XCU" if ($$line eq ".init"); if ($nasm) { - $v="section $line"; - if ($line=~/\.([px])data/) { + $v="section $$line"; + if ($$line=~/\.([px])data/) { $v.=" rdata align="; $v.=$1 eq "p"? 4 : 8; + } elsif ($$line=~/\.CRT\$/i) { + $v.=" rdata align=8"; } } else { $v="$current_segment\tENDS\n" if ($current_segment); - $v.="$line\tSEGMENT"; - if ($line=~/\.([px])data/) { + $v.="$$line\tSEGMENT"; + if ($$line=~/\.([px])data/) { $v.=" READONLY"; $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); + } elsif ($$line=~/\.CRT\$/i) { + $v.=" READONLY "; + $v.=$masm>=$masmref ? "ALIGN(8)" : "DWORD"; } } - $current_segment = $line; + $current_segment = $$line; $self->{value} = $v; last; }; - /\.extern/ && do { $self->{value} = "EXTERN\t".$line; + /\.extern/ && do { $self->{value} = "EXTERN\t".$$line; $self->{value} .= ":NEAR" if ($masm); last; }; /\.globl|.global/ && do { $self->{value} = $masm?"PUBLIC":"global"; - $self->{value} .= "\t".$line; + $self->{value} .= "\t".$$line; last; }; /\.size/ && do { if (defined($current_function)) { undef $self->{value}; if ($current_function->{abi} eq "svr4") { - $self->{value}="\$L\$SEH_end_$current_function->{name}:"; + $self->{value}="${decor}SEH_end_$current_function->{name}:"; $self->{value}.=":\n" if($masm); } - $self->{value}.="$current_function->{name}\tENDP" if($masm); + $self->{value}.="$current_function->{name}\tENDP" if($masm && $current_function->{name}); undef $current_function; } last; }; - /\.align/ && do { $self->{value} = "ALIGN\t".$line; last; }; + /\.align/ && do { my $max = ($masm && $masm>=$masmref) ? 256 : 4096; + $self->{value} = "ALIGN\t".($$line>$max?$max:$$line); + last; + }; /\.(value|long|rva|quad)/ && do { my $sz = substr($1,0,1); - my @arr = split(',',$line); + my @arr = split(/,\s*/,$$line); my $last = pop(@arr); my $conv = sub { my $var=shift; - $var=~s/0x([0-9a-f]+)/0$1h/ig; - $var=~s/\.L/\$L\$/g; + $var=~s/^(0b[0-1]+)/oct($1)/eig; + $var=~s/^0x([0-9a-f]+)/0$1h/ig if ($masm); if ($sz eq "D" && ($current_segment=~/.[px]data/ || $dir eq ".rva")) { $var=~s/([_a-z\$\@][_a-z0-9\$\@]*)/$nasm?"$1 wrt ..imagebase":"imagerel $1"/egi; } $var; @@ -582,7 +654,9 @@ my %globals; $self->{value} .= &$conv($last); last; }; - /\.byte/ && do { my @str=split(",",$line); + /\.byte/ && do { my @str=split(/,\s*/,$$line); + map(s/(0b[0-1]+)/oct($1)/eig,@str); + map(s/0x([0-9a-f]+)/0$1h/ig,@str) if ($masm); while ($#str>15) { $self->{value}.="DB\t" .join(",",@str[0..15])."\n"; @@ -592,8 +666,21 @@ 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 = ""; + $$line = ""; } $ret; @@ -604,63 +691,263 @@ my %globals; } } +sub rex { + my $opcode=shift; + my ($dst,$src,$rex)=@_; + + $rex|=0x04 if($dst>=8); + $rex|=0x01 if($src>=8); + push @$opcode,($rex|0x40) if ($rex); +} + +# 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 ); + +my $movq = sub { # elderly gas can't handle inter-register movq + my $arg = shift; + my @opcode=(0x66); + if ($arg =~ /%xmm([0-9]+),\s*%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+),\s*%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]+),\s*%xmm([0-9]+),\s*(%\w+)/) { + my @opcode=(0x66); + my $imm=$1; + my $src=$2; + my $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]+),\s*(%\w+),\s*%xmm([0-9]+)/) { + my @opcode=(0x66); + my $imm=$1; + my $src=$2; + my $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]+),\s*%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]+),\s*%xmm([0-9]+),\s*%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,$dst,8); + push @opcode,0x0f,0xc7,0xf0|($dst&7); + @opcode; + } else { + (); + } +}; + +my $rdseed = sub { + if (shift =~ /%[er](\w+)/) { + my @opcode=(); + my $dst=$1; + if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; } + rex(\@opcode,0,$dst,8); + push @opcode,0x0f,0xc7,0xf8|($dst&7); + @opcode; + } else { + (); + } +}; + +sub rxb { + my $opcode=shift; + my ($dst,$src1,$src2,$rxb)=@_; + + $rxb|=0x7<<5; + $rxb&=~(0x04<<5) if($dst>=8); + $rxb&=~(0x01<<5) if($src1>=8); + $rxb&=~(0x02<<5) if($src2>=8); + push @$opcode,$rxb; +} + +my $vprotd = sub { + if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) { + my @opcode=(0x8f); + rxb(\@opcode,$3,$2,-1,0x08); + push @opcode,0x78,0xc2; + push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M + my $c=$1; + push @opcode,$c=~/^0/?oct($c):$c; + @opcode; + } else { + (); + } +}; + +my $vprotq = sub { + if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) { + my @opcode=(0x8f); + rxb(\@opcode,$3,$2,-1,0x08); + push @opcode,0x78,0xc3; + push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M + my $c=$1; + push @opcode,$c=~/^0/?oct($c):$c; + @opcode; + } else { + (); + } +}; + +my $endbranch = sub { + (0xf3,0x0f,0x1e,0xfa); +}; + if ($nasm) { print <<___; default rel +%define XMMWORD +%define YMMWORD +%define ZMMWORD ___ } elsif ($masm) { print <<___; OPTION DOTNAME ___ } -while($line=<>) { +while(defined(my $line=<>)) { - chomp($line); + $line =~ s|\R$||; # Better chomp $line =~ s|[#!].*$||; # get rid of asm-style comments... $line =~ s|/\*.*\*/||; # ... and C-style comments... $line =~ s|^\s+||; # ... and skip white spaces in beginning + $line =~ s|\s+$||; # ... and at the end - undef $label; - undef $opcode; - undef $dst; - undef $src; - undef $sz; - - if ($label=label->re(\$line)) { print $label->out(); } + if (my $label=label->re(\$line)) { print $label->out(); } - if (directive->re(\$line)) { - printf "%s",directive->out(); - } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: { + if (my $directive=directive->re(\$line)) { + printf "%s",$directive->out(); + } elsif (my $opcode=opcode->re(\$line)) { + my $asm = eval("\$".$opcode->mnemonic()); + + if ((ref($asm) eq 'CODE') && scalar(my @bytes=&$asm($line))) { + print $gas?".byte\t":"DB\t",join(',',@bytes),"\n"; + next; + } - if ($src=register->re(\$line)) { opcode->size($src->size()); } - elsif ($src=const->re(\$line)) { } - elsif ($src=ea->re(\$line)) { } - elsif ($src=expr->re(\$line)) { } + my @args; + ARGUMENT: while (1) { + my $arg; - last ARGUMENT if ($line !~ /^,/); + ($arg=register->re(\$line, $opcode))|| + ($arg=const->re(\$line)) || + ($arg=ea->re(\$line, $opcode)) || + ($arg=expr->re(\$line, $opcode)) || + last ARGUMENT; - $line = substr($line,1); $line =~ s/^\s+//; + push @args,$arg; - if ($dst=register->re(\$line)) { opcode->size($dst->size()); } - elsif ($dst=const->re(\$line)) { } - elsif ($dst=ea->re(\$line)) { } + last ARGUMENT if ($line !~ /^,/); + $line =~ s/^,\s*//; } # ARGUMENT: - $sz=opcode->size(); + if ($#args>=0) { + my $insn; + my $sz=$opcode->size(); - if (defined($dst)) { if ($gas) { - printf "\t%s\t%s,%s", $opcode->out($dst->size()), - $src->out($sz),$dst->out($sz); + $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(); + 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 =~ /^ymm[0-9]+$/) { $insn.=$sz; $sz="y" if(!$sz); last; } + if ($arg =~ /^zmm[0-9]+$/) { $insn.=$sz; $sz="z" 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,%s", $opcode->out(), - $dst->out($sz),$src->out($sz); + printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args)); } - } elsif (defined($src)) { - printf "\t%s\t%s",$opcode->out(),$src->out($sz); } else { printf "\t%s",$opcode->out(); } @@ -700,7 +987,7 @@ close STDOUT; # (#) Nth argument, volatile # # In Unix terms top of stack is argument transfer area for arguments -# which could not be accomodated in registers. Or in other words 7th +# which could not be accommodated in registers. Or in other words 7th # [integer] argument resides at 8(%rsp) upon function entry point. # 128 bytes above %rsp constitute a "red zone" which is not touched # by signal handlers and can be used as temporal storage without @@ -717,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. # @@ -826,6 +1113,7 @@ close STDOUT; # CONTEXT.R14 232 # CONTEXT.R15 240 # CONTEXT.Rip 248 +# CONTEXT.Xmm6 512 # sizeof(CONTEXT) 1232 # DISPATCHER_CONTEXT.ControlPc 0 # DISPATCHER_CONTEXT.ImageBase 8 @@ -863,7 +1151,7 @@ close STDOUT; # .rva .LSEH_end_function # .rva function_unwind_info # -# Reference to functon_unwind_info from .xdata segment is the anchor. +# Reference to function_unwind_info from .xdata segment is the anchor. # In case you wonder why references are 32-bit .rvas and not 64-bit # .quads. References put into these two segments are required to be # *relative* to the base address of the current binary module, a.k.a.