quantum init

This commit is contained in:
zhaoxiaomeng
2018-01-04 13:38:57 +08:00
committed by Simon
parent d11f845fde
commit 53af3b51ae
2361 changed files with 387455 additions and 144458 deletions

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 1995-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
#!/usr/local/bin/perl
# void des_ncbc_encrypt(input, output, length, schedule, ivec, enc)
# des_cblock (*input);

View File

@@ -1,10 +1,6 @@
#! /usr/bin/env perl
# Copyright 2006-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
#!/usr/bin/env perl
# PowerPC assembler distiller by <appro>.
my $flavour = shift;
my $output = shift;
@@ -211,21 +207,6 @@ my $mtsle = sub {
" .long ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2);
};
# PowerISA 3.0 stuff
my $maddhdu = sub {
my ($f, $rt, $ra, $rb, $rc) = @_;
" .long ".sprintf "0x%X",(4<<26)|($rt<<21)|($ra<<16)|($rb<<11)|($rc<<6)|49;
};
my $maddld = sub {
my ($f, $rt, $ra, $rb, $rc) = @_;
" .long ".sprintf "0x%X",(4<<26)|($rt<<21)|($ra<<16)|($rb<<11)|($rc<<6)|51;
};
my $darn = sub {
my ($f, $rt, $l) = @_;
" .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($l<<16)|(755<<1);
};
while($line=<>) {
$line =~ s|[#!;].*$||; # get rid of asm-style comments...

View File

@@ -1,5 +1,5 @@
The perl scripts in this directory are my 'hack' to generate
multiple different assembler formats via the one original script.
multiple different assembler formats via the one origional script.
The way to use this library is to start with adding the path to this directory
and then include it.

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 2012-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
#!/usr/bin/env perl
# Specific modes implementations for SPARC Architecture 2011. There
# is T4 dependency though, an ASI value that is not specified in the
@@ -23,10 +16,6 @@
# block sizes [though few percent better for not so long ones]. All
# this based on suggestions from David Miller.
$::bias="STACK_BIAS";
$::frame="STACK_FRAME";
$::size_t_cc="SIZE_T_CC";
sub asm_init { # to be called with @ARGV as argument
for (@_) { $::abibits=64 if (/\-m64/ || /\-xarch\=v9/); }
if ($::abibits==64) { $::bias=2047; $::frame=192; $::size_t_cc="%xcc"; }
@@ -1398,7 +1387,7 @@ ___
# Purpose of these subroutines is to explicitly encode VIS instructions,
# so that one can compile the module without having to specify VIS
# extensions on compiler command line, e.g. -xarch=v9 vs. -xarch=v9a.
# extentions on compiler command line, e.g. -xarch=v9 vs. -xarch=v9a.
# Idea is to reserve for option to produce "universal" binary and let
# programmer detect if current CPU is VIS capable at run-time.
sub unvis {

View File

@@ -1,11 +1,4 @@
#! /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
#!/usr/bin/env perl
# Ascetic x86_64 AT&T to MASM/NASM assembler translator by <appro>.
#
@@ -65,9 +58,6 @@
# 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; }
@@ -90,7 +80,7 @@ my $nasm=0;
if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1;
$prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`;
$prefix =~ s|\R$||; # Better chomp
chomp($prefix);
}
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\$"; }
@@ -112,15 +102,14 @@ my %globals;
{ package opcode; # pick up opcodes
sub re {
my ($class, $line) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance in enough...
local *line = shift;
undef $ret;
if ($$line =~ /^([a-z][a-z0-9]*)/i) {
bless $self,$class;
if ($line =~ /^([a-z][a-z0-9]*)/i) {
$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)x?([bw]).*/) { # movz is pain...
@@ -132,7 +121,7 @@ my %globals;
$self->{sz} = "";
} elsif ($self->{op} =~ /^v/) { # VEX
$self->{sz} = "";
} elsif ($self->{op} =~ /mov[dq]/ && $$line =~ /%xmm/) {
} elsif ($self->{op} =~ /mov[dq]/ && $line =~ /%xmm/) {
$self->{sz} = "";
} elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) {
$self->{op} = $1;
@@ -142,7 +131,8 @@ my %globals;
$ret;
}
sub size {
my ($self, $sz) = @_;
my $self = shift;
my $sz = shift;
$self->{sz} = $sz if (defined($sz) && !defined($self->{sz}));
$self->{sz};
}
@@ -170,8 +160,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/) {
@@ -183,22 +173,22 @@ my %globals;
}
}
sub mnemonic {
my ($self, $op) = @_;
my $self=shift;
my $op=shift;
$self->{op}=$op if (defined($op));
$self->{op};
}
}
{ package const; # pick up constants, which start with $
sub re {
my ($class, $line) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance in enough...
local *line = shift;
undef $ret;
if ($$line =~ /^\$([^,]+)/) {
bless $self, $class;
if ($line =~ /^\$([^,]+)/) {
$self->{value} = $1;
$ret = $self;
$$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
$line = substr($line,@+[0]); $line =~ s/^\s+//;
}
$ret;
}
@@ -210,47 +200,46 @@ 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/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
if ($value =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg) {
$self->{value} = $value;
}
sprintf "\$%s",$self->{value};
} else {
$self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm);
sprintf "%s",$self->{value};
my $value = $self->{value};
$value =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm);
sprintf "%s",$value;
}
}
}
{ package ea; # pick up effective addresses: expr(%reg,%reg,scale)
sub re {
my ($class, $line, $opcode) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance in enough...
local *line = shift;
undef $ret;
# optional * ----vvv--- appears in indirect jmp/call
if ($$line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) {
bless $self, $class;
# optional * ---vvv--- appears in indirect jmp/call
if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) {
$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, $sz) = @_;
my $self = shift;
my $sz = shift;
$self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
$self->{label} =~ s/\.L/$decor/g;
@@ -292,7 +281,7 @@ my %globals;
sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base};
}
} else {
my %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR",
%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" );
@@ -301,12 +290,11 @@ my %globals;
$self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig;
$self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/);
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");
($self->{asterisk}) && ($sz="q") ||
(opcode->mnemonic() =~ /^v?mov([qd])$/) && ($sz=$1) ||
(opcode->mnemonic() =~ /^v?pinsr([qdwb])$/) && ($sz=$1) ||
(opcode->mnemonic() =~ /^vpbroadcast([qdwb])$/) && ($sz=$1) ||
(opcode->mnemonic() =~ /^vinsert[fi]128$/) && ($sz="x");
if (defined($self->{index})) {
sprintf "%s[%s%s*%d%s]",$szmap{$sz},
@@ -325,24 +313,24 @@ my %globals;
}
{ package register; # pick up registers, which start with %.
sub re {
my ($class, $line, $opcode) = @_;
my $class = shift; # muliple instances...
my $self = {};
my $ret;
local *line = shift;
undef $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;
my $ret;
undef $ret;
if ($self->{value} =~ /^r[\d]+b$/i) { $ret="b"; }
elsif ($self->{value} =~ /^r[\d]+w$/i) { $ret="w"; }
@@ -363,15 +351,14 @@ my %globals;
}
{ package label; # pick up labels, which end with :
sub re {
my ($class, $line) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance is enough...
local *line = shift;
undef $ret;
if ($$line =~ /(^[\.\w]+)\:/) {
bless $self,$class;
if ($line =~ /(^[\.\w]+)\:/) {
$self->{value} = $1;
$ret = $self;
$$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
$line = substr($line,@+[0]); $line =~ s/^\s+//;
$self->{value} =~ s/^\.L/$decor/;
}
@@ -401,15 +388,14 @@ my %globals;
}
$func;
} elsif ($self->{value} ne "$current_function->{name}") {
# Make all labels in masm global.
$self->{value} .= ":" if ($masm);
$self->{value} .= ":" if ($masm && $ret!~m/^\$/);
$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 .= "${decor}SEH_begin_$current_function->{name}:";
$func .= ":" if ($masm);
@@ -420,8 +406,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}".
@@ -429,28 +415,26 @@ my %globals;
}
}
}
{ package expr; # pick up expressioins
{ package expr; # pick up expressions
sub re {
my ($class, $line, $opcode) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance is enough...
local *line = shift;
undef $ret;
if ($$line =~ /(^[^,]+)/) {
bless $self,$class;
if ($line =~ /(^[^,]+)/) {
$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/$decor/g;
$self->{opcode} = $opcode;
}
$ret;
}
sub out {
my $self = shift;
if ($nasm && $self->{opcode}->mnemonic()=~m/^j(?![re]cxz)/) {
if ($nasm && opcode->mnemonic()=~m/^j(?![re]cxz)/) {
"NEAR ".$self->{value};
} else {
$self->{value};
@@ -459,9 +443,9 @@ my %globals;
}
{ package directive; # pick up directives, which start with .
sub re {
my ($class, $line) = @_;
my $self = {};
my $ret;
my $self = shift; # single instance is enough...
local *line = shift;
undef $ret;
my $dir;
my %opcode = # lea 2f-1f(%rip),%dst; 1: nop; 2:
( "%rax"=>0x01058d48, "%rcx"=>0x010d8d48,
@@ -473,26 +457,25 @@ my %globals;
"%r12"=>0x01258d4c, "%r13"=>0x012d8d4c,
"%r14"=>0x01358d4c, "%r15"=>0x013d8d4c );
if ($$line =~ /^\s*(\.\w+)/) {
bless $self,$class;
if ($line =~ /^\s*(\.\w+)/) {
$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 { my ($sym,$type,$narg) = split(',',$$line);
/\.type/ && do { ($sym,$type,$narg) = split(',',$line);
if ($type eq "\@function") {
undef $current_function;
$current_function->{name} = $sym;
@@ -504,25 +487,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;
&& 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
@@ -531,7 +514,7 @@ 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)) {
@@ -540,9 +523,9 @@ my %globals;
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"; }
@@ -550,13 +533,13 @@ my %globals;
} elsif ($dir =~ /\.(text|data)/) {
$current_segment=".$1";
} elsif ($dir =~ /\.hidden/) {
if ($flavour eq "macosx") { $self->{value} = ".private_extern\t$prefix$$line"; }
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} = "$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;
}
@@ -587,38 +570,38 @@ 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) {
} 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) {
} 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)) {
@@ -632,13 +615,10 @@ my %globals;
}
last;
};
/\.align/ && do { my $max = ($masm && $masm>=$masmref) ? 256 : 4096;
$self->{value} = "ALIGN\t".($$line>$max?$max:$$line);
last;
};
/\.align/ && do { $self->{value} = "ALIGN\t".$line; last; };
/\.(value|long|rva|quad)/
&& do { my $sz = substr($1,0,1);
my @arr = split(/,\s*/,$$line);
my @arr = split(/,\s*/,$line);
my $last = pop(@arr);
my $conv = sub { my $var=shift;
$var=~s/^(0b[0-1]+)/oct($1)/eig;
@@ -654,7 +634,7 @@ my %globals;
$self->{value} .= &$conv($last);
last;
};
/\.byte/ && do { my @str=split(/,\s*/,$$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) {
@@ -666,7 +646,7 @@ my %globals;
.join(",",@str) if (@str);
last;
};
/\.comm/ && do { my @str=split(/,\s*/,$$line);
/\.comm/ && do { my @str=split(/,\s*/,$line);
my $v=undef;
if ($nasm) {
$v.="common $prefix@str[0] @str[1]";
@@ -680,7 +660,7 @@ my %globals;
last;
};
}
$$line = "";
$line = "";
}
$ret;
@@ -692,21 +672,15 @@ my %globals;
}
sub rex {
my $opcode=shift;
local *opcode=shift;
my ($dst,$src,$rex)=@_;
$rex|=0x04 if($dst>=8);
$rex|=0x01 if($src>=8);
push @$opcode,($rex|0x40) if ($rex);
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...
# 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 );
@@ -735,9 +709,9 @@ my $movq = sub { # elderly gas can't handle inter-register movq
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;
$imm=$1;
$src=$2;
$dst=$3;
if ($dst =~ /%r([0-9]+)d/) { $dst = $1; }
elsif ($dst =~ /%e/) { $dst = $regrm{$dst}; }
rex(\@opcode,$src,$dst);
@@ -753,9 +727,9 @@ my $pextrd = sub {
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;
$imm=$1;
$src=$2;
$dst=$3;
if ($src =~ /%r([0-9]+)/) { $src = $1; }
elsif ($src =~ /%e/) { $src = $regrm{$src}; }
rex(\@opcode,$dst,$src);
@@ -812,7 +786,7 @@ my $rdrand = sub {
my @opcode=();
my $dst=$1;
if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
rex(\@opcode,0,$dst,8);
rex(\@opcode,0,$1,8);
push @opcode,0x0f,0xc7,0xf0|($dst&7);
@opcode;
} else {
@@ -825,7 +799,7 @@ my $rdseed = sub {
my @opcode=();
my $dst=$1;
if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
rex(\@opcode,0,$dst,8);
rex(\@opcode,0,$1,8);
push @opcode,0x0f,0xc7,0xf8|($dst&7);
@opcode;
} else {
@@ -834,14 +808,14 @@ my $rdseed = sub {
};
sub rxb {
my $opcode=shift;
local *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;
push @opcode,$rxb;
}
my $vprotd = sub {
@@ -872,10 +846,6 @@ my $vprotq = sub {
}
};
my $endbranch = sub {
(0xf3,0x0f,0x1e,0xfa);
};
if ($nasm) {
print <<___;
default rel
@@ -888,47 +858,51 @@ ___
OPTION DOTNAME
___
}
while(defined(my $line=<>)) {
while($line=<>) {
$line =~ s|\R$||; # Better chomp
chomp($line);
$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
if (my $label=label->re(\$line)) { print $label->out(); }
undef $label;
undef $opcode;
undef @args;
if (my $directive=directive->re(\$line)) {
printf "%s",$directive->out();
} elsif (my $opcode=opcode->re(\$line)) {
if ($label=label->re(\$line)) { print $label->out(); }
if (directive->re(\$line)) {
printf "%s",directive->out();
} elsif ($opcode=opcode->re(\$line)) {
my $asm = eval("\$".$opcode->mnemonic());
undef @bytes;
if ((ref($asm) eq 'CODE') && scalar(my @bytes=&$asm($line))) {
if ((ref($asm) eq 'CODE') && scalar(@bytes=&$asm($line))) {
print $gas?".byte\t":"DB\t",join(',',@bytes),"\n";
next;
}
my @args;
ARGUMENT: while (1) {
my $arg;
my $arg;
($arg=register->re(\$line, $opcode))||
($arg=const->re(\$line)) ||
($arg=ea->re(\$line, $opcode)) ||
($arg=expr->re(\$line, $opcode)) ||
last ARGUMENT;
if ($arg=register->re(\$line)) { opcode->size($arg->size()); }
elsif ($arg=const->re(\$line)) { }
elsif ($arg=ea->re(\$line)) { }
elsif ($arg=expr->re(\$line)) { }
else { 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) {
my $insn;
my $sz=$opcode->size();
my $sz=opcode->size();
if ($gas) {
$insn = $opcode->out($#args>=1?$args[$#args]->size():$sz);
@@ -987,7 +961,7 @@ close STDOUT;
# (#) Nth argument, volatile
#
# In Unix terms top of stack is argument transfer area for arguments
# which could not be accommodated in registers. Or in other words 7th
# which could not be accomodated 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
@@ -1004,7 +978,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.
#
@@ -1151,7 +1125,7 @@ close STDOUT;
# .rva .LSEH_end_function
# .rva function_unwind_info
#
# Reference to function_unwind_info from .xdata segment is the anchor.
# Reference to functon_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.

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 1995-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
#!/usr/bin/env perl
# require 'x86asm.pl';
# &asm_init(<flavor>,"des-586.pl"[,$i386only]);
@@ -172,11 +165,6 @@ sub ::vprotd
{ &::generic("vprotd",@_); }
}
sub ::endbranch
{
&::data_byte(0xf3,0x0f,0x1e,0xfb);
}
# label management
$lbdecor="L"; # local label decoration, set by package
$label="000";

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 2007-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
#!/usr/bin/env perl
package x86gas;
@@ -24,7 +17,7 @@ sub opsize()
{ my $reg=shift;
if ($reg =~ m/^%e/o) { "l"; }
elsif ($reg =~ m/^%[a-d][hl]$/o) { "b"; }
elsif ($reg =~ m/^%[yxm]/o) { undef; }
elsif ($reg =~ m/^%[xm]/o) { undef; }
else { "w"; }
}

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 2007-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
#!/usr/bin/env perl
package x86masm;
@@ -25,10 +18,10 @@ sub ::generic
if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no []
{ $opcode="mov"; }
elsif ($opcode !~ /mov[dq]$/)
elsif ($opcode !~ /movq/)
{ # fix xmm references
$arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[-1]=~/\bxmm[0-7]\b/i);
$arg[-1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i);
$arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[1]=~/\bxmm[0-7]\b/i);
$arg[1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i);
}
&::emit($opcode,@arg);
@@ -89,7 +82,7 @@ TITLE $_[0].asm
IF \@Version LT 800
ECHO MASM version 8.00 or later is strongly recommended.
ENDIF
.686
.486
.MODEL FLAT
OPTION DOTNAME
IF \@Version LT 800
@@ -167,13 +160,13 @@ sub ::public_label
{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
sub ::data_byte
{ push(@out,("DB\t").join(',',splice(@_,0,16))."\n") while(@_); }
{ push(@out,("DB\t").join(',',@_)."\n"); }
sub ::data_short
{ push(@out,("DW\t").join(',',splice(@_,0,8))."\n") while(@_); }
{ push(@out,("DW\t").join(',',@_)."\n"); }
sub ::data_word
{ push(@out,("DD\t").join(',',splice(@_,0,4))."\n") while(@_); }
{ push(@out,("DD\t").join(',',@_)."\n"); }
sub ::align
{ push(@out,"ALIGN\t$_[0]\n"); }

View File

@@ -1,11 +1,4 @@
#! /usr/bin/env perl
# Copyright 1999-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
#!/usr/bin/env perl
package x86nasm;