Home | History | Annotate | Download | only in perlasm
      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 
      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\n";
     65     # All symbols in assembly files are hidden.
     66     $ret .= &$hidden($name);
     67     $$global = $name;
     68     $ret;
     69 };
     70 my $global = $globl;
     71 my $extern = sub {
     72     &$globl(@_);
     73     return;	# return nothing
     74 };
     75 my $type = sub {
     76     if ($flavour =~ /linux/)	{ ".type\t".join(',',@_); }
     77     elsif ($flavour =~ /ios32/)	{ if (join(',',@_) =~ /(\w+),%function/) {
     78 					"#ifdef __thumb2__\n".
     79 					".thumb_func	$1\n".
     80 					"#endif";
     81 				  }
     82 			        }
     83     else			{ ""; }
     84 };
     85 my $size = sub {
     86     if ($flavour =~ /linux/)	{ ".size\t".join(',',@_); }
     87     else			{ ""; }
     88 };
     89 my $inst = sub {
     90     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
     91     else                        { ".long\t".join(',',@_); }
     92 };
     93 my $asciz = sub {
     94     my $line = join(",",@_);
     95     if ($line =~ /^"(.*)"$/)
     96     {	".byte	" . join(",",unpack("C*",$1),0) . "\n.align	2";	}
     97     else
     98     {	"";	}
     99 };
    100 
    101 sub range {
    102   my ($r,$sfx,$start,$end) = @_;
    103 
    104     join(",",map("$r$_$sfx",($start..$end)));
    105 }
    106 
    107 sub expand_line {
    108   my $line = shift;
    109   my @ret = ();
    110 
    111     pos($line)=0;
    112 
    113     while ($line =~ m/\G[^@\/\{\"]*/g) {
    114 	if ($line =~ m/\G(@|\/\/|$)/gc) {
    115 	    last;
    116 	}
    117 	elsif ($line =~ m/\G\{/gc) {
    118 	    my $saved_pos = pos($line);
    119 	    $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
    120 	    pos($line) = $saved_pos;
    121 	    $line =~ m/\G[^\}]*\}/g;
    122 	}
    123 	elsif ($line =~ m/\G\"/gc) {
    124 	    $line =~ m/\G[^\"]*\"/g;
    125 	}
    126     }
    127 
    128     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
    129 
    130     return $line;
    131 }
    132 
    133 print "#if defined(__arm__)\n" if ($flavour eq "linux32");
    134 print "#if defined(__aarch64__)\n" if ($flavour eq "linux64");
    135 
    136 while(my $line=<>) {
    137 
    138     if ($line =~ m/^\s*(#|@|\/\/)/)	{ print $line; next; }
    139 
    140     $line =~ s|/\*.*\*/||;	# get rid of C-style comments...
    141     $line =~ s|^\s+||;		# ... and skip white spaces in beginning...
    142     $line =~ s|\s+$||;		# ... and at the end
    143 
    144     {
    145 	$line =~ s|[\b\.]L(\w{2,})|L$1|g;	# common denominator for Locallabel
    146 	$line =~ s|\bL(\w{2,})|\.L$1|g	if ($dotinlocallabels);
    147     }
    148 
    149     {
    150 	$line =~ s|(^[\.\w]+)\:\s*||;
    151 	my $label = $1;
    152 	if ($label) {
    153 	    printf "%s:",($GLOBALS{$label} or $label);
    154 	}
    155     }
    156 
    157     if ($line !~ m/^[#@]/) {
    158 	$line =~ s|^\s*(\.?)(\S+)\s*||;
    159 	my $c = $1; $c = "\t" if ($c eq "");
    160 	my $mnemonic = $2;
    161 	my $opcode;
    162 	if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
    163 	    $opcode = eval("\$$1_$2");
    164 	} else {
    165 	    $opcode = eval("\$$mnemonic");
    166 	}
    167 
    168 	my $arg=expand_line($line);
    169 
    170 	if (ref($opcode) eq 'CODE') {
    171 		$line = &$opcode($arg);
    172 	} elsif ($mnemonic)         {
    173 		$line = $c.$mnemonic;
    174 		$line.= "\t$arg" if ($arg ne "");
    175 	}
    176     }
    177 
    178     print $line if ($line);
    179     print "\n";
    180 }
    181 
    182 print "#endif\n" if ($flavour eq "linux32" || $flavour eq "linux64");
    183 
    184 close STDOUT;
    185