perlasm/ppc-xlate.pl: add PowerISA 3.0B instructions.
[openssl.git] / crypto / perlasm / ppc-xlate.pl
index a67eef57d5b6dbda264270f62ac9c5a00365c46d..ba2842fb8240f1874ae7078018433b48960822aa 100755 (executable)
@@ -1,46 +1,75 @@
-#!/usr/bin/env perl
-
-# PowerPC assembler distiller by <appro>.
+#! /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
 
 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|^[\.\_]||;
+    $name =~ s|^\.||;
+
     SWITCH: for ($flavour) {
-       /aix/           && do { $name = ".$name";
+       /aix/           && do { if (!$$type) {
+                                   $$type = "\@function";
+                               }
+                               if ($$type =~ /function/) {
+                                   $name = ".$name";
+                               }
                                last;
                              };
        /osx/           && do { $name = "_$name";
                                last;
                              };
        /linux.*(32|64le)/
-                       && do { $ret .= ".globl $name\n";
-                               $ret .= ".type  $name,\@function";
+                       && do { $ret .= ".globl $name";
+                               if (!$$type) {
+                                   $ret .= "\n.type    $name,\@function";
+                                   $$type = "\@function";
+                               }
                                last;
                              };
-       /linux.*64/     && do { $ret .= ".globl $name\n";
-                               $ret .= ".type  $name,\@function\n";
-                               $ret .= ".section       \".opd\",\"aw\"\n";
-                               $ret .= ".align 3\n";
-                               $ret .= "$name:\n";
-                               $ret .= ".quad  .$name,.TOC.\@tocbase,0\n";
-                               $ret .= ".previous\n";
-
-                               $name = ".$name";
+       /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;
                              };
     }
@@ -66,9 +95,13 @@ my $machine = sub {
 my $size = sub {
     if ($flavour =~ /linux/)
     {  shift;
-       my $name = shift; $name =~ s|^[\.\_]||;
-       my $ret  = ".size       $name,.-".($flavour=~/64$/?".":"").$name;
-       $ret .= "\n.size        .$name,.-.$name" if ($flavour=~/64$/);
+       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
@@ -151,6 +184,103 @@ my $vmr = sub {
     "  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
+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;
+}
+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 one can use vcrypto_op
+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 $mtsle      = sub {
+    my ($f, $arg) = @_;
+    "  .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);
+};
+my $iseleq = sub {
+    my ($f, $rt, $ra, $rb) = @_;
+    "  .long   ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|(2<<6)|30;
+};
+
+# 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 {
+    my ($f, $vrt, $vra, $vrb, $vrc) = @_;
+    "  .long   ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($vrc<<6)|35;
+};
+
 while($line=<>) {
 
     $line =~ s|[#!;].*$||;     # get rid of asm-style comments...
@@ -159,7 +289,7 @@ while($line=<>) {
     $line =~ s|\s+$||;         # ... and at the end
 
     {
-       $line =~ s|\b\.L(\w+)|L$1|g;    # common denominator for Locallabel
+       $line =~ s|\.L(\w+)|L$1|g;      # common denominator for Locallabel
        $line =~ s|\bL(\w+)|\.L$1|g     if ($dotinlocallabels);
     }
 
@@ -167,8 +297,13 @@ while($line=<>) {
        $line =~ s|(^[\.\w]+)\:\s*||;
        my $label = $1;
        if ($label) {
-           printf "%s:",($GLOBALS{$label} or $label);
-           printf "\n.localentry\t$GLOBALS{$label},0"  if ($GLOBALS{$label} && $flavour =~ /linux.*64le/);
+           my $xlated = ($GLOBALS{$label} or $label);
+           print "$xlated:";
+           if ($flavour =~ /linux.*64le/) {
+               if ($TYPES{$label} =~ /function/) {
+                   printf "\n.localentry       %s,0\n",$xlated;
+               }
+           }
        }
     }
 
@@ -179,7 +314,7 @@ while($line=<>) {
        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(',',$line)); }
+       if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(/,\s*/,$line)); }
        elsif ($mnemonic)           { $line = $c.$mnemonic.$f."\t".$line; }
     }