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/) {
# 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/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
if ($value =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg) {
$self->{value} = $value;
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->{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/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
$self->{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)/) {
}
{ 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+//;
}
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);
$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}".
}
}
}
-{ package expr; # pick up expressioins
+{ package expr; # pick up expressions
sub re {
my ($class, $line, $opcode) = @_;
my $self = {};
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 );
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 {
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 {
}
};
+my $endbranch = sub {
+ (0xf3,0x0f,0x1e,0xfa);
+};
+
if ($nasm) {
print <<___;
default rel
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) {
# 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.
#