crypto/perlasm/arm-xlate.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2015-2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the Apache License 2.0 (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 use strict;
  10
  11 my $flavour = shift;
  12 my $output = shift;
  13 open STDOUT,">$output" || die "can't open $output: $!";
  14
  15 $flavour = "linux32" if (!$flavour or $flavour eq "void");
  16
  17 my %GLOBALS;
  18 my $dotinlocallabels=($flavour=~/linux/)?1:0;
  19
  20 ################################################################
  21 # directives which need special treatment on different platforms
  22 ################################################################
  23 my $arch = sub {
  24     if ($flavour =~ /linux/)    { ".arch\t".join(',',@_); }
  25     else                        { ""; }
  26 };
  27 my $fpu = sub {
  28     if ($flavour =~ /linux/)    { ".fpu\t".join(',',@_); }
  29     else                        { ""; }
  30 };
  31 my $rodata = sub {
  32     SWITCH: for ($flavour) {
  33         /linux/         && return ".section\t.rodata";
  34         /ios/           && return ".section\t__TEXT,__const";
  35         last;
  36     }
  37 };
  38 my $hidden = sub {
  39     if ($flavour =~ /ios/)      { ".private_extern\t".join(',',@_); }
  40     else                        { ".hidden\t".join(',',@_); }
  41 };
  42 my $comm = sub {
  43     my @args = split(/,\s*/,shift);
  44     my $name = @args[0];
  45     my $global = \$GLOBALS{$name};
  46     my $ret;
  47
  48     if ($flavour =~ /ios32/)    {
  49         $ret = ".comm\t_$name,@args[1]\n";
  50         $ret .= ".non_lazy_symbol_pointer\n";
  51         $ret .= "$name:\n";
  52         $ret .= ".indirect_symbol\t_$name\n";
  53         $ret .= ".long\t0";
  54         $name = "_$name";
  55     } else                      { $ret = ".comm\t".join(',',@args); }
  56
  57     $$global = $name;
  58     $ret;
  59 };
  60 my $globl = sub {
  61     my $name = shift;
  62     my $global = \$GLOBALS{$name};
  63     my $ret;
  64
  65     SWITCH: for ($flavour) {
  66         /ios/           && do { $name = "_$name";
  67                                 last;
  68                               };
  69     }
  70
  71     $ret = ".globl      $name" if (!$ret);
  72     $$global = $name;
  73     $ret;
  74 };
  75 my $global = $globl;
  76 my $extern = sub {
  77     &$globl(@_);
  78     return;     # return nothing
  79 };
  80 my $type = sub {
  81     if ($flavour =~ /linux/)    { ".type\t".join(',',@_); }
  82     elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
  83                                         "#ifdef __thumb2__\n".
  84                                         ".thumb_func    $1\n".
  85                                         "#endif";
  86                                   }
  87                                 }
  88     else                        { ""; }
  89 };
  90 my $size = sub {
  91     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
  92     else                        { ""; }
  93 };
  94 my $inst = sub {
  95     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
  96     else                        { ".long\t".join(',',@_); }
  97 };
  98 my $asciz = sub {
  99     my $line = join(",",@_);
 100     if ($line =~ /^"(.*)"$/)
 101     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
 102     else
 103     {   "";     }
 104 };
 105
 106 my $adrp = sub {
 107     my ($args,$comment) = split(m|\s*//|,shift);
 108     "\tadrp\t$args\@PAGE";
 109 } if ($flavour =~ /ios64/);
 110
 111
 112 sub range {
 113   my ($r,$sfx,$start,$end) = @_;
 114
 115     join(",",map("$r$_$sfx",($start..$end)));
 116 }
 117
 118 sub expand_line {
 119   my $line = shift;
 120   my @ret = ();
 121
 122     pos($line)=0;
 123
 124     while ($line =~ m/\G[^@\/\{\"]*/g) {
 125         if ($line =~ m/\G(@|\/\/|$)/gc) {
 126             last;
 127         }
 128         elsif ($line =~ m/\G\{/gc) {
 129             my $saved_pos = pos($line);
 130             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
 131             pos($line) = $saved_pos;
 132             $line =~ m/\G[^\}]*\}/g;
 133         }
 134         elsif ($line =~ m/\G\"/gc) {
 135             $line =~ m/\G[^\"]*\"/g;
 136         }
 137     }
 138
 139     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
 140
 141     if ($flavour =~ /ios64/) {
 142         $line =~ s/#:lo12:(\w+)/$1\@PAGEOFF/;
 143     }
 144
 145     return $line;
 146 }
 147
 148 while(my $line=<>) {
 149
 150     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
 151
 152     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
 153     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
 154     $line =~ s|\s+$||;          # ... and at the end
 155
 156     {
 157         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
 158         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
 159     }
 160
 161     {
 162         $line =~ s|(^[\.\w]+)\:\s*||;
 163         my $label = $1;
 164         if ($label) {
 165             printf "%s:",($GLOBALS{$label} or $label);
 166         }
 167     }
 168
 169     if ($line !~ m/^[#@]/) {
 170         $line =~ s|^\s*(\.?)(\S+)\s*||;
 171         my $c = $1; $c = "\t" if ($c eq "");
 172         my $mnemonic = $2;
 173         my $opcode;
 174         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
 175             $opcode = eval("\$$1_$2");
 176         } else {
 177             $opcode = eval("\$$mnemonic");
 178         }
 179
 180         my $arg=expand_line($line);
 181
 182         if (ref($opcode) eq 'CODE') {
 183                 $line = &$opcode($arg);
 184         } elsif ($mnemonic)         {
 185                 $line = $c.$mnemonic;
 186                 $line.= "\t$arg" if ($arg ne "");
 187         }
 188     }
 189
 190     print $line if ($line);
 191     print "\n";
 192 }
 193
 194 close STDOUT or die "error closing STDOUT";