crypto/vmx/ppc-xlate.pl

0001 #!/usr/bin/env perl
0002 # SPDX-License-Identifier: GPL-2.0
0003
0004 # PowerPC assembler distiller by <appro>.
0005
0006 my $flavour = shift;
0007 my $output = shift;
0008 open STDOUT,">$output" || die "can't open $output: $!";
0009
0010 my %GLOBALS;
0011 my $dotinlocallabels=($flavour=~/linux/)?1:0;
0012
0013 ################################################################
0014 # directives which need special treatment on different platforms
0015 ################################################################
0016 my $globl = sub {
0017     my $junk = shift;
0018     my $name = shift;
0019     my $global = \$GLOBALS{$name};
0020     my $ret;
0021
0022     $name =~ s|^[\.\_]||;
0023
0024     SWITCH: for ($flavour) {
0025     /aix/       && do { $name = ".$name";
0026                 last;
0027                   };
0028     /osx/       && do { $name = "_$name";
0029                 last;
0030                   };
0031     /linux/
0032             && do { $ret = "_GLOBAL($name)";
0033                 last;
0034                   };
0035     }
0036
0037     $ret = ".globl  $name\nalign 5\n$name:" if (!$ret);
0038     $$global = $name;
0039     $ret;
0040 };
0041 my $text = sub {
0042     my $ret = ($flavour =~ /aix/) ? ".csect\t.text[PR],7" : ".text";
0043     $ret = ".abiversion 2\n".$ret   if ($flavour =~ /linux.*64le/);
0044     $ret;
0045 };
0046 my $machine = sub {
0047     my $junk = shift;
0048     my $arch = shift;
0049     if ($flavour =~ /osx/)
0050     {   $arch =~ s/\"//g;
0051     $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any");
0052     }
0053     ".machine   $arch";
0054 };
0055 my $size = sub {
0056     if ($flavour =~ /linux/)
0057     {   shift;
0058     my $name = shift; $name =~ s|^[\.\_]||;
0059     my $ret  = ".size   $name,.-".($flavour=~/64$/?".":"").$name;
0060     $ret .= "\n.size    .$name,.-.$name" if ($flavour=~/64$/);
0061     $ret;
0062     }
0063     else
0064     {   ""; }
0065 };
0066 my $asciz = sub {
0067     shift;
0068     my $line = join(",",@_);
0069     if ($line =~ /^"(.*)"$/)
0070     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align 2"; }
0071     else
0072     {   ""; }
0073 };
0074 my $quad = sub {
0075     shift;
0076     my @ret;
0077     my ($hi,$lo);
0078     for (@_) {
0079     if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io)
0080     {  $hi=$1?"0x$1":"0"; $lo="0x$2";  }
0081     elsif (/^([0-9]+)$/o)
0082     {  $hi=$1>>32; $lo=$1&0xffffffff;  } # error-prone with 32-bit perl
0083     else
0084     {  $hi=undef; $lo=$_; }
0085
0086     if (defined($hi))
0087     {  push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo");  }
0088     else
0089     {  push(@ret,".quad $lo");  }
0090     }
0091     join("\n",@ret);
0092 };
0093
0094 ################################################################
0095 # simplified mnemonics not handled by at least one assembler
0096 ################################################################
0097 my $cmplw = sub {
0098     my $f = shift;
0099     my $cr = 0; $cr = shift if ($#_>1);
0100     # Some out-of-date 32-bit GNU assembler just can't handle cmplw...
0101     ($flavour =~ /linux.*32/) ?
0102     "   .long   ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 :
0103     "   cmplw   ".join(',',$cr,@_);
0104 };
0105 my $bdnz = sub {
0106     my $f = shift;
0107     my $bo = $f=~/[\+\-]/ ? 16+9 : 16;  # optional "to be taken" hint
0108     "   bc  $bo,0,".shift;
0109 } if ($flavour!~/linux/);
0110 my $bltlr = sub {
0111     my $f = shift;
0112     my $bo = $f=~/\-/ ? 12+2 : 12;  # optional "not to be taken" hint
0113     ($flavour =~ /linux/) ?     # GNU as doesn't allow most recent hints
0114     "   .long   ".sprintf "0x%x",19<<26|$bo<<21|16<<1 :
0115     "   bclr    $bo,0";
0116 };
0117 my $bnelr = sub {
0118     my $f = shift;
0119     my $bo = $f=~/\-/ ? 4+2 : 4;    # optional "not to be taken" hint
0120     ($flavour =~ /linux/) ?     # GNU as doesn't allow most recent hints
0121     "   .long   ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 :
0122     "   bclr    $bo,2";
0123 };
0124 my $beqlr = sub {
0125     my $f = shift;
0126     my $bo = $f=~/-/ ? 12+2 : 12;   # optional "not to be taken" hint
0127     ($flavour =~ /linux/) ?     # GNU as doesn't allow most recent hints
0128     "   .long   ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 :
0129     "   bclr    $bo,2";
0130 };
0131 # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two
0132 # arguments is 64, with "operand out of range" error.
0133 my $extrdi = sub {
0134     my ($f,$ra,$rs,$n,$b) = @_;
0135     $b = ($b+$n)&63; $n = 64-$n;
0136     "   rldicl  $ra,$rs,$b,$n";
0137 };
0138 my $vmr = sub {
0139     my ($f,$vx,$vy) = @_;
0140     "   vor $vx,$vy,$vy";
0141 };
0142
0143 # Some ABIs specify vrsave, special-purpose register #256, as reserved
0144 # for system use.
0145 my $no_vrsave = ($flavour =~ /linux-ppc64le/);
0146 my $mtspr = sub {
0147     my ($f,$idx,$ra) = @_;
0148     if ($idx == 256 && $no_vrsave) {
0149     "   or  $ra,$ra,$ra";
0150     } else {
0151     "   mtspr   $idx,$ra";
0152     }
0153 };
0154 my $mfspr = sub {
0155     my ($f,$rd,$idx) = @_;
0156     if ($idx == 256 && $no_vrsave) {
0157     "   li  $rd,-1";
0158     } else {
0159     "   mfspr   $rd,$idx";
0160     }
0161 };
0162
0163 # PowerISA 2.06 stuff
0164 sub vsxmem_op {
0165     my ($f, $vrt, $ra, $rb, $op) = @_;
0166     "   .long   ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|($rb<<11)|($op*2+1);
0167 }
0168 # made-up unaligned memory reference AltiVec/VMX instructions
0169 my $lvx_u   = sub { vsxmem_op(@_, 844); };  # lxvd2x
0170 my $stvx_u  = sub { vsxmem_op(@_, 972); };  # stxvd2x
0171 my $lvdx_u  = sub { vsxmem_op(@_, 588); };  # lxsdx
0172 my $stvdx_u = sub { vsxmem_op(@_, 716); };  # stxsdx
0173 my $lvx_4w  = sub { vsxmem_op(@_, 780); };  # lxvw4x
0174 my $stvx_4w = sub { vsxmem_op(@_, 908); };  # stxvw4x
0175
0176 # PowerISA 2.07 stuff
0177 sub vcrypto_op {
0178     my ($f, $vrt, $vra, $vrb, $op) = @_;
0179     "   .long   ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op;
0180 }
0181 my $vcipher = sub { vcrypto_op(@_, 1288); };
0182 my $vcipherlast = sub { vcrypto_op(@_, 1289); };
0183 my $vncipher    = sub { vcrypto_op(@_, 1352); };
0184 my $vncipherlast= sub { vcrypto_op(@_, 1353); };
0185 my $vsbox   = sub { vcrypto_op(@_, 0, 1480); };
0186 my $vshasigmad  = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); };
0187 my $vshasigmaw  = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); };
0188 my $vpmsumb = sub { vcrypto_op(@_, 1032); };
0189 my $vpmsumd = sub { vcrypto_op(@_, 1224); };
0190 my $vpmsubh = sub { vcrypto_op(@_, 1096); };
0191 my $vpmsumw = sub { vcrypto_op(@_, 1160); };
0192 my $vaddudm = sub { vcrypto_op(@_, 192);  };
0193 my $vadduqm = sub { vcrypto_op(@_, 256);  };
0194
0195 my $mtsle   = sub {
0196     my ($f, $arg) = @_;
0197     "   .long   ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2);
0198 };
0199
0200 print "#include <asm/ppc_asm.h>\n" if $flavour =~ /linux/;
0201
0202 while($line=<>) {
0203
0204     $line =~ s|[#!;].*$||;  # get rid of asm-style comments...
0205     $line =~ s|/\*.*\*/||;  # ... and C-style comments...
0206     $line =~ s|^\s+||;      # ... and skip white spaces in beginning...
0207     $line =~ s|\s+$||;      # ... and at the end
0208
0209     {
0210     $line =~ s|\b\.L(\w+)|L$1|g;    # common denominator for Locallabel
0211     $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels);
0212     }
0213
0214     {
0215     $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||;
0216     my $c = $1; $c = "\t" if ($c eq "");
0217     my $mnemonic = $2;
0218     my $f = $3;
0219     my $opcode = eval("\$$mnemonic");
0220     $line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/);
0221     if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); }
0222     elsif ($mnemonic)           { $line = $c.$mnemonic.$f."\t".$line; }
0223     }
0224
0225     print $line if ($line);
0226     print "\n";
0227 }
0228
0229 close STDOUT;