1
0
Fork 0
mirror of https://github.com/ossrs/srs.git synced 2025-03-09 15:49:59 +00:00

Upgrade openssl from 1.1.0e to 1.1.1b, with source code. 4.0.78

This commit is contained in:
winlin 2021-03-01 20:47:57 +08:00
parent 8f1c992379
commit 96dbd7bced
1476 changed files with 616554 additions and 4 deletions

View file

@ -0,0 +1,124 @@
The perl scripts in this directory are my 'hack' to generate
multiple different assembler formats via the one original script.
The way to use this library is to start with adding the path to this directory
and then include it.
push(@INC,"perlasm","../../perlasm");
require "x86asm.pl";
The first thing we do is setup the file and type of assembler
&asm_init($ARGV[0]);
The first argument is the 'type'. Currently
'cpp', 'sol', 'a.out', 'elf' or 'win32'.
Argument 2 is the file name.
The reciprocal function is
&asm_finish() which should be called at the end.
There are 2 main 'packages'. x86ms.pl, which is the Microsoft assembler,
and x86unix.pl which is the unix (gas) version.
Functions of interest are:
&external_label("des_SPtrans"); declare and external variable
&LB(reg); Low byte for a register
&HB(reg); High byte for a register
&BP(off,base,index,scale) Byte pointer addressing
&DWP(off,base,index,scale) Word pointer addressing
&stack_push(num) Basically a 'sub esp, num*4' with extra
&stack_pop(num) inverse of stack_push
&function_begin(name,extra) Start a function with pushing of
edi, esi, ebx and ebp. extra is extra win32
external info that may be required.
&function_begin_B(name,extra) Same as normal function_begin but no pushing.
&function_end(name) Call at end of function.
&function_end_A(name) Standard pop and ret, for use inside functions
&function_end_B(name) Call at end but with poping or 'ret'.
&swtmp(num) Address on stack temp word.
&wparam(num) Parameter number num, that was push
in C convention. This all works over pushes
and pops.
&comment("hello there") Put in a comment.
&label("loop") Refer to a label, normally a jmp target.
&set_label("loop") Set a label at this point.
&data_word(word) Put in a word of data.
So how does this all hold together? Given
int calc(int len, int *data)
{
int i,j=0;
for (i=0; i<len; i++)
{
j+=other(data[i]);
}
}
So a very simple version of this function could be coded as
push(@INC,"perlasm","../../perlasm");
require "x86asm.pl";
&asm_init($ARGV[0]);
&external_label("other");
$tmp1= "eax";
$j= "edi";
$data= "esi";
$i= "ebp";
&comment("a simple function");
&function_begin("calc");
&mov( $data, &wparam(1)); # data
&xor( $j, $j);
&xor( $i, $i);
&set_label("loop");
&cmp( $i, &wparam(0));
&jge( &label("end"));
&mov( $tmp1, &DWP(0,$data,$i,4));
&push( $tmp1);
&call( "other");
&add( $j, "eax");
&pop( $tmp1);
&inc( $i);
&jmp( &label("loop"));
&set_label("end");
&mov( "eax", $j);
&function_end("calc");
&asm_finish();
The above example is very very unoptimised but gives an idea of how
things work.
There is also a cbc mode function generator in cbc.pl
&cbc( $name,
$encrypt_function_name,
$decrypt_function_name,
$true_if_byte_swap_needed,
$parameter_number_for_iv,
$parameter_number_for_encrypt_flag,
$first_parameter_to_pass,
$second_parameter_to_pass,
$third_parameter_to_pass);
So for example, given
void BF_encrypt(BF_LONG *data,BF_KEY *key);
void BF_decrypt(BF_LONG *data,BF_KEY *key);
void BF_cbc_encrypt(unsigned char *in, unsigned char *out, long length,
BF_KEY *ks, unsigned char *iv, int enc);
&cbc("BF_cbc_encrypt","BF_encrypt","BF_encrypt",1,4,5,3,-1,-1);
&cbc("des_ncbc_encrypt","des_encrypt","des_encrypt",0,4,5,3,5,-1);
&cbc("des_ede3_cbc_encrypt","des_encrypt3","des_decrypt3",0,6,7,3,4,5);

View file

