]>
Commit | Line | Data |
---|---|---|
1 | #! /usr/bin/env perl | |
2 | # Copyright 2006-2018 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 | my $flavour = shift; | |
10 | my $output = shift; | |
11 | open STDOUT,">$output" || die "can't open $output: $!"; | |
12 | ||
13 | my %GLOBALS; | |
14 | my %TYPES; | |
15 | my $dotinlocallabels=($flavour=~/linux/)?1:0; | |
16 | ||
17 | ################################################################ | |
18 | # directives which need special treatment on different platforms | |
19 | ################################################################ | |
20 | my $type = sub { | |
21 | my ($dir,$name,$type) = @_; | |
22 | ||
23 | $TYPES{$name} = $type; | |
24 | if ($flavour =~ /linux/) { | |
25 | $name =~ s|^\.||; | |
26 | ".type $name,$type"; | |
27 | } else { | |
28 | ""; | |
29 | } | |
30 | }; | |
31 | my $globl = sub { | |
32 | my $junk = shift; | |
33 | my $name = shift; | |
34 | my $global = \$GLOBALS{$name}; | |
35 | my $type = \$TYPES{$name}; | |
36 | my $ret; | |
37 | ||
38 | $name =~ s|^\.||; | |
39 | ||
40 | SWITCH: for ($flavour) { | |
41 | /aix/ && do { if (!$$type) { | |
42 | $$type = "\@function"; | |
43 | } | |
44 | if ($$type =~ /function/) { | |
45 | $name = ".$name"; | |
46 | } | |
47 | last; | |
48 | }; | |
49 | /osx/ && do { $name = "_$name"; | |
50 | last; | |
51 | }; | |
52 | /linux.*(32|64le)/ | |
53 | && do { $ret .= ".globl $name"; | |
54 | if (!$$type) { | |
55 | $ret .= "\n.type $name,\@function"; | |
56 | $$type = "\@function"; | |
57 | } | |
58 | last; | |
59 | }; | |
60 | /linux.*64/ && do { $ret .= ".globl $name"; | |
61 | if (!$$type) { | |
62 | $ret .= "\n.type $name,\@function"; | |
63 | $$type = "\@function"; | |
64 | } | |
65 | if ($$type =~ /function/) { | |
66 | $ret .= "\n.section \".opd\",\"aw\""; | |
67 | $ret .= "\n.align 3"; | |
68 | $ret .= "\n$name:"; | |
69 | $ret .= "\n.quad .$name,.TOC.\@tocbase,0"; | |
70 | $ret .= "\n.previous"; | |
71 | $name = ".$name"; | |
72 | } | |
73 | last; | |
74 | }; | |
75 | } | |
76 | ||
77 | $ret = ".globl $name" if (!$ret); | |
78 | $$global = $name; | |
79 | $ret; | |
80 | }; | |
81 | my $text = sub { | |
82 | my $ret = ($flavour =~ /aix/) ? ".csect\t.text[PR],7" : ".text"; | |
83 | $ret = ".abiversion 2\n".$ret if ($flavour =~ /linux.*64le/); | |
84 | $ret; | |
85 | }; | |
86 | my $machine = sub { | |
87 | my $junk = shift; | |
88 | my $arch = shift; | |
89 | if ($flavour =~ /osx/) | |
90 | { $arch =~ s/\"//g; | |
91 | $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); | |
92 | } | |
93 | ".machine $arch"; | |
94 | }; | |
95 | my $size = sub { | |
96 | if ($flavour =~ /linux/) | |
97 | { shift; | |
98 | my $name = shift; | |
99 | my $real = $GLOBALS{$name} ? \$GLOBALS{$name} : \$name; | |
100 | my $ret = ".size $$real,.-$$real"; | |
101 | $name =~ s|^\.||; | |
102 | if ($$real ne $name) { | |
103 | $ret .= "\n.size $name,.-$$real"; | |
104 | } | |
105 | $ret; | |
106 | } | |
107 | else | |
108 | { ""; } | |
109 | }; | |
110 | my $asciz = sub { | |
111 | shift; | |
112 | my $line = join(",",@_); | |
113 | if ($line =~ /^"(.*)"$/) | |
114 | { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } | |
115 | else | |
116 | { ""; } | |
117 | }; | |
118 | my $quad = sub { | |
119 | shift; | |
120 | my @ret; | |
121 | my ($hi,$lo); | |
122 | for (@_) { | |
123 | if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io) | |
124 | { $hi=$1?"0x$1":"0"; $lo="0x$2"; } | |
125 | elsif (/^([0-9]+)$/o) | |
126 | { $hi=$1>>32; $lo=$1&0xffffffff; } # error-prone with 32-bit perl | |
127 | else | |
128 | { $hi=undef; $lo=$_; } | |
129 | ||
130 | if (defined($hi)) | |
131 | { push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo"); } | |
132 | else | |
133 | { push(@ret,".quad $lo"); } | |
134 | } | |
135 | join("\n",@ret); | |
136 | }; | |
137 | ||
138 | ################################################################ | |
139 | # simplified mnemonics not handled by at least one assembler | |
140 | ################################################################ | |
141 | my $cmplw = sub { | |
142 | my $f = shift; | |
143 | my $cr = 0; $cr = shift if ($#_>1); | |
144 | # Some out-of-date 32-bit GNU assembler just can't handle cmplw... | |
145 | ($flavour =~ /linux.*32/) ? | |
146 | " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : | |
147 | " cmplw ".join(',',$cr,@_); | |
148 | }; | |
149 | my $bdnz = sub { | |
150 | my $f = shift; | |
151 | my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint | |
152 | " bc $bo,0,".shift; | |
153 | } if ($flavour!~/linux/); | |
154 | my $bltlr = sub { | |
155 | my $f = shift; | |
156 | my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint | |
157 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
158 | " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 : | |
159 | " bclr $bo,0"; | |
160 | }; | |
161 | my $bnelr = sub { | |
162 | my $f = shift; | |
163 | my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint | |
164 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
165 | " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 : | |
166 | " bclr $bo,2"; | |
167 | }; | |
168 | my $beqlr = sub { | |
169 | my $f = shift; | |
170 | my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint | |
171 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
172 | " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : | |
173 | " bclr $bo,2"; | |
174 | }; | |
175 | # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two | |
176 | # arguments is 64, with "operand out of range" error. | |
177 | my $extrdi = sub { | |
178 | my ($f,$ra,$rs,$n,$b) = @_; | |
179 | $b = ($b+$n)&63; $n = 64-$n; | |
180 | " rldicl $ra,$rs,$b,$n"; | |
181 | }; | |
182 | my $vmr = sub { | |
183 | my ($f,$vx,$vy) = @_; | |
184 | " vor $vx,$vy,$vy"; | |
185 | }; | |
186 | ||
187 | # Some ABIs specify vrsave, special-purpose register #256, as reserved | |
188 | # for system use. | |
189 | my $no_vrsave = ($flavour =~ /aix|linux64le/); | |
190 | my $mtspr = sub { | |
191 | my ($f,$idx,$ra) = @_; | |
192 | if ($idx == 256 && $no_vrsave) { | |
193 | " or $ra,$ra,$ra"; | |
194 | } else { | |
195 | " mtspr $idx,$ra"; | |
196 | } | |
197 | }; | |
198 | my $mfspr = sub { | |
199 | my ($f,$rd,$idx) = @_; | |
200 | if ($idx == 256 && $no_vrsave) { | |
201 | " li $rd,-1"; | |
202 | } else { | |
203 | " mfspr $rd,$idx"; | |
204 | } | |
205 | }; | |
206 | ||
207 | # PowerISA 2.06 stuff | |
208 | sub vsxmem_op { | |
209 | my ($f, $vrt, $ra, $rb, $op) = @_; | |
210 | " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|($rb<<11)|($op*2+1); | |
211 | } | |
212 | # made-up unaligned memory reference AltiVec/VMX instructions | |
213 | my $lvx_u = sub { vsxmem_op(@_, 844); }; # lxvd2x | |
214 | my $stvx_u = sub { vsxmem_op(@_, 972); }; # stxvd2x | |
215 | my $lvdx_u = sub { vsxmem_op(@_, 588); }; # lxsdx | |
216 | my $stvdx_u = sub { vsxmem_op(@_, 716); }; # stxsdx | |
217 | my $lvx_4w = sub { vsxmem_op(@_, 780); }; # lxvw4x | |
218 | my $stvx_4w = sub { vsxmem_op(@_, 908); }; # stxvw4x | |
219 | my $lvx_splt = sub { vsxmem_op(@_, 332); }; # lxvdsx | |
220 | # VSX instruction[s] masqueraded as made-up AltiVec/VMX | |
221 | my $vpermdi = sub { # xxpermdi | |
222 | my ($f, $vrt, $vra, $vrb, $dm) = @_; | |
223 | $dm = oct($dm) if ($dm =~ /^0/); | |
224 | " .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($dm<<8)|(10<<3)|7; | |
225 | }; | |
226 | ||
227 | # PowerISA 2.07 stuff | |
228 | sub vcrypto_op { | |
229 | my ($f, $vrt, $vra, $vrb, $op) = @_; | |
230 | " .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op; | |
231 | } | |
232 | sub vfour { | |
233 | my ($f, $vrt, $vra, $vrb, $vrc, $op) = @_; | |
234 | " .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($vrc<<6)|$op; | |
235 | }; | |
236 | my $vcipher = sub { vcrypto_op(@_, 1288); }; | |
237 | my $vcipherlast = sub { vcrypto_op(@_, 1289); }; | |
238 | my $vncipher = sub { vcrypto_op(@_, 1352); }; | |
239 | my $vncipherlast= sub { vcrypto_op(@_, 1353); }; | |
240 | my $vsbox = sub { vcrypto_op(@_, 0, 1480); }; | |
241 | my $vshasigmad = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); }; | |
242 | my $vshasigmaw = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); }; | |
243 | my $vpmsumb = sub { vcrypto_op(@_, 1032); }; | |
244 | my $vpmsumd = sub { vcrypto_op(@_, 1224); }; | |
245 | my $vpmsubh = sub { vcrypto_op(@_, 1096); }; | |
246 | my $vpmsumw = sub { vcrypto_op(@_, 1160); }; | |
247 | # These are not really crypto, but vcrypto_op template works | |
248 | my $vaddudm = sub { vcrypto_op(@_, 192); }; | |
249 | my $vadduqm = sub { vcrypto_op(@_, 256); }; | |
250 | my $vmuleuw = sub { vcrypto_op(@_, 648); }; | |
251 | my $vmulouw = sub { vcrypto_op(@_, 136); }; | |
252 | my $vrld = sub { vcrypto_op(@_, 196); }; | |
253 | my $vsld = sub { vcrypto_op(@_, 1476); }; | |
254 | my $vsrd = sub { vcrypto_op(@_, 1732); }; | |
255 | my $vsubudm = sub { vcrypto_op(@_, 1216); }; | |
256 | my $vaddcuq = sub { vcrypto_op(@_, 320); }; | |
257 | my $vaddeuqm = sub { vfour(@_,60); }; | |
258 | my $vaddecuq = sub { vfour(@_,61); }; | |
259 | my $vmrgew = sub { vfour(@_,0,1932); }; | |
260 | my $vmrgow = sub { vfour(@_,0,1676); }; | |
261 | ||
262 | my $mtsle = sub { | |
263 | my ($f, $arg) = @_; | |
264 | " .long ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2); | |
265 | }; | |
266 | ||
267 | # VSX instructions masqueraded as AltiVec/VMX | |
268 | my $mtvrd = sub { | |
269 | my ($f, $vrt, $ra) = @_; | |
270 | " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(179<<1)|1; | |
271 | }; | |
272 | my $mtvrwz = sub { | |
273 | my ($f, $vrt, $ra) = @_; | |
274 | " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(243<<1)|1; | |
275 | }; | |
276 | ||
277 | # PowerISA 3.0 stuff | |
278 | my $maddhdu = sub { vfour(@_,49); }; | |
279 | my $maddld = sub { vfour(@_,51); }; | |
280 | my $darn = sub { | |
281 | my ($f, $rt, $l) = @_; | |
282 | " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($l<<16)|(755<<1); | |
283 | }; | |
284 | my $iseleq = sub { | |
285 | my ($f, $rt, $ra, $rb) = @_; | |
286 | " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|(2<<6)|30; | |
287 | }; | |
288 | # VSX instruction[s] masqueraded as made-up AltiVec/VMX | |
289 | my $vspltib = sub { # xxspltib | |
290 | my ($f, $vrt, $imm8) = @_; | |
291 | $imm8 = oct($imm8) if ($imm8 =~ /^0/); | |
292 | $imm8 &= 0xff; | |
293 | " .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($imm8<<11)|(360<<1)|1; | |
294 | }; | |
295 | ||
296 | # PowerISA 3.0B stuff | |
297 | my $addex = sub { | |
298 | my ($f, $rt, $ra, $rb, $cy) = @_; # only cy==0 is specified in 3.0B | |
299 | " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|($cy<<9)|(170<<1); | |
300 | }; | |
301 | my $vmsumudm = sub { vfour(@_,35); }; | |
302 | ||
303 | while($line=<>) { | |
304 | ||
305 | $line =~ s|[#!;].*$||; # get rid of asm-style comments... | |
306 | $line =~ s|/\*.*\*/||; # ... and C-style comments... | |
307 | $line =~ s|^\s+||; # ... and skip white spaces in beginning... | |
308 | $line =~ s|\s+$||; # ... and at the end | |
309 | ||
310 | { | |
311 | $line =~ s|\.L(\w+)|L$1|g; # common denominator for Locallabel | |
312 | $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); | |
313 | } | |
314 | ||
315 | { | |
316 | $line =~ s|(^[\.\w]+)\:\s*||; | |
317 | my $label = $1; | |
318 | if ($label) { | |
319 | my $xlated = ($GLOBALS{$label} or $label); | |
320 | print "$xlated:"; | |
321 | if ($flavour =~ /linux.*64le/) { | |
322 | if ($TYPES{$label} =~ /function/) { | |
323 | printf "\n.localentry %s,0\n",$xlated; | |
324 | } | |
325 | } | |
326 | } | |
327 | } | |
328 | ||
329 | { | |
330 | $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; | |
331 | my $c = $1; $c = "\t" if ($c eq ""); | |
332 | my $mnemonic = $2; | |
333 | my $f = $3; | |
334 | my $opcode = eval("\$$mnemonic"); | |
335 | $line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/); | |
336 | if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(/,\s*/,$line)); } | |
337 | elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } | |
338 | } | |
339 | ||
340 | print $line if ($line); | |
341 | print "\n"; | |
342 | } | |
343 | ||
344 | close STDOUT or die "error closing STDOUT: $!"; |