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