crypto/perlasm/arm-xlate.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2015-2023 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     elsif ($flavour =~ /win64/) { ".arch\t".join(',',@_); }
  26     else                        { ""; }
  27 };
  28 my $fpu = sub {
  29     if ($flavour =~ /linux/)    { ".fpu\t".join(',',@_); }
  30     else                        { ""; }
  31 };
  32 my $rodata = sub {
  33     SWITCH: for ($flavour) {
  34         /linux/         && return ".section\t.rodata";
  35         /ios/           && return ".section\t__TEXT,__const";
  36         last;
  37     }
  38 };
  39 my $hidden = sub {
  40     if ($flavour =~ /ios/)      { ".private_extern\t".join(',',@_); }
  41     elsif ($flavour =~ /win64/) { ""; }
  42     else                        { ".hidden\t".join(',',@_); }
  43 };
  44 my $comm = sub {
  45     my @args = split(/,\s*/,shift);
  46     my $name = @args[0];
  47     my $global = \$GLOBALS{$name};
  48     my $ret;
  49
  50     if ($flavour =~ /ios32/)    {
  51         $ret = ".comm\t_$name,@args[1]\n";
  52         $ret .= ".non_lazy_symbol_pointer\n";
  53         $ret .= "$name:\n";
  54         $ret .= ".indirect_symbol\t_$name\n";
  55         $ret .= ".long\t0";
  56         $name = "_$name";
  57     } else                      { $ret = ".comm\t".join(',',@args); }
  58
  59     $$global = $name;
  60     $ret;
  61 };
  62 my $globl = sub {
  63     my $name = shift;
  64     my $global = \$GLOBALS{$name};
  65     my $ret;
  66
  67     SWITCH: for ($flavour) {
  68         /ios/           && do { $name = "_$name";
  69                                 last;
  70                               };
  71     }
  72
  73     $ret = ".globl      $name" if (!$ret);
  74     $$global = $name;
  75     $ret;
  76 };
  77 my $global = $globl;
  78 my $extern = sub {
  79     &$globl(@_);
  80     return;     # return nothing
  81 };
  82 my $type = sub {
  83     if ($flavour =~ /linux/)    { ".type\t".join(',',@_); }
  84     elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
  85                                         "#ifdef __thumb2__\n".
  86                                         ".thumb_func    $1\n".
  87                                         "#endif";
  88                                   }
  89                                 }
  90     elsif ($flavour =~ /win64/) { if (join(',',@_) =~ /(\w+),%function/) {
  91                 # See https://sourceware.org/binutils/docs/as/Pseudo-Ops.html
  92                 # Per https://docs.microsoft.com/en-us/windows/win32/debug/pe-format#coff-symbol-table,
  93                 # the type for functions is 0x20, or 32.
  94                 ".def $1\n".
  95                 "   .type 32\n".
  96                 ".endef";
  97             }
  98         }
  99     else                        { ""; }
 100 };
 101 my $size = sub {
 102     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
 103     else                        { ""; }
 104 };
 105 my $inst = sub {
 106     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
 107     else                        { ".long\t".join(',',@_); }
 108 };
 109 my $asciz = sub {
 110     my $line = join(",",@_);
 111     if ($line =~ /^"(.*)"$/)
 112     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
 113     else
 114     {   "";     }
 115 };
 116
 117 my $adrp = sub {
 118     my ($args,$comment) = split(m|\s*//|,shift);
 119     "\tadrp\t$args\@PAGE";
 120 } if ($flavour =~ /ios64/);
 121
 122
 123 sub range {
 124   my ($r,$sfx,$start,$end) = @_;
 125
 126     join(",",map("$r$_$sfx",($start..$end)));
 127 }
 128
 129 sub expand_line {
 130   my $line = shift;
 131   my @ret = ();
 132
 133     pos($line)=0;
 134
 135     while ($line =~ m/\G[^@\/\{\"]*/g) {
 136         if ($line =~ m/\G(@|\/\/|$)/gc) {
 137             last;
 138         }
 139         elsif ($line =~ m/\G\{/gc) {
 140             my $saved_pos = pos($line);
 141             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
 142             pos($line) = $saved_pos;
 143             $line =~ m/\G[^\}]*\}/g;
 144         }
 145         elsif ($line =~ m/\G\"/gc) {
 146             $line =~ m/\G[^\"]*\"/g;
 147         }
 148     }
 149
 150     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
 151
 152     if ($flavour =~ /ios64/) {
 153         $line =~ s/#:lo12:(\w+)/$1\@PAGEOFF/;
 154     }
 155
 156     return $line;
 157 }
 158
 159 while(my $line=<>) {
 160
 161     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
 162
 163     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
 164     $line =~ s|^\s+||;          # ... and skip whitespace in beginning...
 165     $line =~ s|\s+$||;          # ... and at the end
 166
 167     {
 168         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
 169         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
 170     }
 171
 172     {
 173         if ($line =~ s|(^[\.\w]+)\:\s*||) {
 174             my $label = $1;
 175             printf "%s:",($GLOBALS{$label} or $label);
 176         }
 177     }
 178
 179     if ($line !~ m/^[#@]/) {
 180         $line =~ s|^\s*(\.?)(\S+)\s*||;
 181         my $c = $1; $c = "\t" if ($c eq "");
 182         my $mnemonic = $2;
 183         my $opcode;
 184         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
 185             $opcode = eval("\$$1_$2");
 186         } else {
 187             $opcode = eval("\$$mnemonic");
 188         }
 189
 190         my $arg=expand_line($line);
 191
 192         if (ref($opcode) eq 'CODE') {
 193                 $line = &$opcode($arg);
 194         } elsif ($mnemonic)         {
 195                 $line = $c.$mnemonic;
 196                 $line.= "\t$arg" if ($arg ne "");
 197         }
 198     }
 199
 200     # ldr REG, #VALUE psuedo-instruction - avoid clang issue with Neon registers
 201     #
 202     if ($line =~ /^\s*ldr\s+([qd]\d\d?)\s*,\s*=(\w+)/i) {
 203         # Immediate load via literal pool into qN or DN - clang max is 2^32-1
 204         my ($reg, $value) = ($1, $2);
 205         # If $value is hex, 0x + 8 hex chars = 10 chars total will be okay
 206         # If $value is decimal, 2^32 - 1 = 4294967295 will be okay (also 10 chars)
 207         die("$line: immediate load via literal pool into $reg: value too large for clang - redo manually") if length($value) > 10;
 208     }
 209
 210     print $line if ($line);
 211     print "\n";
 212 }
 213
 214 close STDOUT or die "error closing STDOUT: $!";