ARMv4 assembly pack: allow Thumb2 even in iOS build,
[openssl.git] / crypto / perlasm / arm-xlate.pl
1 #!/usr/bin/env perl
2
3 # ARM assembler distiller by <appro>.
4
5 my $flavour = shift;
6 my $output = shift;
7 open STDOUT,">$output" || die "can't open $output: $!";
8
9 $flavour = "linux32" if (!$flavour or $flavour eq "void");
10
11 my %GLOBALS;
12 my $dotinlocallabels=($flavour=~/linux/)?1:0;
13
14 ################################################################
15 # directives which need special treatment on different platforms
16 ################################################################
17 my $arch = sub {
18     if ($flavour =~ /linux/)    { ".arch\t".join(',',@_); }
19     else                        { ""; }
20 };
21 my $fpu = sub {
22     if ($flavour =~ /linux/)    { ".fpu\t".join(',',@_); }
23     else                        { ""; }
24 };
25 my $hidden = sub {
26     if ($flavour =~ /ios/)      { ".private_extern\t".join(',',@_); }
27     else                        { ".hidden\t".join(',',@_); }
28 };
29 my $comm = sub {
30     my @args = split(/,\s*/,shift);
31     my $name = @args[0];
32     my $global = \$GLOBALS{$name};
33     my $ret;
34
35     if ($flavour =~ /ios32/)    {
36         $ret = ".comm\t_$name,@args[1]\n";
37         $ret .= ".non_lazy_symbol_pointer\n";
38         $ret .= "$name:\n";
39         $ret .= ".indirect_symbol\t_$name\n";
40         $ret .= ".long\t0";
41         $name = "_$name";
42     } else                      { $ret = ".comm\t".join(',',@args); }
43
44     $$global = $name;
45     $ret;
46 };
47 my $globl = sub {
48     my $name = shift;
49     my $global = \$GLOBALS{$name};
50     my $ret;
51
52     SWITCH: for ($flavour) {
53         /ios/           && do { $name = "_$name";
54                                 last;
55                               };
56     }
57
58     $ret = ".globl      $name" if (!$ret);
59     $$global = $name;
60     $ret;
61 };
62 my $global = $globl;
63 my $extern = sub {
64     &$globl(@_);
65     return;     # return nothing
66 };
67 my $type = sub {
68     if ($flavour =~ /linux/)    { ".type\t".join(',',@_); }
69     elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
70                                         "#ifdef __thumb2__\n".
71                                         ".thumb_func    $1\n".
72                                         "#endif";
73                                   }
74                                 }
75     else                        { ""; }
76 };
77 my $size = sub {
78     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
79     else                        { ""; }
80 };
81 my $inst = sub {
82     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
83     else                        { ".long\t".join(',',@_); }
84 };
85 my $asciz = sub {
86     my $line = join(",",@_);
87     if ($line =~ /^"(.*)"$/)
88     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
89     else
90     {   "";     }
91 };
92
93 sub range {
94   my ($r,$sfx,$start,$end) = @_;
95
96     join(",",map("$r$_$sfx",($start..$end)));
97 }
98
99 sub expand_line {
100   my $line = shift;
101   my @ret = ();
102
103     pos($line)=0;
104
105     while ($line =~ m/\G[^@\/\{\"]*/g) {
106         if ($line =~ m/\G(@|\/\/|$)/gc) {
107             last;
108         }
109         elsif ($line =~ m/\G\{/gc) {
110             my $saved_pos = pos($line);
111             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
112             pos($line) = $saved_pos;
113             $line =~ m/\G[^\}]*\}/g;
114         }
115         elsif ($line =~ m/\G\"/gc) {
116             $line =~ m/\G[^\"]*\"/g;
117         }
118     }
119
120     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
121
122     return $line;
123 }
124
125 while($line=<>) {
126
127     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
128
129     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
130     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
131     $line =~ s|\s+$||;          # ... and at the end
132
133     {
134         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
135         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
136     }
137
138     {
139         $line =~ s|(^[\.\w]+)\:\s*||;
140         my $label = $1;
141         if ($label) {
142             printf "%s:",($GLOBALS{$label} or $label);
143         }
144     }
145
146     if ($line !~ m/^[#@]/) {
147         $line =~ s|^\s*(\.?)(\S+)\s*||;
148         my $c = $1; $c = "\t" if ($c eq "");
149         my $mnemonic = $2;
150         my $opcode;
151         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
152             $opcode = eval("\$$1_$2");
153         } else {
154             $opcode = eval("\$$mnemonic");
155         }
156
157         my $arg=expand_line($line);
158
159         if (ref($opcode) eq 'CODE') {
160                 $line = &$opcode($arg);
161         } elsif ($mnemonic)         {
162                 $line = $c.$mnemonic;
163                 $line.= "\t$arg" if ($arg ne "");
164         }
165     }
166
167     print $line if ($line);
168     print "\n";
169 }
170
171 close STDOUT;