@ -0,0 +1,177 @@
#! /usr/bin/env perl
# Copyright 2015-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
use strict;
my $flavour = shift;
my $output = shift;
open STDOUT,">$output" || die "can't open $output: $!";
$flavour = "linux32" if (!$flavour or $flavour eq "void");
my %GLOBALS;
my $dotinlocallabels=($flavour=~/linux/)?1:0;
################################################################
# directives which need special treatment on different platforms
################################################################
my $arch = sub {
if ($flavour =~ /linux/) { ".arch\t".join(',',@_); }
else { ""; }
};
my $fpu = sub {
if ($flavour =~ /linux/) { ".fpu\t".join(',',@_); }
else { ""; }
};
my $hidden = sub {
if ($flavour =~ /ios/) { ".private_extern\t".join(',',@_); }
else { ".hidden\t".join(',',@_); }
};
my $comm = sub {
my @args = split(/,\s*/,shift);
my $name = @args[0];
my $global = \$GLOBALS{$name};
my $ret;
if ($flavour =~ /ios32/) {
$ret = ".comm\t_$name,@args[1]\n";
$ret .= ".non_lazy_symbol_pointer\n";
$ret .= "$name:\n";
$ret .= ".indirect_symbol\t_$name\n";
$ret .= ".long\t0";
$name = "_$name";
} else { $ret = ".comm\t".join(',',@args); }
$$global = $name;
$ret;
};
my $globl = sub {
my $name = shift;
my $global = \$GLOBALS{$name};
my $ret;
SWITCH: for ($flavour) {
/ios/ && do { $name = "_$name";
last;
};
}
$ret = ".globl $name" if (!$ret);
$$global = $name;
$ret;
};
my $global = $globl;
my $extern = sub {
&$globl(@_);
return; # return nothing
};
my $type = sub {
if ($flavour =~ /linux/) { ".type\t".join(',',@_); }
elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
"#ifdef __thumb2__\n".
".thumb_func $1\n".
"#endif";
}
}
else { ""; }
};
my $size = sub {
if ($flavour =~ /linux/) { ".size\t".join(',',@_); }
else { ""; }
};
my $inst = sub {
if ($flavour =~ /linux/) { ".inst\t".join(',',@_); }
else { ".long\t".join(',',@_); }
};
my $asciz = sub {
my $line = join(",",@_);
if ($line =~ /^"(.*)"$/)
{ ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; }
else
{ ""; }
};
sub range {
my ($r,$sfx,$start,$end) = @_;
join(",",map("$r$_$sfx",($start..$end)));
}
sub expand_line {
my $line = shift;
my @ret = ();
pos($line)=0;
while ($line =~ m/\G[^@\/\{\"]*/g) {
if ($line =~ m/\G(@|\/\/|$)/gc) {
last;
}
elsif ($line =~ m/\G\{/gc) {
my $saved_pos = pos($line);
$line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
pos($line) = $saved_pos;
$line =~ m/\G[^\}]*\}/g;
}
elsif ($line =~ m/\G\"/gc) {
$line =~ m/\G[^\"]*\"/g;
}
}
$line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
return $line;
}
while(my $line=<>) {
if ($line =~ m/^\s*(#|@|\/\/)/) { print $line; next; }
$line =~ s|/\*.*\*/||; # get rid of C-style comments...
$line =~ s|^\s+||; # ... and skip white spaces in beginning...
$line =~ s|\s+$||; # ... and at the end
{
$line =~ s|[\b\.]L(\w{2,})|L$1|g; # common denominator for Locallabel
$line =~ s|\bL(\w{2,})|\.L$1|g if ($dotinlocallabels);
}
{
$line =~ s|(^[\.\w]+)\:\s*||;
my $label = $1;
if ($label) {
printf "%s:",($GLOBALS{$label} or $label);
}
}
if ($line !~ m/^[#@]/) {
$line =~ s|^\s*(\.?)(\S+)\s*||;
my $c = $1; $c = "\t" if ($c eq "");
my $mnemonic = $2;
my $opcode;
if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
$opcode = eval("\$$1_$2");
} else {
$opcode = eval("\$$mnemonic");
}
my $arg=expand_line($line);
if (ref($opcode) eq 'CODE') {
$line = &$opcode($arg);
} elsif ($mnemonic) {
$line = $c.$mnemonic;
$line.= "\t$arg" if ($arg ne "");
}
}
print $line if ($line);
print "\n";
}
close STDOUT;

View file

@ -0,0 +1,356 @@
#! /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
# void des_ncbc_encrypt(input, output, length, schedule, ivec, enc)
# des_cblock (*input);
# des_cblock (*output);
# long length;
# des_key_schedule schedule;
# des_cblock (*ivec);
# int enc;
#
# calls
# des_encrypt((DES_LONG *)tin,schedule,DES_ENCRYPT);
#
#&cbc("des_ncbc_encrypt","des_encrypt",0);
#&cbc("BF_cbc_encrypt","BF_encrypt","BF_encrypt",
# 1,4,5,3,5,-1);
#&cbc("des_ncbc_encrypt","des_encrypt","des_encrypt",
# 0,4,5,3,5,-1);
#&cbc("des_ede3_cbc_encrypt","des_encrypt3","des_decrypt3",
# 0,6,7,3,4,5);
#
# When doing a cipher that needs bigendian order,
# for encrypt, the iv is kept in bigendian form,
# while for decrypt, it is kept in little endian.
sub cbc
{
local($name,$enc_func,$dec_func,$swap,$iv_off,$enc_off,$p1,$p2,$p3)=@_;
# name is the function name
# enc_func and dec_func and the functions to call for encrypt/decrypt
# swap is true if byte order needs to be reversed
# iv_off is parameter number for the iv
# enc_off is parameter number for the encrypt/decrypt flag
# p1,p2,p3 are the offsets for parameters to be passed to the
# underlying calls.
&function_begin_B($name,"");
&comment("");
$in="esi";
$out="edi";
$count="ebp";
&push("ebp");
&push("ebx");
&push("esi");
&push("edi");
$data_off=4;
$data_off+=4 if ($p1 > 0);
$data_off+=4 if ($p2 > 0);
$data_off+=4 if ($p3 > 0);
&mov($count, &wparam(2)); # length
&comment("getting iv ptr from parameter $iv_off");
&mov("ebx", &wparam($iv_off)); # Get iv ptr
&mov($in, &DWP(0,"ebx","",0));# iv[0]
&mov($out, &DWP(4,"ebx","",0));# iv[1]
&push($out);
&push($in);
&push($out); # used in decrypt for iv[1]
&push($in); # used in decrypt for iv[0]
&mov("ebx", "esp"); # This is the address of tin[2]
&mov($in, &wparam(0)); # in
&mov($out, &wparam(1)); # out
# We have loaded them all, how lets push things
&comment("getting encrypt flag from parameter $enc_off");
&mov("ecx", &wparam($enc_off)); # Get enc flag
if ($p3 > 0)
{
&comment("get and push parameter $p3");
if ($enc_off != $p3)
{ &mov("eax", &wparam($p3)); &push("eax"); }
else { &push("ecx"); }
}
if ($p2 > 0)
{
&comment("get and push parameter $p2");
if ($enc_off != $p2)
{ &mov("eax", &wparam($p2)); &push("eax"); }
else { &push("ecx"); }
}
if ($p1 > 0)
{
&comment("get and push parameter $p1");
if ($enc_off != $p1)
{ &mov("eax", &wparam($p1)); &push("eax"); }
else { &push("ecx"); }
}
&push("ebx"); # push data/iv
&cmp("ecx",0);
&jz(&label("decrypt"));
&and($count,0xfffffff8);
&mov("eax", &DWP($data_off,"esp","",0)); # load iv[0]
&mov("ebx", &DWP($data_off+4,"esp","",0)); # load iv[1]
&jz(&label("encrypt_finish"));
#############################################################
&set_label("encrypt_loop");
# encrypt start
# "eax" and "ebx" hold iv (or the last cipher text)
&mov("ecx", &DWP(0,$in,"",0)); # load first 4 bytes
&mov("edx", &DWP(4,$in,"",0)); # second 4 bytes
&xor("eax", "ecx");
&xor("ebx", "edx");
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP($data_off,"esp","",0), "eax"); # put in array for call
&mov(&DWP($data_off+4,"esp","",0), "ebx"); #
&call($enc_func);
&mov("eax", &DWP($data_off,"esp","",0));
&mov("ebx", &DWP($data_off+4,"esp","",0));
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP(0,$out,"",0),"eax");
&mov(&DWP(4,$out,"",0),"ebx");
# eax and ebx are the next iv.
&add($in, 8);
&add($out, 8);
&sub($count, 8);
&jnz(&label("encrypt_loop"));
###################################################################3
&set_label("encrypt_finish");
&mov($count, &wparam(2)); # length
&and($count, 7);
&jz(&label("finish"));
&call(&label("PIC_point"));
&set_label("PIC_point");
&blindpop("edx");
&lea("ecx",&DWP(&label("cbc_enc_jmp_table")."-".&label("PIC_point"),"edx"));
&mov($count,&DWP(0,"ecx",$count,4));
&add($count,"edx");
&xor("ecx","ecx");
&xor("edx","edx");
#&mov($count,&DWP(&label("cbc_enc_jmp_table"),"",$count,4));
&jmp_ptr($count);
&set_label("ej7");
&movb(&HB("edx"), &BP(6,$in,"",0));
&shl("edx",8);
&set_label("ej6");
&movb(&HB("edx"), &BP(5,$in,"",0));
&set_label("ej5");
&movb(&LB("edx"), &BP(4,$in,"",0));
&set_label("ej4");
&mov("ecx", &DWP(0,$in,"",0));
&jmp(&label("ejend"));
&set_label("ej3");
&movb(&HB("ecx"), &BP(2,$in,"",0));
&shl("ecx",8);
&set_label("ej2");
&movb(&HB("ecx"), &BP(1,$in,"",0));
&set_label("ej1");
&movb(&LB("ecx"), &BP(0,$in,"",0));
&set_label("ejend");
&xor("eax", "ecx");
&xor("ebx", "edx");
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP($data_off,"esp","",0), "eax"); # put in array for call
&mov(&DWP($data_off+4,"esp","",0), "ebx"); #
&call($enc_func);
&mov("eax", &DWP($data_off,"esp","",0));
&mov("ebx", &DWP($data_off+4,"esp","",0));
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP(0,$out,"",0),"eax");
&mov(&DWP(4,$out,"",0),"ebx");
&jmp(&label("finish"));
#############################################################
#############################################################
&set_label("decrypt",1);
# decrypt start
&and($count,0xfffffff8);
# The next 2 instructions are only for if the jz is taken
&mov("eax", &DWP($data_off+8,"esp","",0)); # get iv[0]
&mov("ebx", &DWP($data_off+12,"esp","",0)); # get iv[1]
&jz(&label("decrypt_finish"));
&set_label("decrypt_loop");
&mov("eax", &DWP(0,$in,"",0)); # load first 4 bytes
&mov("ebx", &DWP(4,$in,"",0)); # second 4 bytes
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP($data_off,"esp","",0), "eax"); # put back
&mov(&DWP($data_off+4,"esp","",0), "ebx"); #
&call($dec_func);
&mov("eax", &DWP($data_off,"esp","",0)); # get return
&mov("ebx", &DWP($data_off+4,"esp","",0)); #
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov("ecx", &DWP($data_off+8,"esp","",0)); # get iv[0]
&mov("edx", &DWP($data_off+12,"esp","",0)); # get iv[1]
&xor("ecx", "eax");
&xor("edx", "ebx");
&mov("eax", &DWP(0,$in,"",0)); # get old cipher text,
&mov("ebx", &DWP(4,$in,"",0)); # next iv actually
&mov(&DWP(0,$out,"",0),"ecx");
&mov(&DWP(4,$out,"",0),"edx");
&mov(&DWP($data_off+8,"esp","",0), "eax"); # save iv
&mov(&DWP($data_off+12,"esp","",0), "ebx"); #
&add($in, 8);
&add($out, 8);
&sub($count, 8);
&jnz(&label("decrypt_loop"));
############################ ENDIT #######################3
&set_label("decrypt_finish");
&mov($count, &wparam(2)); # length
&and($count, 7);
&jz(&label("finish"));
&mov("eax", &DWP(0,$in,"",0)); # load first 4 bytes
&mov("ebx", &DWP(4,$in,"",0)); # second 4 bytes
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov(&DWP($data_off,"esp","",0), "eax"); # put back
&mov(&DWP($data_off+4,"esp","",0), "ebx"); #
&call($dec_func);
&mov("eax", &DWP($data_off,"esp","",0)); # get return
&mov("ebx", &DWP($data_off+4,"esp","",0)); #
&bswap("eax") if $swap;
&bswap("ebx") if $swap;
&mov("ecx", &DWP($data_off+8,"esp","",0)); # get iv[0]
&mov("edx", &DWP($data_off+12,"esp","",0)); # get iv[1]
&xor("ecx", "eax");
&xor("edx", "ebx");
# this is for when we exit
&mov("eax", &DWP(0,$in,"",0)); # get old cipher text,
&mov("ebx", &DWP(4,$in,"",0)); # next iv actually
&set_label("dj7");
&rotr("edx", 16);
&movb(&BP(6,$out,"",0), &LB("edx"));
&shr("edx",16);
&set_label("dj6");
&movb(&BP(5,$out,"",0), &HB("edx"));
&set_label("dj5");
&movb(&BP(4,$out,"",0), &LB("edx"));
&set_label("dj4");
&mov(&DWP(0,$out,"",0), "ecx");
&jmp(&label("djend"));
&set_label("dj3");
&rotr("ecx", 16);
&movb(&BP(2,$out,"",0), &LB("ecx"));
&shl("ecx",16);
&set_label("dj2");
&movb(&BP(1,$in,"",0), &HB("ecx"));
&set_label("dj1");
&movb(&BP(0,$in,"",0), &LB("ecx"));
&set_label("djend");
# final iv is still in eax:ebx
&jmp(&label("finish"));
############################ FINISH #######################3
&set_label("finish",1);
&mov("ecx", &wparam($iv_off)); # Get iv ptr
#################################################
$total=16+4;
$total+=4 if ($p1 > 0);
$total+=4 if ($p2 > 0);
$total+=4 if ($p3 > 0);
&add("esp",$total);
&mov(&DWP(0,"ecx","",0), "eax"); # save iv
&mov(&DWP(4,"ecx","",0), "ebx"); # save iv
&function_end_A($name);
&align(64);
&set_label("cbc_enc_jmp_table");
&data_word("0");
&data_word(&label("ej1")."-".&label("PIC_point"));
&data_word(&label("ej2")."-".&label("PIC_point"));
&data_word(&label("ej3")."-".&label("PIC_point"));
&data_word(&label("ej4")."-".&label("PIC_point"));
&data_word(&label("ej5")."-".&label("PIC_point"));
&data_word(&label("ej6")."-".&label("PIC_point"));
&data_word(&label("ej7")."-".&label("PIC_point"));
# not used
#&set_label("cbc_dec_jmp_table",1);
#&data_word("0");
#&data_word(&label("dj1")."-".&label("PIC_point"));
#&data_word(&label("dj2")."-".&label("PIC_point"));
#&data_word(&label("dj3")."-".&label("PIC_point"));
#&data_word(&label("dj4")."-".&label("PIC_point"));
#&data_word(&label("dj5")."-".&label("PIC_point"));
#&data_word(&label("dj6")."-".&label("PIC_point"));
#&data_word(&label("dj7")."-".&label("PIC_point"));
&align(64);
&function_end_B($name);
}
1;

