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