xref: /openssl/crypto/perlasm/arm-xlate.pl (revision da1c088f) 
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
9use strict;
10
11my $flavour = shift;
12my $output = shift;
13open STDOUT,">$output" || die "can't open $output: $!";
14
15$flavour = "linux32" if (!$flavour or $flavour eq "void");
16
17my %GLOBALS;
18my $dotinlocallabels=($flavour=~/linux/)?1:0;
19
20################################################################
21# directives which need special treatment on different platforms
22################################################################
23my $arch = sub {
24    if ($flavour =~ /linux/)	{ ".arch\t".join(',',@_); }
25    elsif ($flavour =~ /win64/) { ".arch\t".join(',',@_); }
26    else			{ ""; }
27};
28my $fpu = sub {
29    if ($flavour =~ /linux/)	{ ".fpu\t".join(',',@_); }
30    else			{ ""; }
31};
32my $rodata = sub {
33    SWITCH: for ($flavour) {
34	/linux/		&& return ".section\t.rodata";
35	/ios/		&& return ".section\t__TEXT,__const";
36	last;
37    }
38};
39my $hidden = sub {
40    if ($flavour =~ /ios/)	{ ".private_extern\t".join(',',@_); }
41    elsif ($flavour =~ /win64/) { ""; }
42    else			{ ".hidden\t".join(',',@_); }
43};
44my $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};
62my $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};
77my $global = $globl;
78my $extern = sub {
79    &$globl(@_);
80    return;	# return nothing
81};
82my $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};
101my $size = sub {
102    if ($flavour =~ /linux/)	{ ".size\t".join(',',@_); }
103    else			{ ""; }
104};
105my $inst = sub {
106    if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
107    else                        { ".long\t".join(',',@_); }
108};
109my $asciz = sub {
110    my $line = join(",",@_);
111    if ($line =~ /^"(.*)"$/)
112    {	".byte	" . join(",",unpack("C*",$1),0) . "\n.align	2";	}
113    else
114    {	"";	}
115};
116
117my $adrp = sub {
118    my ($args,$comment) = split(m|\s*//|,shift);
119    "\tadrp\t$args\@PAGE";
120} if ($flavour =~ /ios64/);
121
122
123sub range {
124  my ($r,$sfx,$start,$end) = @_;
125
126    join(",",map("$r$_$sfx",($start..$end)));
127}
128
129sub 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
159while(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
214close STDOUT or die "error closing STDOUT: $!";
215