View file

@ -0,0 +1,344 @@
#! /usr/bin/env perl
# Copyright 2006-2018 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
my $flavour = shift;
my $output = shift;
open STDOUT,">$output" || die "can't open $output: $!";
my %GLOBALS;
my %TYPES;
my $dotinlocallabels=($flavour=~/linux/)?1:0;
################################################################
# directives which need special treatment on different platforms
################################################################
my $type = sub {
my ($dir,$name,$type) = @_;
$TYPES{$name} = $type;
if ($flavour =~ /linux/) {
$name =~ s|^\.||;
".type $name,$type";
} else {
"";
}
};
my $globl = sub {
my $junk = shift;
my $name = shift;
my $global = \$GLOBALS{$name};
my $type = \$TYPES{$name};
my $ret;
$name =~ s|^\.||;
SWITCH: for ($flavour) {
/aix/ && do { if (!$$type) {
$$type = "\@function";
}
if ($$type =~ /function/) {
$name = ".$name";
}
last;
};
/osx/ && do { $name = "_$name";
last;
};
/linux.*(32|64le)/
&& do { $ret .= ".globl $name";
if (!$$type) {
$ret .= "\n.type $name,\@function";
$$type = "\@function";
}
last;
};
/linux.*64/ && do { $ret .= ".globl $name";
if (!$$type) {
$ret .= "\n.type $name,\@function";
$$type = "\@function";
}
if ($$type =~ /function/) {
$ret .= "\n.section \".opd\",\"aw\"";
$ret .= "\n.align 3";
$ret .= "\n$name:";
$ret .= "\n.quad .$name,.TOC.\@tocbase,0";
$ret .= "\n.previous";
$name = ".$name";
}
last;
};
}
$ret = ".globl $name" if (!$ret);
$$global = $name;
$ret;
};
my $text = sub {
my $ret = ($flavour =~ /aix/) ? ".csect\t.text[PR],7" : ".text";
$ret = ".abiversion 2\n".$ret if ($flavour =~ /linux.*64le/);
$ret;
};
my $machine = sub {
my $junk = shift;
my $arch = shift;
if ($flavour =~ /osx/)
{ $arch =~ s/\"//g;
$arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any");
}
".machine $arch";
};
my $size = sub {
if ($flavour =~ /linux/)
{ shift;
my $name = shift;
my $real = $GLOBALS{$name} ? \$GLOBALS{$name} : \$name;
my $ret = ".size $$real,.-$$real";
$name =~ s|^\.||;
if ($$real ne $name) {
$ret .= "\n.size $name,.-$$real";
}
$ret;
}
else
{ ""; }
};
my $asciz = sub {
shift;
my $line = join(",",@_);
if ($line =~ /^"(.*)"$/)
{ ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; }
else
{ ""; }
};
my $quad = sub {
shift;
my @ret;
my ($hi,$lo);
for (@_) {
if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io)
{ $hi=$1?"0x$1":"0"; $lo="0x$2"; }
elsif (/^([0-9]+)$/o)
{ $hi=$1>>32; $lo=$1&0xffffffff; } # error-prone with 32-bit perl
else
{ $hi=undef; $lo=$_; }
if (defined($hi))
{ push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo"); }
else
{ push(@ret,".quad $lo"); }
}
join("\n",@ret);
};
################################################################
# simplified mnemonics not handled by at least one assembler
################################################################
my $cmplw = sub {
my $f = shift;
my $cr = 0; $cr = shift if ($#_>1);
# Some out-of-date 32-bit GNU assembler just can't handle cmplw...
($flavour =~ /linux.*32/) ?
" .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 :
" cmplw ".join(',',$cr,@_);
};
my $bdnz = sub {
my $f = shift;
my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint
" bc $bo,0,".shift;
} if ($flavour!~/linux/);
my $bltlr = sub {
my $f = shift;
my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint
($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
" .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 :
" bclr $bo,0";
};
my $bnelr = sub {
my $f = shift;
my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint
($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
" .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 :
" bclr $bo,2";
};
my $beqlr = sub {
my $f = shift;
my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint
($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
" .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 :
" bclr $bo,2";
};
# GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two
# arguments is 64, with "operand out of range" error.
my $extrdi = sub {
my ($f,$ra,$rs,$n,$b) = @_;
$b = ($b+$n)&63; $n = 64-$n;
" rldicl $ra,$rs,$b,$n";
};
my $vmr = sub {
my ($f,$vx,$vy) = @_;
" vor $vx,$vy,$vy";
};
# Some ABIs specify vrsave, special-purpose register #256, as reserved
# for system use.
my $no_vrsave = ($flavour =~ /aix|linux64le/);
my $mtspr = sub {
my ($f,$idx,$ra) = @_;
if ($idx == 256 && $no_vrsave) {
" or $ra,$ra,$ra";
} else {
" mtspr $idx,$ra";
}
};
my $mfspr = sub {
my ($f,$rd,$idx) = @_;
if ($idx == 256 && $no_vrsave) {
" li $rd,-1";
} else {
" mfspr $rd,$idx";
}
};
# PowerISA 2.06 stuff
sub vsxmem_op {
my ($f, $vrt, $ra, $rb, $op) = @_;
" .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|($rb<<11)|($op*2+1);
}
# made-up unaligned memory reference AltiVec/VMX instructions
my $lvx_u = sub { vsxmem_op(@_, 844); }; # lxvd2x
my $stvx_u = sub { vsxmem_op(@_, 972); }; # stxvd2x
my $lvdx_u = sub { vsxmem_op(@_, 588); }; # lxsdx
my $stvdx_u = sub { vsxmem_op(@_, 716); }; # stxsdx
my $lvx_4w = sub { vsxmem_op(@_, 780); }; # lxvw4x
my $stvx_4w = sub { vsxmem_op(@_, 908); }; # stxvw4x
my $lvx_splt = sub { vsxmem_op(@_, 332); }; # lxvdsx
# VSX instruction[s] masqueraded as made-up AltiVec/VMX
my $vpermdi = sub { # xxpermdi
my ($f, $vrt, $vra, $vrb, $dm) = @_;
$dm = oct($dm) if ($dm =~ /^0/);
" .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($dm<<8)|(10<<3)|7;
};
# PowerISA 2.07 stuff
sub vcrypto_op {
my ($f, $vrt, $vra, $vrb, $op) = @_;
" .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op;
}
sub vfour {
my ($f, $vrt, $vra, $vrb, $vrc, $op) = @_;
" .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($vrc<<6)|$op;
};
my $vcipher = sub { vcrypto_op(@_, 1288); };
my $vcipherlast = sub { vcrypto_op(@_, 1289); };
my $vncipher = sub { vcrypto_op(@_, 1352); };
my $vncipherlast= sub { vcrypto_op(@_, 1353); };
my $vsbox = sub { vcrypto_op(@_, 0, 1480); };
my $vshasigmad = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); };
my $vshasigmaw = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); };
my $vpmsumb = sub { vcrypto_op(@_, 1032); };
my $vpmsumd = sub { vcrypto_op(@_, 1224); };
my $vpmsubh = sub { vcrypto_op(@_, 1096); };
my $vpmsumw = sub { vcrypto_op(@_, 1160); };
# These are not really crypto, but vcrypto_op template works
my $vaddudm = sub { vcrypto_op(@_, 192); };
my $vadduqm = sub { vcrypto_op(@_, 256); };
my $vmuleuw = sub { vcrypto_op(@_, 648); };
my $vmulouw = sub { vcrypto_op(@_, 136); };
my $vrld = sub { vcrypto_op(@_, 196); };
my $vsld = sub { vcrypto_op(@_, 1476); };
my $vsrd = sub { vcrypto_op(@_, 1732); };
my $vsubudm = sub { vcrypto_op(@_, 1216); };
my $vaddcuq = sub { vcrypto_op(@_, 320); };
my $vaddeuqm = sub { vfour(@_,60); };
my $vaddecuq = sub { vfour(@_,61); };
my $vmrgew = sub { vfour(@_,0,1932); };
my $vmrgow = sub { vfour(@_,0,1676); };
my $mtsle = sub {
my ($f, $arg) = @_;
" .long ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2);
};
# VSX instructions masqueraded as AltiVec/VMX
my $mtvrd = sub {
my ($f, $vrt, $ra) = @_;
" .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(179<<1)|1;
};
my $mtvrwz = sub {
my ($f, $vrt, $ra) = @_;
" .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(243<<1)|1;
};
# PowerISA 3.0 stuff
my $maddhdu = sub { vfour(@_,49); };
my $maddld = sub { vfour(@_,51); };
my $darn = sub {
my ($f, $rt, $l) = @_;
" .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($l<<16)|(755<<1);
};
my $iseleq = sub {
my ($f, $rt, $ra, $rb) = @_;
" .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|(2<<6)|30;
};
# VSX instruction[s] masqueraded as made-up AltiVec/VMX
my $vspltib = sub { # xxspltib
my ($f, $vrt, $imm8) = @_;
$imm8 = oct($imm8) if ($imm8 =~ /^0/);
$imm8 &= 0xff;
" .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($imm8<<11)|(360<<1)|1;
};
# PowerISA 3.0B stuff
my $addex = sub {
my ($f, $rt, $ra, $rb, $cy) = @_; # only cy==0 is specified in 3.0B
" .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|($cy<<9)|(170<<1);
};
my $vmsumudm = sub { vfour(@_,35); };
while($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
{
$line =~ s|\.L(\w+)|L$1|g; # common denominator for Locallabel
$line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels);
}
{
$line =~ s|(^[\.\w]+)\:\s*||;
my $label = $1;
if ($label) {
my $xlated = ($GLOBALS{$label} or $label);
print "$xlated:";
if ($flavour =~ /linux.*64le/) {
if ($TYPES{$label} =~ /function/) {
printf "\n.localentry %s,0\n",$xlated;
}
}
}
}
{
$line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||;
my $c = $1; $c = "\t" if ($c eq "");
my $mnemonic = $2;
my $f = $3;
my $opcode = eval("\$$mnemonic");
$line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/);
if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(/,\s*/,$line)); }
elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; }
}
print $line if ($line);
print "\n";
}
close STDOUT;

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,303 @@
#! /usr/bin/env perl
# Copyright 1995-2018 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
# require 'x86asm.pl';
# &asm_init(<flavor>[,$i386only]);
# &function_begin("foo");
# ...
# &function_end("foo");
# &asm_finish
$out=();
$i386=0;
# AUTOLOAD is this context has quite unpleasant side effect, namely
# that typos in function calls effectively go to assembler output,
# but on the pros side we don't have to implement one subroutine per
# each opcode...
sub ::AUTOLOAD
{ my $opcode = $AUTOLOAD;
die "more than 4 arguments passed to $opcode" if ($#_>3);
$opcode =~ s/.*:://;
if ($opcode =~ /^push/) { $stack+=4; }
elsif ($opcode =~ /^pop/) { $stack-=4; }
&generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
}
sub ::emit
{ my $opcode=shift;
if ($#_==-1) { push(@out,"\t$opcode\n"); }
else { push(@out,"\t$opcode\t".join(',',@_)."\n"); }
}
sub ::LB
{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
$1."l";
}
sub ::HB
{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
$1."h";
}
sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); }
sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); }
sub ::blindpop { &pop($_[0]); $stack+=4; }
sub ::wparam { &DWP($stack+4*$_[0],"esp"); }
sub ::swtmp { &DWP(4*$_[0],"esp"); }
sub ::bswap
{ if ($i386) # emulate bswap for i386
{ &comment("bswap @_");
&xchg(&HB(@_),&LB(@_));
&ror (@_,16);
&xchg(&HB(@_),&LB(@_));
}
else
{ &generic("bswap",@_); }
}
# These are made-up opcodes introduced over the years essentially
# by ignorance, just alias them to real ones...
sub ::movb { &mov(@_); }
sub ::xorb { &xor(@_); }
sub ::rotl { &rol(@_); }
sub ::rotr { &ror(@_); }
sub ::exch { &xchg(@_); }
sub ::halt { &hlt; }
sub ::movz { &movzx(@_); }
sub ::pushf { &pushfd; }
sub ::popf { &popfd; }
# 3 argument instructions
sub ::movq
{ my($p1,$p2,$optimize)=@_;
if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
# movq between mmx registers can sink Intel CPUs
{ &::pshufw($p1,$p2,0xe4); }
else
{ &::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",@_); }
}
sub ::rdseed
{ my ($dst)=@_;
if ($dst =~ /(e[a-dsd][ixp])/)
{ &::data_byte(0x0f,0xc7,0xf8|$regrm{$dst}); }
else
{ &::generic("rdrand",@_); }
}
sub rxb {
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;
}
sub ::vprotd
{ my $args=join(',',@_);
if ($args =~ /xmm([0-7]),xmm([0-7]),([x0-9a-f]+)/)
{ my @opcode=(0x8f);
rxb(\@opcode,$1,$2,-1,0x08);
push @opcode,0x78,0xc2;
push @opcode,0xc0|($2&7)|(($1&7)<<3); # ModR/M
my $c=$3;
push @opcode,$c=~/^0/?oct($c):$c;
&::data_byte(@opcode);
}
else
{ &::generic("vprotd",@_); }
}
sub ::endbranch
{
&::data_byte(0xf3,0x0f,0x1e,0xfb);
}
# label management
$lbdecor="L"; # local label decoration, set by package
$label="000";
sub ::islabel # see is argument is a known label
{ my $i;
foreach $i (values %label) { return $i if ($i eq $_[0]); }
$label{$_[0]}; # can be undef
}
sub ::label # instantiate a function-scope label
{ if (!defined($label{$_[0]}))
{ $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; }
$label{$_[0]};
}
sub ::LABEL # instantiate a file-scope label
{ $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
$label{$_[0]};
}
sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); }
sub ::set_label_B { push(@out,"@_:\n"); }
sub ::set_label
{ my $label=&::label($_[0]);
&::align($_[1]) if ($_[1]>1);
&::set_label_B($label);
$label;
}
sub ::wipe_labels # wipes function-scope labels
{ foreach $i (keys %label)
{ delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); }
}
# subroutine management
sub ::function_begin
{ &function_begin_B(@_);
$stack=4;
&push("ebp");
&push("ebx");
&push("esi");
&push("edi");
}
sub ::function_end
{ &pop("edi");
&pop("esi");
&pop("ebx");
&pop("ebp");
&ret();
&function_end_B(@_);
$stack=0;
&wipe_labels();
}
sub ::function_end_A
{ &pop("edi");
&pop("esi");
&pop("ebx");
&pop("ebp");
&ret();
$stack+=16; # readjust esp as if we didn't pop anything
}
sub ::asciz
{ my @str=unpack("C*",shift);
push @str,0;
while ($#str>15) {
&data_byte(@str[0..15]);
foreach (0..15) { shift @str; }
}
&data_byte(@str) if (@str);
}
sub ::asm_finish
{ &file_end();
print @out;
}
sub ::asm_init
{ my ($type,$cpu)=@_;
$i386=$cpu;
$elf=$cpp=$coff=$aout=$macosx=$win32=$mwerks=$android=0;
if (($type eq "elf"))
{ $elf=1; require "x86gas.pl"; }
elsif (($type eq "elf-1"))
{ $elf=-1; require "x86gas.pl"; }
elsif (($type eq "a\.out"))
{ $aout=1; require "x86gas.pl"; }
elsif (($type eq "coff" or $type eq "gaswin"))
{ $coff=1; require "x86gas.pl"; }
elsif (($type eq "win32n"))
{ $win32=1; require "x86nasm.pl"; }
elsif (($type eq "win32"))
{ $win32=1; require "x86masm.pl"; }
elsif (($type eq "macosx"))
{ $aout=1; $macosx=1; require "x86gas.pl"; }
elsif (($type eq "android"))
{ $elf=1; $android=1; require "x86gas.pl"; }
else
{ print STDERR <<"EOF";
Pick one target type from
elf - Linux, FreeBSD, Solaris x86, etc.
a.out - DJGPP, elder OpenBSD, etc.
coff - GAS/COFF such as Win32 targets
win32n - Windows 95/Windows NT NASM format
macosx - Mac OS X
EOF
exit(1);
}
$pic=0;
for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
&file();
}
sub ::hidden {}
1;

