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 sub range {
 107   my ($r,$sfx,$start,$end) = @_;
 108
 109     join(",",map("$r$_$sfx",($start..$end)));
 110 }
 111
 112 sub expand_line {
 113   my $line = shift;
 114   my @ret = ();
 115
 116     pos($line)=0;
 117
 118     while ($line =~ m/\G[^@\/\{\"]*/g) {
 119         if ($line =~ m/\G(@|\/\/|$)/gc) {
 120             last;
 121         }
 122         elsif ($line =~ m/\G\{/gc) {
 123             my $saved_pos = pos($line);
 124             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
 125             pos($line) = $saved_pos;
 126             $line =~ m/\G[^\}]*\}/g;
 127         }
 128         elsif ($line =~ m/\G\"/gc) {
 129             $line =~ m/\G[^\"]*\"/g;
 130         }
 131     }
 132
 133     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
 134
 135     return $line;
 136 }
 137
 138 while(my $line=<>) {
 139
 140     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
 141
 142     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
 143     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
 144     $line =~ s|\s+$||;          # ... and at the end
 145
 146     {
 147         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
 148         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
 149     }
 150
 151     {
 152         $line =~ s|(^[\.\w]+)\:\s*||;
 153         my $label = $1;
 154         if ($label) {
 155             printf "%s:",($GLOBALS{$label} or $label);
 156         }
 157     }
 158
 159     if ($line !~ m/^[#@]/) {
 160         $line =~ s|^\s*(\.?)(\S+)\s*||;
 161         my $c = $1; $c = "\t" if ($c eq "");
 162         my $mnemonic = $2;
 163         my $opcode;
 164         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
 165             $opcode = eval("\$$1_$2");
 166         } else {
 167             $opcode = eval("\$$mnemonic");
 168         }
 169
 170         my $arg=expand_line($line);
 171
 172         if (ref($opcode) eq 'CODE') {
 173                 $line = &$opcode($arg);
 174         } elsif ($mnemonic)         {
 175                 $line = $c.$mnemonic;
 176                 $line.= "\t$arg" if ($arg ne "");
 177         }
 178     }
 179
 180     print $line if ($line);
 181     print "\n";
 182 }
 183
 184 close STDOUT;