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