View file

@ -0,0 +1,265 @@
#! /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
package x86gas;
*out=\@::out;
$::lbdecor=$::aout?"L":".L"; # local label decoration
$nmdecor=($::aout or $::coff)?"_":""; # external name decoration
$initseg="";
$align=16;
$align=log($align)/log(2) if ($::aout);
$com_start="#" if ($::aout or $::coff);
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; }
else { "w"; }
}
# swap arguments;
# expand opcode with size suffix;
# prefix numeric constants with $;
sub ::generic
{ my($opcode,@arg)=@_;
my($suffix,$dst,$src);
@arg=reverse(@arg);
for (@arg)
{ s/^(\*?)(e?[a-dsixphl]{2})$/$1%$2/o; # gp registers
s/^([xy]?mm[0-7])$/%$1/o; # xmm/mmx registers
s/^(\-?[0-9]+)$/\$$1/o; # constants
s/^(\-?0x[0-9a-f]+)$/\$$1/o; # constants
}
$dst = $arg[$#arg] if ($#arg>=0);
$src = $arg[$#arg-1] if ($#arg>=1);
if ($dst =~ m/^%/o) { $suffix=&opsize($dst); }
elsif ($src =~ m/^%/o) { $suffix=&opsize($src); }
else { $suffix="l"; }
undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o);
if ($#_==0) { &::emit($opcode); }
elsif ($#_==1 && $opcode =~ m/^(call|clflush|j|loop|set)/o)
{ &::emit($opcode,@arg); }
else { &::emit($opcode.$suffix,@arg);}
1;
}
#
# opcodes not covered by ::generic above, mostly inconsistent namings...
#
sub ::movzx { &::movzb(@_); }
sub ::pushfd { &::pushfl; }
sub ::popfd { &::popfl; }
sub ::cpuid { &::emit(".byte\t0x0f,0xa2"); }
sub ::rdtsc { &::emit(".byte\t0x0f,0x31"); }
sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
sub ::call_ptr { &::generic("call","*$_[0]"); }
sub ::jmp_ptr { &::generic("jmp","*$_[0]"); }
*::bswap = sub { &::emit("bswap","%$_[0]"); } if (!$::i386);
sub ::DWP
{ my($addr,$reg1,$reg2,$idx)=@_;
my $ret="";
if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
$addr =~ s/^\s+//;
# prepend global references with optional underscore
$addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige;
$reg1 = "%$reg1" if ($reg1);
$reg2 = "%$reg2" if ($reg2);
$ret .= $addr if (($addr ne "") && ($addr ne 0));
if ($reg2)
{ $idx!= 0 or $idx=1;
$ret .= "($reg1,$reg2,$idx)";
}
elsif ($reg1)
{ $ret .= "($reg1)"; }
$ret;
}
sub ::QWP { &::DWP(@_); }
sub ::BP { &::DWP(@_); }
sub ::WP { &::DWP(@_); }
sub ::BC { @_; }
sub ::DWC { @_; }
sub ::file
{ push(@out,".text\n"); }
sub ::function_begin_B
{ my $func=shift;
my $global=($func !~ /^_/);
my $begin="${::lbdecor}_${func}_begin";
&::LABEL($func,$global?"$begin":"$nmdecor$func");
$func=$nmdecor.$func;
push(@out,".globl\t$func\n") if ($global);
if ($::coff)
{ push(@out,".def\t$func;\t.scl\t".(3-$global).";\t.type\t32;\t.endef\n"); }
elsif (($::aout and !$::pic) or $::macosx)
{ }
else
{ push(@out,".type $func,\@function\n"); }
push(@out,".align\t$align\n");
push(@out,"$func:\n");
push(@out,"$begin:\n") if ($global);
$::stack=4;
}
sub ::function_end_B
{ my $func=shift;
push(@out,".size\t$nmdecor$func,.-".&::LABEL($func)."\n") if ($::elf);
$::stack=0;
&::wipe_labels();
}
sub ::comment
{
if (!defined($com_start) or $::elf)
{ # Regarding $::elf above...
# GNU and SVR4 as'es use different comment delimiters,
push(@out,"\n"); # so we just skip ELF comments...
return;
}
foreach (@_)
{
if (/^\s*$/)
{ push(@out,"\n"); }
else
{ push(@out,"\t$com_start $_ $com_end\n"); }
}
}
sub ::external_label
{ foreach(@_) { &::LABEL($_,$nmdecor.$_); } }
sub ::public_label
{ push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
sub ::file_end
{ 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,16";
if ($::macosx) { push (@out,"$tmp,2\n"); }
elsif ($::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
{ my $val=$_[0];
if ($::aout)
{ $val=int(log($val)/log(2));
$val.=",0x90";
}
push(@out,".align\t$val\n");
}
sub ::picmeup
{ my($dst,$sym,$base,$reflabel)=@_;
if (($::pic && ($::elf || $::aout)) || $::macosx)
{ if (!defined($base))
{ &::call(&::label("PIC_me_up"));
&::set_label("PIC_me_up");
&::blindpop($dst);
$base=$dst;
$reflabel=&::label("PIC_me_up");
}
if ($::macosx)
{ my $indirect=&::static_label("$nmdecor$sym\$non_lazy_ptr");
&::mov($dst,&::DWP("$indirect-$reflabel",$base));
$non_lazy_ptr{"$nmdecor$sym"}=$indirect;
}
elsif ($sym eq "OPENSSL_ia32cap_P" && $::elf>0)
{ &::lea($dst,&::DWP("$sym-$reflabel",$base)); }
else
{ &::lea($dst,&::DWP("_GLOBAL_OFFSET_TABLE_+[.-$reflabel]",
$base));
&::mov($dst,&::DWP("$sym\@GOT",$dst));
}
}
else
{ &::lea($dst,&::DWP($sym)); }
}
sub ::initseg
{ my $f=$nmdecor.shift;
if ($::android)
{ $initseg.=<<___;
.section .init_array
.align 4
.long $f
___
}
elsif ($::elf)
{ $initseg.=<<___;
.section .init
call $f
___
}
elsif ($::coff)
{ $initseg.=<<___; # applies to both Cygwin and Mingw
.section .ctors
.long $f
___
}
elsif ($::macosx)
{ $initseg.=<<___;
.mod_init_func
.align 2
.long $f
___
}
elsif ($::aout)
{ my $ctor="${nmdecor}_GLOBAL_\$I\$$f";
$initseg.=".text\n";
$initseg.=".type $ctor,\@function\n" if ($::pic);
$initseg.=<<___; # OpenBSD way...
.globl $ctor
.align 2
$ctor:
jmp $f
___
}
}
sub ::dataseg
{ push(@out,".data\n"); }
*::hidden = sub { push(@out,".hidden\t$nmdecor$_[0]\n"); } if ($::elf);
1;

View file

@ -0,0 +1,206 @@
#! /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
package x86masm;
*out=\@::out;
$::lbdecor="\$L"; # local label decoration
$nmdecor="_"; # external name decoration
$initseg="";
$segment="";
sub ::generic
{ my ($opcode,@arg)=@_;
# fix hexadecimal constants
for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; }
if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no []
{ $opcode="mov"; }
elsif ($opcode !~ /mov[dq]$/)
{ # 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);
}
&::emit($opcode,@arg);
1;
}
#
# opcodes not covered by ::generic above, mostly inconsistent namings...
#
sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
sub ::call_ptr { &::emit("call",@_); }
sub ::jmp_ptr { &::emit("jmp",@_); }
sub ::lock { &::data_byte(0xf0); }
sub get_mem
{ my($size,$addr,$reg1,$reg2,$idx)=@_;
my($post,$ret);
if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
$ret .= "$size PTR " if ($size ne "");
$addr =~ s/^\s+//;
# prepend global references with optional underscore
$addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige;
# put address arithmetic expression in parenthesis
$addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
if (($addr ne "") && ($addr ne 0))
{ if ($addr !~ /^-/) { $ret .= "$addr"; }
else { $post=$addr; }
}
$ret .= "[";
if ($reg2 ne "")
{ $idx!=0 or $idx=1;
$ret .= "$reg2*$idx";
$ret .= "+$reg1" if ($reg1 ne "");
}
else
{ $ret .= "$reg1"; }
$ret .= "$post]";
$ret =~ s/\+\]/]/; # in case $addr was the only argument
$ret =~ s/\[\s*\]//;
$ret;
}
sub ::BP { &get_mem("BYTE",@_); }
sub ::WP { &get_mem("WORD",@_); }
sub ::DWP { &get_mem("DWORD",@_); }
sub ::QWP { &get_mem("QWORD",@_); }
sub ::BC { "@_"; }
sub ::DWC { "@_"; }
sub ::file
{ my $tmp=<<___;
IF \@Version LT 800
ECHO MASM version 8.00 or later is strongly recommended.
ENDIF
.686
.MODEL FLAT
OPTION DOTNAME
IF \@Version LT 800
.text\$ SEGMENT PAGE 'CODE'
ELSE
.text\$ SEGMENT ALIGN(64) 'CODE'
ENDIF
___
push(@out,$tmp);
$segment = ".text\$";
}
sub ::function_begin_B
{ my $func=shift;
my $global=($func !~ /^_/);
my $begin="${::lbdecor}_${func}_begin";
&::LABEL($func,$global?"$begin":"$nmdecor$func");
$func="ALIGN\t16\n".$nmdecor.$func."\tPROC";
if ($global) { $func.=" PUBLIC\n${begin}::\n"; }
else { $func.=" PRIVATE\n"; }
push(@out,$func);
$::stack=4;
}
sub ::function_end_B
{ my $func=shift;
push(@out,"$nmdecor$func ENDP\n");
$::stack=0;
&::wipe_labels();
}
sub ::file_end
{ my $xmmheader=<<___;
.686
.XMM
IF \@Version LT 800
XMMWORD STRUCT 16
DQ 2 dup (?)
XMMWORD ENDS
ENDIF
___
if (grep {/\b[x]?mm[0-7]\b/i} @out) {
grep {s/\.[3-7]86/$xmmheader/} @out;
}
push(@out,"$segment ENDS\n");
if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
{ my $comm=<<___;
.bss SEGMENT 'BSS'
COMM ${nmdecor}OPENSSL_ia32cap_P:DWORD:4
.bss ENDS
___
# comment out OPENSSL_ia32cap_P declarations
grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
push (@out,$comm);
}
push (@out,$initseg) if ($initseg);
push (@out,"END\n");
}
sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
*::set_label_B = sub
{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); };
sub ::external_label
{ foreach(@_)
{ push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); }
}
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(@_); }
sub ::data_short
{ push(@out,("DW\t").join(',',splice(@_,0,8))."\n") while(@_); }
sub ::data_word
{ push(@out,("DD\t").join(',',splice(@_,0,4))."\n") while(@_); }
sub ::align
{ push(@out,"ALIGN\t$_[0]\n"); }
sub ::picmeup
{ my($dst,$sym)=@_;
&::lea($dst,&::DWP($sym));
}
sub ::initseg
{ my $f=$nmdecor.shift;
$initseg.=<<___;
.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA'
EXTERN $f:NEAR
DD $f
.CRT\$XCU ENDS
___
}
sub ::dataseg
{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; }
sub ::safeseh
{ my $nm=shift;
push(@out,"IF \@Version GE 710\n");
push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n");
push(@out,"ENDIF\n");
}
1;

