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
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 $hidden = sub {
33    if ($flavour =~ /ios/)	{ ".private_extern\t".join(',',@_); }
34    elsif ($flavour =~ /win64/) { ""; }
35    else			{ ".hidden\t".join(',',@_); }
36};
37my $comm = sub {
38    my @args = split(/,\s*/,shift);
39    my $name = @args[0];
40    my $global = \$GLOBALS{$name};
41    my $ret;
42
43    if ($flavour =~ /ios32/)	{
44	$ret = ".comm\t_$name,@args[1]\n";
45	$ret .= ".non_lazy_symbol_pointer\n";
46	$ret .= "$name:\n";
47	$ret .= ".indirect_symbol\t_$name\n";
48	$ret .= ".long\t0";
49	$name = "_$name";
50    } else			{ $ret = ".comm\t".join(',',@args); }
51
52    $$global = $name;
53    $ret;
54};
55my $globl = sub {
56    my $name = shift;
57    my $global = \$GLOBALS{$name};
58    my $ret;
59
60    SWITCH: for ($flavour) {
61	/ios/		&& do { $name = "_$name";
62				last;
63			      };
64    }
65
66    $ret = ".globl	$name\n";
67    # All symbols in assembly files are hidden.
68    $ret .= &$hidden($name);
69    $$global = $name;
70    $ret;
71};
72my $global = $globl;
73my $extern = sub {
74    &$globl(@_);
75    return;	# return nothing
76};
77my $type = sub {
78    if ($flavour =~ /linux/)	{ ".type\t".join(',',@_); }
79    elsif ($flavour =~ /ios32/)	{ if (join(',',@_) =~ /(\w+),%function/) {
80					"#ifdef __thumb2__\n".
81					".thumb_func	$1\n".
82					"#endif";
83				  }
84			        }
85    elsif ($flavour =~ /win64/) { if (join(',',@_) =~ /(\w+),%function/) {
86                # See https://sourceware.org/binutils/docs/as/Pseudo-Ops.html
87                # Per https://docs.microsoft.com/en-us/windows/win32/debug/pe-format#coff-symbol-table,
88                # the type for functions is 0x20, or 32.
89                ".def $1\n".
90                "   .type 32\n".
91                ".endef";
92            }
93        }
94    else			{ ""; }
95};
96my $size = sub {
97    if ($flavour =~ /linux/)	{ ".size\t".join(',',@_); }
98    else			{ ""; }
99};
100my $inst = sub {
101    if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
102    else                        { ".long\t".join(',',@_); }
103};
104my $asciz = sub {
105    my $line = join(",",@_);
106    if ($line =~ /^"(.*)"$/)
107    {	".byte	" . join(",",unpack("C*",$1),0) . "\n.align	2";	}
108    else
109    {	"";	}
110};
111my $section = sub {
112    if ($flavour =~ /ios/) {
113        if ($_[0] eq ".rodata") {
114            return ".section\t__TEXT,__const";
115        }
116        die "Unknown section name $_[0]";
117    } else {
118        return ".section\t" . join(",", @_);
119    }
120};
121
122sub range {
123  my ($r,$sfx,$start,$end) = @_;
124
125    join(",",map("$r$_$sfx",($start..$end)));
126}
127
128sub expand_line {
129  my $line = shift;
130  my @ret = ();
131
132    pos($line)=0;
133
134    while ($line =~ m/\G[^@\/\{\"]*/g) {
135	if ($line =~ m/\G(@|\/\/|$)/gc) {
136	    last;
137	}
138	elsif ($line =~ m/\G\{/gc) {
139	    my $saved_pos = pos($line);
140	    $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
141	    pos($line) = $saved_pos;
142	    $line =~ m/\G[^\}]*\}/g;
143	}
144	elsif ($line =~ m/\G\"/gc) {
145	    $line =~ m/\G[^\"]*\"/g;
146	}
147    }
148
149    $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
150
151    return $line;
152}
153
154my ($arch_defines, $target_defines);
155if ($flavour =~ /32/) {
156    $arch_defines = "defined(OPENSSL_ARM)";
157} elsif ($flavour =~ /64/) {
158    $arch_defines = "defined(OPENSSL_AARCH64)";
159} else {
160    die "unknown architecture: $flavour";
161}
162if ($flavour =~ /linux/) {
163    # Although the flavour is specified as "linux", it is really used by all
164    # ELF platforms.
165    $target_defines = "defined(__ELF__)";
166} elsif ($flavour =~ /ios/) {
167    # Although the flavour is specified as "ios", it is really used by all Apple
168    # platforms.
169    $target_defines = "defined(__APPLE__)";
170} elsif ($flavour =~ /win/) {
171    $target_defines = "defined(_WIN32)";
172} else {
173    die "unknown target: $flavour";
174}
175
176print <<___;
177// This file is generated from a similarly-named Perl script in the BoringSSL
178// source tree. Do not edit by hand.
179
180#include <ring-core/asm_base.h>
181
182#if !defined(OPENSSL_NO_ASM) && $arch_defines && $target_defines
183___
184
185while(my $line=<>) {
186
187    if ($line =~ m/^\s*(#|@|\/\/)/)	{ print $line; next; }
188
189    $line =~ s|/\*.*\*/||;	# get rid of C-style comments...
190    $line =~ s|^\s+||;		# ... and skip white spaces in beginning...
191    $line =~ s|\s+$||;		# ... and at the end
192
193    if ($flavour =~ /64/) {
194	my $copy = $line;
195	# Also remove line comments.
196	$copy =~ s|//.*||;
197	if ($copy =~ /\b[wx]18\b/) {
198	    die "r18 is reserved by the platform and may not be used.";
199	}
200    }
201
202    {
203	$line =~ s|[\b\.]L(\w{2,})|L$1|g;	# common denominator for Locallabel
204	$line =~ s|\bL(\w{2,})|\.L$1|g	if ($dotinlocallabels);
205    }
206
207    {
208	$line =~ s|(^[\.\w]+)\:\s*||;
209	my $label = $1;
210	if ($label) {
211	    printf "%s:",($GLOBALS{$label} or $label);
212	}
213    }
214
215    if ($line !~ m/^[#@]/) {
216	$line =~ s|^\s*(\.?)(\S+)\s*||;
217	my $c = $1; $c = "\t" if ($c eq "");
218	my $mnemonic = $2;
219	my $opcode;
220	if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
221	    $opcode = eval("\$$1_$2");
222	} else {
223	    $opcode = eval("\$$mnemonic");
224	}
225
226	if ($flavour =~ /ios/) {
227	    # Mach-O and ELF use different syntax for these relocations. Note
228	    # that we require :pg_hi21: to be explicitly listed. It is normally
229	    # optional with adrp instructions.
230	    $line =~ s|:pg_hi21:(\w+)|\1\@PAGE|;
231	    $line =~ s|:lo12:(\w+)|\1\@PAGEOFF|;
232	} else {
233	    # Clang's integrated assembly does not support the optional
234	    # :pg_hi21: markers, so erase them.
235	    $line =~ s|:pg_hi21:||;
236	}
237
238	my $arg=expand_line($line);
239
240	if (ref($opcode) eq 'CODE') {
241		$line = &$opcode($arg);
242	} elsif ($mnemonic)         {
243		$line = $c.$mnemonic;
244		$line.= "\t$arg" if ($arg ne "");
245	}
246    }
247
248    print $line if ($line);
249    print "\n";
250}
251
252print <<___;
253#endif  // !OPENSSL_NO_ASM && $arch_defines && $target_defines
254___
255
256close STDOUT or die "error closing STDOUT: $!";
257