d78a8baac1282710e65d0c8dfd15726c1a5577c9
[openssl.git] / 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 $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;