View file

@ -0,0 +1,186 @@
#! /usr/bin/env perl
# Copyright 1999-2018 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
package x86nasm;
*out=\@::out;
$::lbdecor="L\$"; # local label decoration
$nmdecor="_"; # external name decoration
$drdecor=$::mwerks?".":""; # directive decoration
$initseg="";
sub ::generic
{ my $opcode=shift;
my $tmp;
if (!$::mwerks)
{ if ($opcode =~ m/^j/o && $#_==0) # optimize jumps
{ $_[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;
}
#
# opcodes not covered by ::generic above, mostly inconsistent namings...
#
sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
sub ::call_ptr { &::emit("call",@_); }
sub ::jmp_ptr { &::emit("jmp",@_); }
sub get_mem
{ my($size,$addr,$reg1,$reg2,$idx)=@_;
my($post,$ret);
if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
if ($size ne "")
{ $ret .= "$size";
$ret .= " PTR" if ($::mwerks);
$ret .= " ";
}
$ret .= "[";
$addr =~ s/^\s+//;
# prepend global references with optional underscore
$addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
# put address arithmetic expression in parenthesis
$addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
if (($addr ne "") && ($addr ne 0))
{ if ($addr !~ /^-/) { $ret .= "$addr+"; }
else { $post=$addr; }
}
if ($reg2 ne "")
{ $idx!=0 or $idx=1;
$ret .= "$reg2*$idx";
$ret .= "+$reg1" if ($reg1 ne "");
}
else
{ $ret .= "$reg1"; }
$ret .= "$post]";
$ret =~ s/\+\]/]/; # in case $addr was the only argument
$ret;
}
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 ")."@_"; }
sub ::file
{ if ($::mwerks) { push(@out,".section\t.text,64\n"); }
else
{ my $tmp=<<___;
%ifidn __OUTPUT_FORMAT__,obj
section code use32 class=code align=64
%elifidn __OUTPUT_FORMAT__,win32
\$\@feat.00 equ 1
section .text code align=64
%else
section .text code
%endif
___
push(@out,$tmp);
}
}
sub ::function_begin_B
{ my $func=shift;
my $global=($func !~ /^_/);
my $begin="${::lbdecor}_${func}_begin";
$begin =~ s/^\@/./ if ($::mwerks); # the torture never stops
&::LABEL($func,$global?"$begin":"$nmdecor$func");
$func=$nmdecor.$func;
push(@out,"${drdecor}global $func\n") if ($global);
push(@out,"${drdecor}align 16\n");
push(@out,"$func:\n");
push(@out,"$begin:\n") if ($global);
$::stack=4;
}
sub ::function_end_B
{ $::stack=0;
&::wipe_labels();
}
sub ::file_end
{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
{ my $comm=<<___;
${drdecor}segment .bss
${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 16
___
# comment out OPENSSL_ia32cap_P declarations
grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
push (@out,$comm)
}
push (@out,$initseg) if ($initseg);
}
sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
sub ::external_label
{ foreach(@_)
{ push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); }
}
sub ::public_label
{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
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"); }
sub ::align
{ push(@out,"${drdecor}align\t$_[0]\n"); }
sub ::picmeup
{ my($dst,$sym)=@_;
&::lea($dst,&::DWP($sym));
}
sub ::initseg
{ my $f=$nmdecor.shift;
if ($::win32)
{ $initseg=<<___;
segment .CRT\$XCU data align=4
extern $f
dd $f
___
}
}
sub ::dataseg
{ if ($mwerks) { push(@out,".section\t.data,4\n"); }
else { push(@out,"section\t.data align=4\n"); }
}
sub ::safeseh
{ my $nm=shift;
push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n");
push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n");
push(@out,"%endif\n");
}
1;