mirror of
https://github.com/openssl/openssl.git
synced 2025-03-07 19:38:33 +08:00
178fa72ed5
This commit adds an architecture named aix64-gcc-as which can generate assembler source code compatible with AIX assembler (as) instead of the GNU Assembler (gas). This architecture name is then used in a callback for the .p2align directive which is not available in AIX as. The motivation for this addition came out of an issue we ran into when working on upgrading OpenSSL in Node.js. We ran into the following compilation error on one of the CI machines that uses AIX: 05:39:05 Assembler: 05:39:05 crypto/bn/ppc64-mont-fixed.s: line 4: Error In Syntax This machine is using AIX Version 7.2 and does not have gas installed and the .p2align directive is causing this error. After asking around if it would be possible to install GAS on this machine I learned that AIX GNU utils are not maintained as well as the native AIX ones and we (Red Hat/IBM) have run into issues with the GNU utils in the past and if possible it would be preferable to be able to use the AIX native assembler. Refs: https://github.com/nodejs/node/pull/38512 Reviewed-by: Tomas Mraz <tomas@openssl.org> Reviewed-by: Paul Dale <pauli@openssl.org> (Merged from https://github.com/openssl/openssl/pull/15638)
421 lines
12 KiB
Raku
Executable File
421 lines
12 KiB
Raku
Executable File
#! /usr/bin/env perl
|
|
# Copyright 2006-2020 The OpenSSL Project Authors. All Rights Reserved.
|
|
#
|
|
# Licensed under the Apache License 2.0 (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|64(le|v2))/
|
|
&& 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.*64(le|v2)/);
|
|
$ret;
|
|
};
|
|
my $p2align = sub {
|
|
my $ret = ($flavour =~ /aix64-as/) ? "" : ".p2align $line";
|
|
$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);
|
|
};
|
|
|
|
################################################################
|
|
# vector register number hacking
|
|
################################################################
|
|
|
|
# It is convenient to be able to set a variable like:
|
|
# my $foo = "v33";
|
|
# and use this in different contexts where:
|
|
# * a VSR (Vector-Scaler Register) number (i.e. "v33") is required
|
|
# * a VR (Vector Register) number (i.e. "v1") is required
|
|
# Map VSR numbering to VR number for certain vector instructions.
|
|
|
|
# vs<N> -> v<N-32> if N > 32
|
|
sub vsr2vr1 {
|
|
my $in = shift;
|
|
|
|
my $n = int($in);
|
|
if ($n >= 32) {
|
|
$n -= 32;
|
|
}
|
|
|
|
return "$n";
|
|
}
|
|
# As above for first $num register args, returns list
|
|
sub _vsr2vr {
|
|
my $num = shift;
|
|
my @rest = @_;
|
|
my @subst = splice(@rest, 0, $num);
|
|
|
|
@subst = map { vsr2vr1($_); } @subst;
|
|
|
|
return (@subst, @rest);
|
|
}
|
|
# As above but 1st arg ($f) is extracted and reinserted after
|
|
# processing so that it can be ignored by a code generation function
|
|
# that consumes the result
|
|
sub vsr2vr_args {
|
|
my $num = shift;
|
|
my $f = shift;
|
|
|
|
my @out = _vsr2vr($num, @_);
|
|
|
|
return ($f, @out);
|
|
}
|
|
# As above but 1st arg is mnemonic, return formatted instruction
|
|
sub vsr2vr {
|
|
my $mnemonic = shift;
|
|
my $num = shift;
|
|
my $f = shift;
|
|
|
|
my @out = _vsr2vr($num, @_);
|
|
|
|
" ${mnemonic}${f} " . join(",", @out);
|
|
}
|
|
|
|
# ISA 2.03
|
|
my $vsel = sub { vsr2vr("vsel", 4, @_); };
|
|
my $vsl = sub { vsr2vr("vsl", 3, @_); };
|
|
my $vspltisb = sub { vsr2vr("vspltisb", 1, @_); };
|
|
my $vspltisw = sub { vsr2vr("vspltisw", 1, @_); };
|
|
my $vsr = sub { vsr2vr("vsr", 3, @_); };
|
|
my $vsro = sub { vsr2vr("vsro", 3, @_); };
|
|
|
|
# ISA 3.0
|
|
my $lxsd = sub { vsr2vr("lxsd", 1, @_); };
|
|
|
|
################################################################
|
|
# 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|linux64(le|v2)/);
|
|
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) = vsr2vr_args(3, @_);
|
|
" .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;
|
|
};
|
|
sub vfour_vsr {
|
|
my ($f, $vrt, $vra, $vrb, $vrc, $op) = vsr2vr_args(4, @_);
|
|
" .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_vsr(@_,60); };
|
|
my $vaddecuq = sub { vfour_vsr(@_,61); };
|
|
my $vmrgew = sub { vfour_vsr(@_,0,1932); };
|
|
my $vmrgow = sub { vfour_vsr(@_,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;
|
|
};
|
|
my $lvwzx_u = sub { vsxmem_op(@_, 12); }; # lxsiwzx
|
|
my $stvwx_u = sub { vsxmem_op(@_, 140); }; # stxsiwx
|
|
|
|
# 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_vsr(@_, 35); };
|
|
|
|
while($line=<>) {
|
|
|
|
$line =~ s|[#!;].*$||; # get rid of asm-style comments...
|
|
$line =~ s|/\*.*\*/||; # ... and C-style comments...
|
|
$line =~ s|^\s+||; # ... and skip whitespaces 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.*64(le|v2)/) {
|
|
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 or die "error closing STDOUT: $!";
|