diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm')
-rw-r--r-- | src/lib/libcrypto/perlasm/alpha.pl | 434 | ||||
-rwxr-xr-x | src/lib/libcrypto/perlasm/x86_64-xlate.pl | 625 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86asm.pl | 333 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86gas.pl | 24 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86ms.pl | 472 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86nasm.pl | 559 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86unix.pl | 808 |
7 files changed, 858 insertions, 2397 deletions
diff --git a/src/lib/libcrypto/perlasm/alpha.pl b/src/lib/libcrypto/perlasm/alpha.pl deleted file mode 100644 index 3dac571743..0000000000 --- a/src/lib/libcrypto/perlasm/alpha.pl +++ /dev/null | |||
@@ -1,434 +0,0 @@ | |||
1 | #!/usr/local/bin/perl | ||
2 | |||
3 | package alpha; | ||
4 | use Carp qw(croak cluck); | ||
5 | |||
6 | $label="100"; | ||
7 | |||
8 | $n_debug=0; | ||
9 | $smear_regs=1; | ||
10 | $reg_alloc=1; | ||
11 | |||
12 | $align="3"; | ||
13 | $com_start="#"; | ||
14 | |||
15 | sub main'asm_init_output { @out=(); } | ||
16 | sub main'asm_get_output { return(@out); } | ||
17 | sub main'get_labels { return(@labels); } | ||
18 | sub main'external_label { push(@labels,@_); } | ||
19 | |||
20 | # General registers | ||
21 | |||
22 | %regs=( 'r0', '$0', | ||
23 | 'r1', '$1', | ||
24 | 'r2', '$2', | ||
25 | 'r3', '$3', | ||
26 | 'r4', '$4', | ||
27 | 'r5', '$5', | ||
28 | 'r6', '$6', | ||
29 | 'r7', '$7', | ||
30 | 'r8', '$8', | ||
31 | 'r9', '$22', | ||
32 | 'r10', '$23', | ||
33 | 'r11', '$24', | ||
34 | 'r12', '$25', | ||
35 | 'r13', '$27', | ||
36 | 'r14', '$28', | ||
37 | 'r15', '$21', # argc == 5 | ||
38 | 'r16', '$20', # argc == 4 | ||
39 | 'r17', '$19', # argc == 3 | ||
40 | 'r18', '$18', # argc == 2 | ||
41 | 'r19', '$17', # argc == 1 | ||
42 | 'r20', '$16', # argc == 0 | ||
43 | 'r21', '$9', # save 0 | ||
44 | 'r22', '$10', # save 1 | ||
45 | 'r23', '$11', # save 2 | ||
46 | 'r24', '$12', # save 3 | ||
47 | 'r25', '$13', # save 4 | ||
48 | 'r26', '$14', # save 5 | ||
49 | |||
50 | 'a0', '$16', | ||
51 | 'a1', '$17', | ||
52 | 'a2', '$18', | ||
53 | 'a3', '$19', | ||
54 | 'a4', '$20', | ||
55 | 'a5', '$21', | ||
56 | |||
57 | 's0', '$9', | ||
58 | 's1', '$10', | ||
59 | 's2', '$11', | ||
60 | 's3', '$12', | ||
61 | 's4', '$13', | ||
62 | 's5', '$14', | ||
63 | 'zero', '$31', | ||
64 | 'sp', '$30', | ||
65 | ); | ||
66 | |||
67 | $main'reg_s0="r21"; | ||
68 | $main'reg_s1="r22"; | ||
69 | $main'reg_s2="r23"; | ||
70 | $main'reg_s3="r24"; | ||
71 | $main'reg_s4="r25"; | ||
72 | $main'reg_s5="r26"; | ||
73 | |||
74 | @reg=( '$0', '$1' ,'$2' ,'$3' ,'$4' ,'$5' ,'$6' ,'$7' ,'$8', | ||
75 | '$22','$23','$24','$25','$20','$21','$27','$28'); | ||
76 | |||
77 | |||
78 | sub main'sub { &out3("subq",@_); } | ||
79 | sub main'add { &out3("addq",@_); } | ||
80 | sub main'mov { &out3("bis",$_[0],$_[0],$_[1]); } | ||
81 | sub main'or { &out3("bis",@_); } | ||
82 | sub main'bis { &out3("bis",@_); } | ||
83 | sub main'br { &out1("br",@_); } | ||
84 | sub main'ld { &out2("ldq",@_); } | ||
85 | sub main'st { &out2("stq",@_); } | ||
86 | sub main'cmpult { &out3("cmpult",@_); } | ||
87 | sub main'cmplt { &out3("cmplt",@_); } | ||
88 | sub main'bgt { &out2("bgt",@_); } | ||
89 | sub main'ble { &out2("ble",@_); } | ||
90 | sub main'blt { &out2("blt",@_); } | ||
91 | sub main'mul { &out3("mulq",@_); } | ||
92 | sub main'muh { &out3("umulh",@_); } | ||
93 | |||
94 | $main'QWS=8; | ||
95 | |||
96 | sub main'asm_add | ||
97 | { | ||
98 | push(@out,@_); | ||
99 | } | ||
100 | |||
101 | sub main'asm_finish | ||
102 | { | ||
103 | &main'file_end(); | ||
104 | print &main'asm_get_output(); | ||
105 | } | ||
106 | |||
107 | sub main'asm_init | ||
108 | { | ||
109 | ($type,$fn)=@_; | ||
110 | $filename=$fn; | ||
111 | |||
112 | &main'asm_init_output(); | ||
113 | &main'comment("Don't even think of reading this code"); | ||
114 | &main'comment("It was automatically generated by $filename"); | ||
115 | &main'comment("Which is a perl program used to generate the alpha assember."); | ||
116 | &main'comment("eric <eay\@cryptsoft.com>"); | ||
117 | &main'comment(""); | ||
118 | |||
119 | $filename =~ s/\.pl$//; | ||
120 | &main'file($filename); | ||
121 | } | ||
122 | |||
123 | sub conv | ||
124 | { | ||
125 | local($r)=@_; | ||
126 | local($v); | ||
127 | |||
128 | return($regs{$r}) if defined($regs{$r}); | ||
129 | return($r); | ||
130 | } | ||
131 | |||
132 | sub main'QWPw | ||
133 | { | ||
134 | local($off,$reg)=@_; | ||
135 | |||
136 | return(&main'QWP($off*8,$reg)); | ||
137 | } | ||
138 | |||
139 | sub main'QWP | ||
140 | { | ||
141 | local($off,$reg)=@_; | ||
142 | |||
143 | $ret="$off(".&conv($reg).")"; | ||
144 | return($ret); | ||
145 | } | ||
146 | |||
147 | sub out3 | ||
148 | { | ||
149 | local($name,$p1,$p2,$p3)=@_; | ||
150 | |||
151 | $p1=&conv($p1); | ||
152 | $p2=&conv($p2); | ||
153 | $p3=&conv($p3); | ||
154 | push(@out,"\t$name\t"); | ||
155 | $l=length($p1)+1; | ||
156 | push(@out,$p1.","); | ||
157 | $ll=3-($l+9)/8; | ||
158 | $tmp1=sprintf("\t" x $ll); | ||
159 | push(@out,$tmp1); | ||
160 | |||
161 | $l=length($p2)+1; | ||
162 | push(@out,$p2.","); | ||
163 | $ll=3-($l+9)/8; | ||
164 | $tmp1=sprintf("\t" x $ll); | ||
165 | push(@out,$tmp1); | ||
166 | |||
167 | push(@out,&conv($p3)."\n"); | ||
168 | } | ||
169 | |||
170 | sub out2 | ||
171 | { | ||
172 | local($name,$p1,$p2,$p3)=@_; | ||
173 | |||
174 | $p1=&conv($p1); | ||
175 | $p2=&conv($p2); | ||
176 | push(@out,"\t$name\t"); | ||
177 | $l=length($p1)+1; | ||
178 | push(@out,$p1.","); | ||
179 | $ll=3-($l+9)/8; | ||
180 | $tmp1=sprintf("\t" x $ll); | ||
181 | push(@out,$tmp1); | ||
182 | |||
183 | push(@out,&conv($p2)."\n"); | ||
184 | } | ||
185 | |||
186 | sub out1 | ||
187 | { | ||
188 | local($name,$p1)=@_; | ||
189 | |||
190 | $p1=&conv($p1); | ||
191 | push(@out,"\t$name\t".$p1."\n"); | ||
192 | } | ||
193 | |||
194 | sub out0 | ||
195 | { | ||
196 | push(@out,"\t$_[0]\n"); | ||
197 | } | ||
198 | |||
199 | sub main'file | ||
200 | { | ||
201 | local($file)=@_; | ||
202 | |||
203 | local($tmp)=<<"EOF"; | ||
204 | # DEC Alpha assember | ||
205 | # Generated from perl scripts contains in SSLeay | ||
206 | .file 1 "$file.s" | ||
207 | .set noat | ||
208 | EOF | ||
209 | push(@out,$tmp); | ||
210 | } | ||
211 | |||
212 | sub main'function_begin | ||
213 | { | ||
214 | local($func)=@_; | ||
215 | |||
216 | print STDERR "$func\n"; | ||
217 | local($tmp)=<<"EOF"; | ||
218 | .text | ||
219 | .align $align | ||
220 | .globl $func | ||
221 | .ent $func | ||
222 | ${func}: | ||
223 | ${func}..ng: | ||
224 | .frame \$30,0,\$26,0 | ||
225 | .prologue 0 | ||
226 | EOF | ||
227 | push(@out,$tmp); | ||
228 | $stack=0; | ||
229 | } | ||
230 | |||
231 | sub main'function_end | ||
232 | { | ||
233 | local($func)=@_; | ||
234 | |||
235 | local($tmp)=<<"EOF"; | ||
236 | ret \$31,(\$26),1 | ||
237 | .end $func | ||
238 | EOF | ||
239 | push(@out,$tmp); | ||
240 | $stack=0; | ||
241 | %label=(); | ||
242 | } | ||
243 | |||
244 | sub main'function_end_A | ||
245 | { | ||
246 | local($func)=@_; | ||
247 | |||
248 | local($tmp)=<<"EOF"; | ||
249 | ret \$31,(\$26),1 | ||
250 | EOF | ||
251 | push(@out,$tmp); | ||
252 | } | ||
253 | |||
254 | sub main'function_end_B | ||
255 | { | ||
256 | local($func)=@_; | ||
257 | |||
258 | $func=$under.$func; | ||
259 | |||
260 | push(@out,"\t.end $func\n"); | ||
261 | $stack=0; | ||
262 | %label=(); | ||
263 | } | ||
264 | |||
265 | sub main'wparam | ||
266 | { | ||
267 | local($num)=@_; | ||
268 | |||
269 | if ($num < 6) | ||
270 | { | ||
271 | $num=20-$num; | ||
272 | return("r$num"); | ||
273 | } | ||
274 | else | ||
275 | { return(&main'QWP($stack+$num*8,"sp")); } | ||
276 | } | ||
277 | |||
278 | sub main'stack_push | ||
279 | { | ||
280 | local($num)=@_; | ||
281 | $stack+=$num*8; | ||
282 | &main'sub("sp",$num*8,"sp"); | ||
283 | } | ||
284 | |||
285 | sub main'stack_pop | ||
286 | { | ||
287 | local($num)=@_; | ||
288 | $stack-=$num*8; | ||
289 | &main'add("sp",$num*8,"sp"); | ||
290 | } | ||
291 | |||
292 | sub main'swtmp | ||
293 | { | ||
294 | return(&main'QWP(($_[0])*8,"sp")); | ||
295 | } | ||
296 | |||
297 | # Should use swtmp, which is above sp. Linix can trash the stack above esp | ||
298 | #sub main'wtmp | ||
299 | # { | ||
300 | # local($num)=@_; | ||
301 | # | ||
302 | # return(&main'QWP(-($num+1)*4,"esp","",0)); | ||
303 | # } | ||
304 | |||
305 | sub main'comment | ||
306 | { | ||
307 | foreach (@_) | ||
308 | { | ||
309 | if (/^\s*$/) | ||
310 | { push(@out,"\n"); } | ||
311 | else | ||
312 | { push(@out,"\t$com_start $_ $com_end\n"); } | ||
313 | } | ||
314 | } | ||
315 | |||
316 | sub main'label | ||
317 | { | ||
318 | if (!defined($label{$_[0]})) | ||
319 | { | ||
320 | $label{$_[0]}=$label; | ||
321 | $label++; | ||
322 | } | ||
323 | return('$'.$label{$_[0]}); | ||
324 | } | ||
325 | |||
326 | sub main'set_label | ||
327 | { | ||
328 | if (!defined($label{$_[0]})) | ||
329 | { | ||
330 | $label{$_[0]}=$label; | ||
331 | $label++; | ||
332 | } | ||
333 | # push(@out,".align $align\n") if ($_[1] != 0); | ||
334 | push(@out,'$'."$label{$_[0]}:\n"); | ||
335 | } | ||
336 | |||
337 | sub main'file_end | ||
338 | { | ||
339 | } | ||
340 | |||
341 | sub main'data_word | ||
342 | { | ||
343 | push(@out,"\t.long $_[0]\n"); | ||
344 | } | ||
345 | |||
346 | @pool_free=(); | ||
347 | @pool_taken=(); | ||
348 | $curr_num=0; | ||
349 | $max=0; | ||
350 | |||
351 | sub main'init_pool | ||
352 | { | ||
353 | local($args)=@_; | ||
354 | local($i); | ||
355 | |||
356 | @pool_free=(); | ||
357 | for ($i=(14+(6-$args)); $i >= 0; $i--) | ||
358 | { | ||
359 | push(@pool_free,"r$i"); | ||
360 | } | ||
361 | print STDERR "START :register pool:@pool_free\n"; | ||
362 | $curr_num=$max=0; | ||
363 | } | ||
364 | |||
365 | sub main'fin_pool | ||
366 | { | ||
367 | printf STDERR "END %2d:register pool:@pool_free\n",$max; | ||
368 | } | ||
369 | |||
370 | sub main'GR | ||
371 | { | ||
372 | local($r)=@_; | ||
373 | local($i,@n,$_); | ||
374 | |||
375 | foreach (@pool_free) | ||
376 | { | ||
377 | if ($r ne $_) | ||
378 | { push(@n,$_); } | ||
379 | else | ||
380 | { | ||
381 | $curr_num++; | ||
382 | $max=$curr_num if ($curr_num > $max); | ||
383 | } | ||
384 | } | ||
385 | @pool_free=@n; | ||
386 | print STDERR "GR:@pool_free\n" if $reg_alloc; | ||
387 | return(@_); | ||
388 | } | ||
389 | |||
390 | sub main'NR | ||
391 | { | ||
392 | local($num)=@_; | ||
393 | local(@ret); | ||
394 | |||
395 | $num=1 if $num == 0; | ||
396 | ($#pool_free >= ($num-1)) || croak "out of registers: want $num, have @pool_free"; | ||
397 | while ($num > 0) | ||
398 | { | ||
399 | push(@ret,pop @pool_free); | ||
400 | $curr_num++; | ||
401 | $max=$curr_num if ($curr_num > $max); | ||
402 | $num-- | ||
403 | } | ||
404 | print STDERR "nr @ret\n" if $n_debug; | ||
405 | print STDERR "NR:@pool_free\n" if $reg_alloc; | ||
406 | return(@ret); | ||
407 | |||
408 | } | ||
409 | |||
410 | sub main'FR | ||
411 | { | ||
412 | local(@r)=@_; | ||
413 | local(@a,$v,$w); | ||
414 | |||
415 | print STDERR "fr @r\n" if $n_debug; | ||
416 | # cluck "fr @r"; | ||
417 | for $w (@pool_free) | ||
418 | { | ||
419 | foreach $v (@r) | ||
420 | { | ||
421 | croak "double register free of $v (@pool_free)" if $w eq $v; | ||
422 | } | ||
423 | } | ||
424 | foreach $v (@r) | ||
425 | { | ||
426 | croak "bad argument to FR" if ($v !~ /^r\d+$/); | ||
427 | if ($smear_regs) | ||
428 | { unshift(@pool_free,$v); } | ||
429 | else { push(@pool_free,$v); } | ||
430 | $curr_num--; | ||
431 | } | ||
432 | print STDERR "FR:@pool_free\n" if $reg_alloc; | ||
433 | } | ||
434 | 1; | ||
diff --git a/src/lib/libcrypto/perlasm/x86_64-xlate.pl b/src/lib/libcrypto/perlasm/x86_64-xlate.pl index 74153b017d..8153a92a7b 100755 --- a/src/lib/libcrypto/perlasm/x86_64-xlate.pl +++ b/src/lib/libcrypto/perlasm/x86_64-xlate.pl | |||
@@ -1,6 +1,6 @@ | |||
1 | #!/usr/bin/env perl | 1 | #!/usr/bin/env perl |
2 | 2 | ||
3 | # Ascetic x86_64 AT&T to MASM assembler translator by <appro>. | 3 | # Ascetic x86_64 AT&T to MASM/NASM assembler translator by <appro>. |
4 | # | 4 | # |
5 | # Why AT&T to MASM and not vice versa? Several reasons. Because AT&T | 5 | # Why AT&T to MASM and not vice versa? Several reasons. Because AT&T |
6 | # format is way easier to parse. Because it's simpler to "gear" from | 6 | # format is way easier to parse. Because it's simpler to "gear" from |
@@ -20,12 +20,11 @@ | |||
20 | # Currently recognized limitations: | 20 | # Currently recognized limitations: |
21 | # | 21 | # |
22 | # - can't use multiple ops per line; | 22 | # - can't use multiple ops per line; |
23 | # - indirect calls and jumps are not supported; | ||
24 | # | 23 | # |
25 | # Dual-ABI styling rules. | 24 | # Dual-ABI styling rules. |
26 | # | 25 | # |
27 | # 1. Adhere to Unix register and stack layout [see the end for | 26 | # 1. Adhere to Unix register and stack layout [see cross-reference |
28 | # explanation]. | 27 | # ABI "card" at the end for explanation]. |
29 | # 2. Forget about "red zone," stick to more traditional blended | 28 | # 2. Forget about "red zone," stick to more traditional blended |
30 | # stack frame allocation. If volatile storage is actually required | 29 | # stack frame allocation. If volatile storage is actually required |
31 | # that is. If not, just leave the stack as is. | 30 | # that is. If not, just leave the stack as is. |
@@ -42,21 +41,26 @@ | |||
42 | # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is | 41 | # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is |
43 | # required to identify the spots, where to inject Win64 epilogue! | 42 | # required to identify the spots, where to inject Win64 epilogue! |
44 | # But on the pros, it's then prefixed with rep automatically:-) | 43 | # But on the pros, it's then prefixed with rep automatically:-) |
45 | # 7. Due to MASM limitations [and certain general counter-intuitivity | 44 | # 7. Stick to explicit ip-relative addressing. If you have to use |
46 | # of ip-relative addressing] generation of position-independent | 45 | # GOTPCREL addressing, stick to mov symbol@GOTPCREL(%rip),%r??. |
47 | # code is assisted by synthetic directive, .picmeup, which puts | 46 | # Both are recognized and translated to proper Win64 addressing |
48 | # address of the *next* instruction into target register. | 47 | # modes. To support legacy code a synthetic directive, .picmeup, |
48 | # is implemented. It puts address of the *next* instruction into | ||
49 | # target register, e.g.: | ||
49 | # | 50 | # |
50 | # Example 1: | ||
51 | # .picmeup %rax | 51 | # .picmeup %rax |
52 | # lea .Label-.(%rax),%rax | 52 | # lea .Label-.(%rax),%rax |
53 | # Example 2: | 53 | # |
54 | # .picmeup %rcx | 54 | # 8. In order to provide for structured exception handling unified |
55 | # .Lpic_point: | 55 | # Win64 prologue copies %rsp value to %rax. For further details |
56 | # ... | 56 | # see SEH paragraph at the end. |
57 | # lea .Label-.Lpic_point(%rcx),%rbp | 57 | # 9. .init segment is allowed to contain calls to functions only. |
58 | 58 | # a. If function accepts more than 4 arguments *and* >4th argument | |
59 | my $output = shift; | 59 | # is declared as non 64-bit value, do clear its upper part. |
60 | |||
61 | my $flavour = shift; | ||
62 | my $output = shift; | ||
63 | if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } | ||
60 | 64 | ||
61 | { my ($stddev,$stdino,@junk)=stat(STDOUT); | 65 | { my ($stddev,$stdino,@junk)=stat(STDOUT); |
62 | my ($outdev,$outino,@junk)=stat($output); | 66 | my ($outdev,$outino,@junk)=stat($output); |
@@ -65,13 +69,40 @@ my $output = shift; | |||
65 | if ($stddev!=$outdev || $stdino!=$outino); | 69 | if ($stddev!=$outdev || $stdino!=$outino); |
66 | } | 70 | } |
67 | 71 | ||
72 | my $gas=1; $gas=0 if ($output =~ /\.asm$/); | ||
73 | my $elf=1; $elf=0 if (!$gas); | ||
74 | my $win64=0; | ||
75 | my $prefix=""; | ||
76 | my $decor=".L"; | ||
77 | |||
68 | my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005 | 78 | my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005 |
69 | my $masm=$masmref if ($output =~ /\.asm/); | 79 | my $masm=0; |
70 | if ($masm && `ml64 2>&1` =~ m/Version ([0-9]+)\.([0-9]+)(\.([0-9]+))?/) | 80 | my $PTR=" PTR"; |
71 | { $masm=$1 + $2*2**-16 + $4*2**-32; } | 81 | |
82 | my $nasmref=2.03; | ||
83 | my $nasm=0; | ||
84 | |||
85 | if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1; | ||
86 | $prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`; | ||
87 | chomp($prefix); | ||
88 | } | ||
89 | elsif ($flavour eq "macosx") { $gas=1; $elf=0; $prefix="_"; $decor="L\$"; } | ||
90 | elsif ($flavour eq "masm") { $gas=0; $elf=0; $masm=$masmref; $win64=1; $decor="\$L\$"; } | ||
91 | elsif ($flavour eq "nasm") { $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $decor="\$L\$"; $PTR=""; } | ||
92 | elsif (!$gas) | ||
93 | { if ($ENV{ASM} =~ m/nasm/ && `nasm -v` =~ m/version ([0-9]+)\.([0-9]+)/i) | ||
94 | { $nasm = $1 + $2*0.01; $PTR=""; } | ||
95 | elsif (`ml64 2>&1` =~ m/Version ([0-9]+)\.([0-9]+)(\.([0-9]+))?/) | ||
96 | { $masm = $1 + $2*2**-16 + $4*2**-32; } | ||
97 | die "no assembler found on %PATH" if (!($nasm || $masm)); | ||
98 | $win64=1; | ||
99 | $elf=0; | ||
100 | $decor="\$L\$"; | ||
101 | } | ||
72 | 102 | ||
73 | my $current_segment; | 103 | my $current_segment; |
74 | my $current_function; | 104 | my $current_function; |
105 | my %globals; | ||
75 | 106 | ||
76 | { package opcode; # pick up opcodes | 107 | { package opcode; # pick up opcodes |
77 | sub re { | 108 | sub re { |
@@ -88,8 +119,10 @@ my $current_function; | |||
88 | if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... | 119 | if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... |
89 | $self->{op} = $1; | 120 | $self->{op} = $1; |
90 | $self->{sz} = "b"; | 121 | $self->{sz} = "b"; |
91 | } elsif ($self->{op} =~ /call/) { | 122 | } elsif ($self->{op} =~ /call|jmp/) { |
92 | $self->{sz} = "" | 123 | $self->{sz} = ""; |
124 | } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op)/) { # SSEn | ||
125 | $self->{sz} = ""; | ||
93 | } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { | 126 | } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { |
94 | $self->{op} = $1; | 127 | $self->{op} = $1; |
95 | $self->{sz} = $2; | 128 | $self->{sz} = $2; |
@@ -105,13 +138,20 @@ my $current_function; | |||
105 | } | 138 | } |
106 | sub out { | 139 | sub out { |
107 | my $self = shift; | 140 | my $self = shift; |
108 | if (!$masm) { | 141 | if ($gas) { |
109 | if ($self->{op} eq "movz") { # movz is pain... | 142 | if ($self->{op} eq "movz") { # movz is pain... |
110 | sprintf "%s%s%s",$self->{op},$self->{sz},shift; | 143 | sprintf "%s%s%s",$self->{op},$self->{sz},shift; |
111 | } elsif ($self->{op} =~ /^set/) { | 144 | } elsif ($self->{op} =~ /^set/) { |
112 | "$self->{op}"; | 145 | "$self->{op}"; |
113 | } elsif ($self->{op} eq "ret") { | 146 | } elsif ($self->{op} eq "ret") { |
114 | ".byte 0xf3,0xc3"; | 147 | my $epilogue = ""; |
148 | if ($win64 && $current_function->{abi} eq "svr4") { | ||
149 | $epilogue = "movq 8(%rsp),%rdi\n\t" . | ||
150 | "movq 16(%rsp),%rsi\n\t"; | ||
151 | } | ||
152 | $epilogue . ".byte 0xf3,0xc3"; | ||
153 | } elsif ($self->{op} eq "call" && !$elf && $current_segment eq ".init") { | ||
154 | ".p2align\t3\n\t.quad"; | ||
115 | } else { | 155 | } else { |
116 | "$self->{op}$self->{sz}"; | 156 | "$self->{op}$self->{sz}"; |
117 | } | 157 | } |
@@ -119,15 +159,25 @@ my $current_function; | |||
119 | $self->{op} =~ s/^movz/movzx/; | 159 | $self->{op} =~ s/^movz/movzx/; |
120 | if ($self->{op} eq "ret") { | 160 | if ($self->{op} eq "ret") { |
121 | $self->{op} = ""; | 161 | $self->{op} = ""; |
122 | if ($current_function->{abi} eq "svr4") { | 162 | if ($win64 && $current_function->{abi} eq "svr4") { |
123 | $self->{op} = "mov rdi,QWORD PTR 8[rsp]\t;WIN64 epilogue\n\t". | 163 | $self->{op} = "mov rdi,QWORD${PTR}[8+rsp]\t;WIN64 epilogue\n\t". |
124 | "mov rsi,QWORD PTR 16[rsp]\n\t"; | 164 | "mov rsi,QWORD${PTR}[16+rsp]\n\t"; |
125 | } | 165 | } |
126 | $self->{op} .= "DB\t0F3h,0C3h\t\t;repret"; | 166 | $self->{op} .= "DB\t0F3h,0C3h\t\t;repret"; |
127 | } | 167 | } elsif ($self->{op} =~ /^(pop|push)f/) { |
168 | $self->{op} .= $self->{sz}; | ||
169 | } elsif ($self->{op} eq "call" && $current_segment eq ".CRT\$XCU") { | ||
170 | $self->{op} = "ALIGN\t8\n\tDQ"; | ||
171 | } | ||
128 | $self->{op}; | 172 | $self->{op}; |
129 | } | 173 | } |
130 | } | 174 | } |
175 | sub mnemonic { | ||
176 | my $self=shift; | ||
177 | my $op=shift; | ||
178 | $self->{op}=$op if (defined($op)); | ||
179 | $self->{op}; | ||
180 | } | ||
131 | } | 181 | } |
132 | { package const; # pick up constants, which start with $ | 182 | { package const; # pick up constants, which start with $ |
133 | sub re { | 183 | sub re { |
@@ -145,14 +195,15 @@ my $current_function; | |||
145 | sub out { | 195 | sub out { |
146 | my $self = shift; | 196 | my $self = shift; |
147 | 197 | ||
148 | if (!$masm) { | 198 | if ($gas) { |
149 | # Solaris /usr/ccs/bin/as can't handle multiplications | 199 | # Solaris /usr/ccs/bin/as can't handle multiplications |
150 | # in $self->{value} | 200 | # in $self->{value} |
151 | $self->{value} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi; | 201 | $self->{value} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi; |
152 | $self->{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; | 202 | $self->{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; |
153 | sprintf "\$%s",$self->{value}; | 203 | sprintf "\$%s",$self->{value}; |
154 | } else { | 204 | } else { |
155 | $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig; | 205 | $self->{value} =~ s/(0b[0-1]+)/oct($1)/eig; |
206 | $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm); | ||
156 | sprintf "%s",$self->{value}; | 207 | sprintf "%s",$self->{value}; |
157 | } | 208 | } |
158 | } | 209 | } |
@@ -163,14 +214,20 @@ my $current_function; | |||
163 | local *line = shift; | 214 | local *line = shift; |
164 | undef $ret; | 215 | undef $ret; |
165 | 216 | ||
166 | if ($line =~ /^([^\(,]*)\(([%\w,]+)\)/ && | 217 | # optional * ---vvv--- appears in indirect jmp/call |
218 | if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/ && | ||
167 | !($line =~ /^PIC_(GOT|PLT)/)) { | 219 | !($line =~ /^PIC_(GOT|PLT)/)) { |
168 | $self->{label} = $1; | 220 | $self->{asterisk} = $1; |
169 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$2); | 221 | $self->{label} = $2; |
222 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$3); | ||
170 | $self->{scale} = 1 if (!defined($self->{scale})); | 223 | $self->{scale} = 1 if (!defined($self->{scale})); |
171 | $ret = $self; | 224 | $ret = $self; |
172 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 225 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
173 | 226 | ||
227 | if ($win64 && $self->{label} =~ s/\@GOTPCREL//) { | ||
228 | die if (opcode->mnemonic() ne "mov"); | ||
229 | opcode->mnemonic("lea"); | ||
230 | } | ||
174 | $self->{base} =~ s/^%//; | 231 | $self->{base} =~ s/^%//; |
175 | $self->{index} =~ s/^%// if (defined($self->{index})); | 232 | $self->{index} =~ s/^%// if (defined($self->{index})); |
176 | } | 233 | } |
@@ -181,42 +238,50 @@ my $current_function; | |||
181 | my $self = shift; | 238 | my $self = shift; |
182 | my $sz = shift; | 239 | my $sz = shift; |
183 | 240 | ||
241 | $self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
242 | $self->{label} =~ s/\.L/$decor/g; | ||
243 | |||
184 | # Silently convert all EAs to 64-bit. This is required for | 244 | # Silently convert all EAs to 64-bit. This is required for |
185 | # elder GNU assembler and results in more compact code, | 245 | # elder GNU assembler and results in more compact code, |
186 | # *but* most importantly AES module depends on this feature! | 246 | # *but* most importantly AES module depends on this feature! |
187 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 247 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
188 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 248 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
189 | 249 | ||
190 | if (!$masm) { | 250 | if ($gas) { |
191 | # Solaris /usr/ccs/bin/as can't handle multiplications | 251 | # Solaris /usr/ccs/bin/as can't handle multiplications |
192 | # in $self->{label} | 252 | # in $self->{label}, new gas requires sign extension... |
193 | $self->{label} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi; | 253 | use integer; |
254 | $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi; | ||
194 | $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; | 255 | $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; |
256 | $self->{label} =~ s/([0-9]+)/$1<<32>>32/eg; | ||
257 | $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64"); | ||
195 | 258 | ||
196 | if (defined($self->{index})) { | 259 | if (defined($self->{index})) { |
197 | sprintf "%s(%%%s,%%%s,%d)", | 260 | sprintf "%s%s(%%%s,%%%s,%d)",$self->{asterisk}, |
198 | $self->{label},$self->{base}, | 261 | $self->{label},$self->{base}, |
199 | $self->{index},$self->{scale}; | 262 | $self->{index},$self->{scale}; |
200 | } else { | 263 | } else { |
201 | sprintf "%s(%%%s)", $self->{label},$self->{base}; | 264 | sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base}; |
202 | } | 265 | } |
203 | } else { | 266 | } else { |
204 | %szmap = ( b=>"BYTE", w=>"WORD", l=>"DWORD", q=>"QWORD" ); | 267 | %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", q=>"QWORD$PTR" ); |
205 | 268 | ||
206 | $self->{label} =~ s/\./\$/g; | 269 | $self->{label} =~ s/\./\$/g; |
207 | $self->{label} =~ s/0x([0-9a-f]+)/0$1h/ig; | 270 | $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig; |
208 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); | 271 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); |
272 | $sz="q" if ($self->{asterisk}); | ||
209 | 273 | ||
210 | if (defined($self->{index})) { | 274 | if (defined($self->{index})) { |
211 | sprintf "%s PTR %s[%s*%d+%s]",$szmap{$sz}, | 275 | sprintf "%s[%s%s*%d+%s]",$szmap{$sz}, |
212 | $self->{label}, | 276 | $self->{label}?"$self->{label}+":"", |
213 | $self->{index},$self->{scale}, | 277 | $self->{index},$self->{scale}, |
214 | $self->{base}; | 278 | $self->{base}; |
215 | } elsif ($self->{base} eq "rip") { | 279 | } elsif ($self->{base} eq "rip") { |
216 | sprintf "%s PTR %s",$szmap{$sz},$self->{label}; | 280 | sprintf "%s[%s]",$szmap{$sz},$self->{label}; |
217 | } else { | 281 | } else { |
218 | sprintf "%s PTR %s[%s]",$szmap{$sz}, | 282 | sprintf "%s[%s%s]",$szmap{$sz}, |
219 | $self->{label},$self->{base}; | 283 | $self->{label}?"$self->{label}+":"", |
284 | $self->{base}; | ||
220 | } | 285 | } |
221 | } | 286 | } |
222 | } | 287 | } |
@@ -228,9 +293,11 @@ my $current_function; | |||
228 | local *line = shift; | 293 | local *line = shift; |
229 | undef $ret; | 294 | undef $ret; |
230 | 295 | ||
231 | if ($line =~ /^%(\w+)/) { | 296 | # optional * ---vvv--- appears in indirect jmp/call |
297 | if ($line =~ /^(\*?)%(\w+)/) { | ||
232 | bless $self,$class; | 298 | bless $self,$class; |
233 | $self->{value} = $1; | 299 | $self->{asterisk} = $1; |
300 | $self->{value} = $2; | ||
234 | $ret = $self; | 301 | $ret = $self; |
235 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 302 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
236 | } | 303 | } |
@@ -253,7 +320,8 @@ my $current_function; | |||
253 | } | 320 | } |
254 | sub out { | 321 | sub out { |
255 | my $self = shift; | 322 | my $self = shift; |
256 | sprintf $masm?"%s":"%%%s",$self->{value}; | 323 | if ($gas) { sprintf "%s%%%s",$self->{asterisk},$self->{value}; } |
324 | else { $self->{value}; } | ||
257 | } | 325 | } |
258 | } | 326 | } |
259 | { package label; # pick up labels, which end with : | 327 | { package label; # pick up labels, which end with : |
@@ -262,37 +330,63 @@ my $current_function; | |||
262 | local *line = shift; | 330 | local *line = shift; |
263 | undef $ret; | 331 | undef $ret; |
264 | 332 | ||
265 | if ($line =~ /(^[\.\w]+\:)/) { | 333 | if ($line =~ /(^[\.\w]+)\:/) { |
266 | $self->{value} = $1; | 334 | $self->{value} = $1; |
267 | $ret = $self; | 335 | $ret = $self; |
268 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 336 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
269 | 337 | ||
270 | $self->{value} =~ s/\.L/\$L/ if ($masm); | 338 | $self->{value} =~ s/^\.L/$decor/; |
271 | } | 339 | } |
272 | $ret; | 340 | $ret; |
273 | } | 341 | } |
274 | sub out { | 342 | sub out { |
275 | my $self = shift; | 343 | my $self = shift; |
276 | 344 | ||
277 | if (!$masm) { | 345 | if ($gas) { |
278 | $self->{value}; | 346 | my $func = ($globals{$self->{value}} or $self->{value}) . ":"; |
279 | } elsif ($self->{value} ne "$current_function->{name}:") { | 347 | if ($win64 && |
280 | $self->{value}; | 348 | $current_function->{name} eq $self->{value} && |
281 | } elsif ($current_function->{abi} eq "svr4") { | 349 | $current_function->{abi} eq "svr4") { |
282 | my $func = "$current_function->{name} PROC\n". | 350 | $func .= "\n"; |
283 | " mov QWORD PTR 8[rsp],rdi\t;WIN64 prologue\n". | 351 | $func .= " movq %rdi,8(%rsp)\n"; |
284 | " mov QWORD PTR 16[rsp],rsi\n"; | 352 | $func .= " movq %rsi,16(%rsp)\n"; |
353 | $func .= " movq %rsp,%rax\n"; | ||
354 | $func .= "${decor}SEH_begin_$current_function->{name}:\n"; | ||
355 | my $narg = $current_function->{narg}; | ||
356 | $narg=6 if (!defined($narg)); | ||
357 | $func .= " movq %rcx,%rdi\n" if ($narg>0); | ||
358 | $func .= " movq %rdx,%rsi\n" if ($narg>1); | ||
359 | $func .= " movq %r8,%rdx\n" if ($narg>2); | ||
360 | $func .= " movq %r9,%rcx\n" if ($narg>3); | ||
361 | $func .= " movq 40(%rsp),%r8\n" if ($narg>4); | ||
362 | $func .= " movq 48(%rsp),%r9\n" if ($narg>5); | ||
363 | } | ||
364 | $func; | ||
365 | } elsif ($self->{value} ne "$current_function->{name}") { | ||
366 | $self->{value} .= ":" if ($masm && $ret!~m/^\$/); | ||
367 | $self->{value} . ":"; | ||
368 | } elsif ($win64 && $current_function->{abi} eq "svr4") { | ||
369 | my $func = "$current_function->{name}" . | ||
370 | ($nasm ? ":" : "\tPROC $current_function->{scope}") . | ||
371 | "\n"; | ||
372 | $func .= " mov QWORD${PTR}[8+rsp],rdi\t;WIN64 prologue\n"; | ||
373 | $func .= " mov QWORD${PTR}[16+rsp],rsi\n"; | ||
374 | $func .= " mov rax,rsp\n"; | ||
375 | $func .= "${decor}SEH_begin_$current_function->{name}:"; | ||
376 | $func .= ":" if ($masm); | ||
377 | $func .= "\n"; | ||
285 | my $narg = $current_function->{narg}; | 378 | my $narg = $current_function->{narg}; |
286 | $narg=6 if (!defined($narg)); | 379 | $narg=6 if (!defined($narg)); |
287 | $func .= " mov rdi,rcx\n" if ($narg>0); | 380 | $func .= " mov rdi,rcx\n" if ($narg>0); |
288 | $func .= " mov rsi,rdx\n" if ($narg>1); | 381 | $func .= " mov rsi,rdx\n" if ($narg>1); |
289 | $func .= " mov rdx,r8\n" if ($narg>2); | 382 | $func .= " mov rdx,r8\n" if ($narg>2); |
290 | $func .= " mov rcx,r9\n" if ($narg>3); | 383 | $func .= " mov rcx,r9\n" if ($narg>3); |
291 | $func .= " mov r8,QWORD PTR 40[rsp]\n" if ($narg>4); | 384 | $func .= " mov r8,QWORD${PTR}[40+rsp]\n" if ($narg>4); |
292 | $func .= " mov r9,QWORD PTR 48[rsp]\n" if ($narg>5); | 385 | $func .= " mov r9,QWORD${PTR}[48+rsp]\n" if ($narg>5); |
293 | $func .= "\n"; | 386 | $func .= "\n"; |
294 | } else { | 387 | } else { |
295 | "$current_function->{name} PROC"; | 388 | "$current_function->{name}". |
389 | ($nasm ? ":" : "\tPROC $current_function->{scope}"); | ||
296 | } | 390 | } |
297 | } | 391 | } |
298 | } | 392 | } |
@@ -307,13 +401,19 @@ my $current_function; | |||
307 | $ret = $self; | 401 | $ret = $self; |
308 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 402 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
309 | 403 | ||
310 | $self->{value} =~ s/\.L/\$L/g if ($masm); | 404 | $self->{value} =~ s/\@PLT// if (!$elf); |
405 | $self->{value} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
406 | $self->{value} =~ s/\.L/$decor/g; | ||
311 | } | 407 | } |
312 | $ret; | 408 | $ret; |
313 | } | 409 | } |
314 | sub out { | 410 | sub out { |
315 | my $self = shift; | 411 | my $self = shift; |
316 | $self->{value}; | 412 | if ($nasm && opcode->mnemonic()=~m/^j/) { |
413 | "NEAR ".$self->{value}; | ||
414 | } else { | ||
415 | $self->{value}; | ||
416 | } | ||
317 | } | 417 | } |
318 | } | 418 | } |
319 | { package directive; # pick up directives, which start with . | 419 | { package directive; # pick up directives, which start with . |
@@ -333,89 +433,181 @@ my $current_function; | |||
333 | "%r14"=>0x01358d4c, "%r15"=>0x013d8d4c ); | 433 | "%r14"=>0x01358d4c, "%r15"=>0x013d8d4c ); |
334 | 434 | ||
335 | if ($line =~ /^\s*(\.\w+)/) { | 435 | if ($line =~ /^\s*(\.\w+)/) { |
336 | if (!$masm) { | ||
337 | $self->{value} = $1; | ||
338 | $line =~ s/\@abi\-omnipotent/\@function/; | ||
339 | $line =~ s/\@function.*/\@function/; | ||
340 | if ($line =~ /\.picmeup\s+(%r[\w]+)/i) { | ||
341 | $self->{value} = sprintf "\t.long\t0x%x,0x90000000",$opcode{$1}; | ||
342 | } elsif ($line =~ /\.asciz\s+"(.*)"$/) { | ||
343 | $self->{value} = ".byte\t".join(",",unpack("C*",$1),0); | ||
344 | } elsif ($line =~ /\.extern/) { | ||
345 | $self->{value} = ""; # swallow extern | ||
346 | } else { | ||
347 | $self->{value} = $line; | ||
348 | } | ||
349 | $line = ""; | ||
350 | return $self; | ||
351 | } | ||
352 | |||
353 | $dir = $1; | 436 | $dir = $1; |
354 | $ret = $self; | 437 | $ret = $self; |
355 | undef $self->{value}; | 438 | undef $self->{value}; |
356 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 439 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
440 | |||
357 | SWITCH: for ($dir) { | 441 | SWITCH: for ($dir) { |
358 | /\.(text)/ | 442 | /\.picmeup/ && do { if ($line =~ /(%r[\w]+)/i) { |
359 | && do { my $v=undef; | 443 | $dir="\t.long"; |
360 | $v="$current_segment\tENDS\n" if ($current_segment); | 444 | $line=sprintf "0x%x,0x90000000",$opcode{$1}; |
361 | $current_segment = "_$1\$"; | 445 | } |
362 | $current_segment =~ tr/[a-z]/[A-Z]/; | 446 | last; |
363 | $v.="$current_segment\tSEGMENT "; | 447 | }; |
364 | $v.=$masm>=$masmref ? "ALIGN(64)" : "PAGE"; | 448 | /\.global|\.globl|\.extern/ |
365 | $v.=" 'CODE'"; | 449 | && do { $globals{$line} = $prefix . $line; |
366 | $self->{value} = $v; | 450 | $line = $globals{$line} if ($prefix); |
367 | last; | 451 | last; |
368 | }; | 452 | }; |
369 | /\.extern/ && do { $self->{value} = "EXTRN\t".$line.":BYTE"; last; }; | ||
370 | /\.globl/ && do { $self->{value} = "PUBLIC\t".$line; last; }; | ||
371 | /\.type/ && do { ($sym,$type,$narg) = split(',',$line); | 453 | /\.type/ && do { ($sym,$type,$narg) = split(',',$line); |
372 | if ($type eq "\@function") { | 454 | if ($type eq "\@function") { |
373 | undef $current_function; | 455 | undef $current_function; |
374 | $current_function->{name} = $sym; | 456 | $current_function->{name} = $sym; |
375 | $current_function->{abi} = "svr4"; | 457 | $current_function->{abi} = "svr4"; |
376 | $current_function->{narg} = $narg; | 458 | $current_function->{narg} = $narg; |
459 | $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE"; | ||
377 | } elsif ($type eq "\@abi-omnipotent") { | 460 | } elsif ($type eq "\@abi-omnipotent") { |
378 | undef $current_function; | 461 | undef $current_function; |
379 | $current_function->{name} = $sym; | 462 | $current_function->{name} = $sym; |
463 | $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE"; | ||
464 | } | ||
465 | $line =~ s/\@abi\-omnipotent/\@function/; | ||
466 | $line =~ s/\@function.*/\@function/; | ||
467 | last; | ||
468 | }; | ||
469 | /\.asciz/ && do { if ($line =~ /^"(.*)"$/) { | ||
470 | $dir = ".byte"; | ||
471 | $line = join(",",unpack("C*",$1),0); | ||
380 | } | 472 | } |
381 | last; | 473 | last; |
382 | }; | 474 | }; |
475 | /\.rva|\.long|\.quad/ | ||
476 | && do { $line =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
477 | $line =~ s/\.L/$decor/g; | ||
478 | last; | ||
479 | }; | ||
480 | } | ||
481 | |||
482 | if ($gas) { | ||
483 | $self->{value} = $dir . "\t" . $line; | ||
484 | |||
485 | if ($dir =~ /\.extern/) { | ||
486 | $self->{value} = ""; # swallow extern | ||
487 | } elsif (!$elf && $dir =~ /\.type/) { | ||
488 | $self->{value} = ""; | ||
489 | $self->{value} = ".def\t" . ($globals{$1} or $1) . ";\t" . | ||
490 | (defined($globals{$1})?".scl 2;":".scl 3;") . | ||
491 | "\t.type 32;\t.endef" | ||
492 | if ($win64 && $line =~ /([^,]+),\@function/); | ||
493 | } elsif (!$elf && $dir =~ /\.size/) { | ||
494 | $self->{value} = ""; | ||
495 | if (defined($current_function)) { | ||
496 | $self->{value} .= "${decor}SEH_end_$current_function->{name}:" | ||
497 | if ($win64 && $current_function->{abi} eq "svr4"); | ||
498 | undef $current_function; | ||
499 | } | ||
500 | } elsif (!$elf && $dir =~ /\.align/) { | ||
501 | $self->{value} = ".p2align\t" . (log($line)/log(2)); | ||
502 | } elsif ($dir eq ".section") { | ||
503 | $current_segment=$line; | ||
504 | if (!$elf && $current_segment eq ".init") { | ||
505 | if ($flavour eq "macosx") { $self->{value} = ".mod_init_func"; } | ||
506 | elsif ($flavour eq "mingw64") { $self->{value} = ".section\t.ctors"; } | ||
507 | } | ||
508 | } elsif ($dir =~ /\.(text|data)/) { | ||
509 | $current_segment=".$1"; | ||
510 | } | ||
511 | $line = ""; | ||
512 | return $self; | ||
513 | } | ||
514 | |||
515 | # non-gas case or nasm/masm | ||
516 | SWITCH: for ($dir) { | ||
517 | /\.text/ && do { my $v=undef; | ||
518 | if ($nasm) { | ||
519 | $v="section .text code align=64\n"; | ||
520 | } else { | ||
521 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
522 | $current_segment = ".text\$"; | ||
523 | $v.="$current_segment\tSEGMENT "; | ||
524 | $v.=$masm>=$masmref ? "ALIGN(64)" : "PAGE"; | ||
525 | $v.=" 'CODE'"; | ||
526 | } | ||
527 | $self->{value} = $v; | ||
528 | last; | ||
529 | }; | ||
530 | /\.data/ && do { my $v=undef; | ||
531 | if ($nasm) { | ||
532 | $v="section .data data align=8\n"; | ||
533 | } else { | ||
534 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
535 | $current_segment = "_DATA"; | ||
536 | $v.="$current_segment\tSEGMENT"; | ||
537 | } | ||
538 | $self->{value} = $v; | ||
539 | last; | ||
540 | }; | ||
541 | /\.section/ && do { my $v=undef; | ||
542 | $line =~ s/([^,]*).*/$1/; | ||
543 | $line = ".CRT\$XCU" if ($line eq ".init"); | ||
544 | if ($nasm) { | ||
545 | $v="section $line"; | ||
546 | if ($line=~/\.([px])data/) { | ||
547 | $v.=" rdata align="; | ||
548 | $v.=$1 eq "p"? 4 : 8; | ||
549 | } | ||
550 | } else { | ||
551 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
552 | $v.="$line\tSEGMENT"; | ||
553 | if ($line=~/\.([px])data/) { | ||
554 | $v.=" READONLY"; | ||
555 | $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); | ||
556 | } | ||
557 | } | ||
558 | $current_segment = $line; | ||
559 | $self->{value} = $v; | ||
560 | last; | ||
561 | }; | ||
562 | /\.extern/ && do { $self->{value} = "EXTERN\t".$line; | ||
563 | $self->{value} .= ":NEAR" if ($masm); | ||
564 | last; | ||
565 | }; | ||
566 | /\.globl|.global/ | ||
567 | && do { $self->{value} = $masm?"PUBLIC":"global"; | ||
568 | $self->{value} .= "\t".$line; | ||
569 | last; | ||
570 | }; | ||
383 | /\.size/ && do { if (defined($current_function)) { | 571 | /\.size/ && do { if (defined($current_function)) { |
384 | $self->{value}="$current_function->{name}\tENDP"; | 572 | undef $self->{value}; |
573 | if ($current_function->{abi} eq "svr4") { | ||
574 | $self->{value}="${decor}SEH_end_$current_function->{name}:"; | ||
575 | $self->{value}.=":\n" if($masm); | ||
576 | } | ||
577 | $self->{value}.="$current_function->{name}\tENDP" if($masm); | ||
385 | undef $current_function; | 578 | undef $current_function; |
386 | } | 579 | } |
387 | last; | 580 | last; |
388 | }; | 581 | }; |
389 | /\.align/ && do { $self->{value} = "ALIGN\t".$line; last; }; | 582 | /\.align/ && do { $self->{value} = "ALIGN\t".$line; last; }; |
390 | /\.(byte|value|long|quad)/ | 583 | /\.(value|long|rva|quad)/ |
391 | && do { my @arr = split(',',$line); | 584 | && do { my $sz = substr($1,0,1); |
392 | my $sz = substr($1,0,1); | 585 | my @arr = split(/,\s*/,$line); |
393 | my $last = pop(@arr); | 586 | my $last = pop(@arr); |
394 | my $conv = sub { my $var=shift; | 587 | my $conv = sub { my $var=shift; |
395 | if ($var=~s/0x([0-9a-f]+)/0$1h/i) { $var; } | 588 | $var=~s/^(0b[0-1]+)/oct($1)/eig; |
396 | else { sprintf"0%Xh",$var; } | 589 | $var=~s/^0x([0-9a-f]+)/0$1h/ig if ($masm); |
590 | if ($sz eq "D" && ($current_segment=~/.[px]data/ || $dir eq ".rva")) | ||
591 | { $var=~s/([_a-z\$\@][_a-z0-9\$\@]*)/$nasm?"$1 wrt ..imagebase":"imagerel $1"/egi; } | ||
592 | $var; | ||
397 | }; | 593 | }; |
398 | 594 | ||
399 | $sz =~ tr/bvlq/BWDQ/; | 595 | $sz =~ tr/bvlrq/BWDDQ/; |
400 | $self->{value} = "\tD$sz\t"; | 596 | $self->{value} = "\tD$sz\t"; |
401 | for (@arr) { $self->{value} .= &$conv($_).","; } | 597 | for (@arr) { $self->{value} .= &$conv($_).","; } |
402 | $self->{value} .= &$conv($last); | 598 | $self->{value} .= &$conv($last); |
403 | last; | 599 | last; |
404 | }; | 600 | }; |
405 | /\.picmeup/ && do { $self->{value} = sprintf"\tDD\t 0%Xh,090000000h",$opcode{$line}; | 601 | /\.byte/ && do { my @str=split(/,\s*/,$line); |
406 | last; | 602 | map(s/(0b[0-1]+)/oct($1)/eig,@str); |
407 | }; | 603 | map(s/0x([0-9a-f]+)/0$1h/ig,@str) if ($masm); |
408 | /\.asciz/ && do { if ($line =~ /^"(.*)"$/) { | 604 | while ($#str>15) { |
409 | my @str=unpack("C*",$1); | ||
410 | push @str,0; | ||
411 | while ($#str>15) { | ||
412 | $self->{value}.="DB\t" | ||
413 | .join(",",@str[0..15])."\n"; | ||
414 | foreach (0..15) { shift @str; } | ||
415 | } | ||
416 | $self->{value}.="DB\t" | 605 | $self->{value}.="DB\t" |
417 | .join(",",@str) if (@str); | 606 | .join(",",@str[0..15])."\n"; |
607 | foreach (0..15) { shift @str; } | ||
418 | } | 608 | } |
609 | $self->{value}.="DB\t" | ||
610 | .join(",",@str) if (@str); | ||
419 | last; | 611 | last; |
420 | }; | 612 | }; |
421 | } | 613 | } |
@@ -432,6 +624,15 @@ my $current_function; | |||
432 | 624 | ||
433 | print "#include <machine/asm.h>\n"; | 625 | print "#include <machine/asm.h>\n"; |
434 | 626 | ||
627 | if ($nasm) { | ||
628 | print <<___; | ||
629 | default rel | ||
630 | ___ | ||
631 | } elsif ($masm) { | ||
632 | print <<___; | ||
633 | OPTION DOTNAME | ||
634 | ___ | ||
635 | } | ||
435 | while($line=<>) { | 636 | while($line=<>) { |
436 | 637 | ||
437 | chomp($line); | 638 | chomp($line); |
@@ -442,43 +643,42 @@ while($line=<>) { | |||
442 | 643 | ||
443 | undef $label; | 644 | undef $label; |
444 | undef $opcode; | 645 | undef $opcode; |
445 | undef $dst; | ||
446 | undef $src; | ||
447 | undef $sz; | 646 | undef $sz; |
647 | undef @args; | ||
448 | 648 | ||
449 | if ($label=label->re(\$line)) { print $label->out(); } | 649 | if ($label=label->re(\$line)) { print $label->out(); } |
450 | 650 | ||
451 | if (directive->re(\$line)) { | 651 | if (directive->re(\$line)) { |
452 | printf "%s",directive->out(); | 652 | printf "%s",directive->out(); |
453 | } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: { | 653 | } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: while (1) { |
454 | 654 | my $arg; | |
455 | if ($src=register->re(\$line)) { opcode->size($src->size()); } | ||
456 | elsif ($src=const->re(\$line)) { } | ||
457 | elsif ($src=ea->re(\$line)) { } | ||
458 | elsif ($src=expr->re(\$line)) { } | ||
459 | 655 | ||
460 | last ARGUMENT if ($line !~ /^,/); | 656 | if ($arg=register->re(\$line)) { opcode->size($arg->size()); } |
657 | elsif ($arg=const->re(\$line)) { } | ||
658 | elsif ($arg=ea->re(\$line)) { } | ||
659 | elsif ($arg=expr->re(\$line)) { } | ||
660 | else { last ARGUMENT; } | ||
461 | 661 | ||
462 | $line = substr($line,1); $line =~ s/^\s+//; | 662 | push @args,$arg; |
463 | 663 | ||
464 | if ($dst=register->re(\$line)) { opcode->size($dst->size()); } | 664 | last ARGUMENT if ($line !~ /^,/); |
465 | elsif ($dst=const->re(\$line)) { } | ||
466 | elsif ($dst=ea->re(\$line)) { } | ||
467 | 665 | ||
666 | $line =~ s/^,\s*//; | ||
468 | } # ARGUMENT: | 667 | } # ARGUMENT: |
469 | 668 | ||
470 | $sz=opcode->size(); | 669 | $sz=opcode->size(); |
471 | 670 | ||
472 | if (defined($dst)) { | 671 | if ($#args>=0) { |
473 | if (!$masm) { | 672 | my $insn; |
474 | printf "\t%s\t%s,%s", $opcode->out($dst->size()), | 673 | if ($gas) { |
475 | $src->out($sz),$dst->out($sz); | 674 | $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz); |
476 | } else { | 675 | } else { |
477 | printf "\t%s\t%s,%s", $opcode->out(), | 676 | $insn = $opcode->out(); |
478 | $dst->out($sz),$src->out($sz); | 677 | $insn .= $sz if (map($_->out() =~ /x?mm/,@args)); |
678 | @args = reverse(@args); | ||
679 | undef $sz if ($nasm && $opcode->mnemonic() eq "lea"); | ||
479 | } | 680 | } |
480 | } elsif (defined($src)) { | 681 | printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args)); |
481 | printf "\t%s\t%s",$opcode->out(),$src->out($sz); | ||
482 | } else { | 682 | } else { |
483 | printf "\t%s",$opcode->out(); | 683 | printf "\t%s",$opcode->out(); |
484 | } | 684 | } |
@@ -487,11 +687,12 @@ while($line=<>) { | |||
487 | print $line,"\n"; | 687 | print $line,"\n"; |
488 | } | 688 | } |
489 | 689 | ||
490 | print "\n$current_segment\tENDS\nEND\n" if ($masm); | 690 | print "\n$current_segment\tENDS\n" if ($current_segment && $masm); |
691 | print "END\n" if ($masm); | ||
491 | 692 | ||
492 | close STDOUT; | 693 | close STDOUT; |
493 | 694 | ||
494 | ################################################# | 695 | ################################################# |
495 | # Cross-reference x86_64 ABI "card" | 696 | # Cross-reference x86_64 ABI "card" |
496 | # | 697 | # |
497 | # Unix Win64 | 698 | # Unix Win64 |
@@ -555,3 +756,161 @@ close STDOUT; | |||
555 | # movq 16(%rsp),%rsi | 756 | # movq 16(%rsp),%rsi |
556 | # endif | 757 | # endif |
557 | # ret | 758 | # ret |
759 | # | ||
760 | ################################################# | ||
761 | # Win64 SEH, Structured Exception Handling. | ||
762 | # | ||
763 | # Unlike on Unix systems(*) lack of Win64 stack unwinding information | ||
764 | # has undesired side-effect at run-time: if an exception is raised in | ||
765 | # assembler subroutine such as those in question (basically we're | ||
766 | # referring to segmentation violations caused by malformed input | ||
767 | # parameters), the application is briskly terminated without invoking | ||
768 | # any exception handlers, most notably without generating memory dump | ||
769 | # or any user notification whatsoever. This poses a problem. It's | ||
770 | # possible to address it by registering custom language-specific | ||
771 | # handler that would restore processor context to the state at | ||
772 | # subroutine entry point and return "exception is not handled, keep | ||
773 | # unwinding" code. Writing such handler can be a challenge... But it's | ||
774 | # doable, though requires certain coding convention. Consider following | ||
775 | # snippet: | ||
776 | # | ||
777 | # .type function,@function | ||
778 | # function: | ||
779 | # movq %rsp,%rax # copy rsp to volatile register | ||
780 | # pushq %r15 # save non-volatile registers | ||
781 | # pushq %rbx | ||
782 | # pushq %rbp | ||
783 | # movq %rsp,%r11 | ||
784 | # subq %rdi,%r11 # prepare [variable] stack frame | ||
785 | # andq $-64,%r11 | ||
786 | # movq %rax,0(%r11) # check for exceptions | ||
787 | # movq %r11,%rsp # allocate [variable] stack frame | ||
788 | # movq %rax,0(%rsp) # save original rsp value | ||
789 | # magic_point: | ||
790 | # ... | ||
791 | # movq 0(%rsp),%rcx # pull original rsp value | ||
792 | # movq -24(%rcx),%rbp # restore non-volatile registers | ||
793 | # movq -16(%rcx),%rbx | ||
794 | # movq -8(%rcx),%r15 | ||
795 | # movq %rcx,%rsp # restore original rsp | ||
796 | # ret | ||
797 | # .size function,.-function | ||
798 | # | ||
799 | # The key is that up to magic_point copy of original rsp value remains | ||
800 | # in chosen volatile register and no non-volatile register, except for | ||
801 | # rsp, is modified. While past magic_point rsp remains constant till | ||
802 | # the very end of the function. In this case custom language-specific | ||
803 | # exception handler would look like this: | ||
804 | # | ||
805 | # EXCEPTION_DISPOSITION handler (EXCEPTION_RECORD *rec,ULONG64 frame, | ||
806 | # CONTEXT *context,DISPATCHER_CONTEXT *disp) | ||
807 | # { ULONG64 *rsp = (ULONG64 *)context->Rax; | ||
808 | # if (context->Rip >= magic_point) | ||
809 | # { rsp = ((ULONG64 **)context->Rsp)[0]; | ||
810 | # context->Rbp = rsp[-3]; | ||
811 | # context->Rbx = rsp[-2]; | ||
812 | # context->R15 = rsp[-1]; | ||
813 | # } | ||
814 | # context->Rsp = (ULONG64)rsp; | ||
815 | # context->Rdi = rsp[1]; | ||
816 | # context->Rsi = rsp[2]; | ||
817 | # | ||
818 | # memcpy (disp->ContextRecord,context,sizeof(CONTEXT)); | ||
819 | # RtlVirtualUnwind(UNW_FLAG_NHANDLER,disp->ImageBase, | ||
820 | # dips->ControlPc,disp->FunctionEntry,disp->ContextRecord, | ||
821 | # &disp->HandlerData,&disp->EstablisherFrame,NULL); | ||
822 | # return ExceptionContinueSearch; | ||
823 | # } | ||
824 | # | ||
825 | # It's appropriate to implement this handler in assembler, directly in | ||
826 | # function's module. In order to do that one has to know members' | ||
827 | # offsets in CONTEXT and DISPATCHER_CONTEXT structures and some constant | ||
828 | # values. Here they are: | ||
829 | # | ||
830 | # CONTEXT.Rax 120 | ||
831 | # CONTEXT.Rcx 128 | ||
832 | # CONTEXT.Rdx 136 | ||
833 | # CONTEXT.Rbx 144 | ||
834 | # CONTEXT.Rsp 152 | ||
835 | # CONTEXT.Rbp 160 | ||
836 | # CONTEXT.Rsi 168 | ||
837 | # CONTEXT.Rdi 176 | ||
838 | # CONTEXT.R8 184 | ||
839 | # CONTEXT.R9 192 | ||
840 | # CONTEXT.R10 200 | ||
841 | # CONTEXT.R11 208 | ||
842 | # CONTEXT.R12 216 | ||
843 | # CONTEXT.R13 224 | ||
844 | # CONTEXT.R14 232 | ||
845 | # CONTEXT.R15 240 | ||
846 | # CONTEXT.Rip 248 | ||
847 | # CONTEXT.Xmm6 512 | ||
848 | # sizeof(CONTEXT) 1232 | ||
849 | # DISPATCHER_CONTEXT.ControlPc 0 | ||
850 | # DISPATCHER_CONTEXT.ImageBase 8 | ||
851 | # DISPATCHER_CONTEXT.FunctionEntry 16 | ||
852 | # DISPATCHER_CONTEXT.EstablisherFrame 24 | ||
853 | # DISPATCHER_CONTEXT.TargetIp 32 | ||
854 | # DISPATCHER_CONTEXT.ContextRecord 40 | ||
855 | # DISPATCHER_CONTEXT.LanguageHandler 48 | ||
856 | # DISPATCHER_CONTEXT.HandlerData 56 | ||
857 | # UNW_FLAG_NHANDLER 0 | ||
858 | # ExceptionContinueSearch 1 | ||
859 | # | ||
860 | # In order to tie the handler to the function one has to compose | ||
861 | # couple of structures: one for .xdata segment and one for .pdata. | ||
862 | # | ||
863 | # UNWIND_INFO structure for .xdata segment would be | ||
864 | # | ||
865 | # function_unwind_info: | ||
866 | # .byte 9,0,0,0 | ||
867 | # .rva handler | ||
868 | # | ||
869 | # This structure designates exception handler for a function with | ||
870 | # zero-length prologue, no stack frame or frame register. | ||
871 | # | ||
872 | # To facilitate composing of .pdata structures, auto-generated "gear" | ||
873 | # prologue copies rsp value to rax and denotes next instruction with | ||
874 | # .LSEH_begin_{function_name} label. This essentially defines the SEH | ||
875 | # styling rule mentioned in the beginning. Position of this label is | ||
876 | # chosen in such manner that possible exceptions raised in the "gear" | ||
877 | # prologue would be accounted to caller and unwound from latter's frame. | ||
878 | # End of function is marked with respective .LSEH_end_{function_name} | ||
879 | # label. To summarize, .pdata segment would contain | ||
880 | # | ||
881 | # .rva .LSEH_begin_function | ||
882 | # .rva .LSEH_end_function | ||
883 | # .rva function_unwind_info | ||
884 | # | ||
885 | # Reference to functon_unwind_info from .xdata segment is the anchor. | ||
886 | # In case you wonder why references are 32-bit .rvas and not 64-bit | ||
887 | # .quads. References put into these two segments are required to be | ||
888 | # *relative* to the base address of the current binary module, a.k.a. | ||
889 | # image base. No Win64 module, be it .exe or .dll, can be larger than | ||
890 | # 2GB and thus such relative references can be and are accommodated in | ||
891 | # 32 bits. | ||
892 | # | ||
893 | # Having reviewed the example function code, one can argue that "movq | ||
894 | # %rsp,%rax" above is redundant. It is not! Keep in mind that on Unix | ||
895 | # rax would contain an undefined value. If this "offends" you, use | ||
896 | # another register and refrain from modifying rax till magic_point is | ||
897 | # reached, i.e. as if it was a non-volatile register. If more registers | ||
898 | # are required prior [variable] frame setup is completed, note that | ||
899 | # nobody says that you can have only one "magic point." You can | ||
900 | # "liberate" non-volatile registers by denoting last stack off-load | ||
901 | # instruction and reflecting it in finer grade unwind logic in handler. | ||
902 | # After all, isn't it why it's called *language-specific* handler... | ||
903 | # | ||
904 | # Attentive reader can notice that exceptions would be mishandled in | ||
905 | # auto-generated "gear" epilogue. Well, exception effectively can't | ||
906 | # occur there, because if memory area used by it was subject to | ||
907 | # segmentation violation, then it would be raised upon call to the | ||
908 | # function (and as already mentioned be accounted to caller, which is | ||
909 | # not a problem). If you're still not comfortable, then define tail | ||
910 | # "magic point" just prior ret instruction and have handler treat it... | ||
911 | # | ||
912 | # (*) Note that we're talking about run-time, not debug-time. Lack of | ||
913 | # unwind information makes debugging hard on both Windows and | ||
914 | # Unix. "Unlike" referes to the fact that on Unix signal handler | ||
915 | # will always be invoked, core dumped and appropriate exit code | ||
916 | # returned to parent (for user notification). | ||
diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl index f535c9c7fa..4756a28e59 100644 --- a/src/lib/libcrypto/perlasm/x86asm.pl +++ b/src/lib/libcrypto/perlasm/x86asm.pl | |||
@@ -1,136 +1,221 @@ | |||
1 | #!/usr/local/bin/perl | 1 | #!/usr/bin/env perl |
2 | 2 | ||
3 | # require 'x86asm.pl'; | 3 | # require 'x86asm.pl'; |
4 | # &asm_init("cpp","des-586.pl"); | 4 | # &asm_init(<flavor>,"des-586.pl"[,$i386only]); |
5 | # XXX | 5 | # &function_begin("foo"); |
6 | # XXX | 6 | # ... |
7 | # main'asm_finish | 7 | # &function_end("foo"); |
8 | 8 | # &asm_finish | |
9 | sub main'asm_finish | 9 | |
10 | { | 10 | $out=(); |
11 | &file_end(); | 11 | $i386=0; |
12 | &asm_finish_cpp() if $cpp; | 12 | |
13 | print &asm_get_output(); | 13 | # AUTOLOAD is this context has quite unpleasant side effect, namely |
14 | } | 14 | # that typos in function calls effectively go to assembler output, |
15 | 15 | # but on the pros side we don't have to implement one subroutine per | |
16 | sub main'asm_init | 16 | # each opcode... |
17 | { | 17 | sub ::AUTOLOAD |
18 | ($type,$fn,$i386)=@_; | 18 | { my $opcode = $AUTOLOAD; |
19 | $filename=$fn; | 19 | |
20 | 20 | die "more than 4 arguments passed to $opcode" if ($#_>3); | |
21 | $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=$openbsd=0; | 21 | |
22 | if ( ($type eq "elf")) | 22 | $opcode =~ s/.*:://; |
23 | { $elf=1; require "x86unix.pl"; } | 23 | if ($opcode =~ /^push/) { $stack+=4; } |
24 | elsif ( ($type eq "openbsd-elf")) | 24 | elsif ($opcode =~ /^pop/) { $stack-=4; } |
25 | { $openbsd=$elf=1; require "x86unix.pl"; } | 25 | |
26 | elsif ( ($type eq "openbsd-a.out")) | 26 | &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD"; |
27 | { $openbsd=1; require "x86unix.pl"; } | 27 | } |
28 | elsif ( ($type eq "a.out")) | 28 | |
29 | { $aout=1; require "x86unix.pl"; } | 29 | sub ::emit |
30 | elsif ( ($type eq "coff" or $type eq "gaswin")) | 30 | { my $opcode=shift; |
31 | { $coff=1; require "x86unix.pl"; } | 31 | |
32 | elsif ( ($type eq "cpp")) | 32 | if ($#_==-1) { push(@out,"\t$opcode\n"); } |
33 | { $cpp=1; require "x86unix.pl"; } | 33 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } |
34 | elsif ( ($type eq "win32")) | 34 | } |
35 | { $win32=1; require "x86ms.pl"; } | 35 | |
36 | elsif ( ($type eq "win32n")) | 36 | sub ::emitraw |
37 | { $win32=1; require "x86nasm.pl"; } | 37 | { my $opcode=shift; |
38 | elsif ( ($type eq "nw-nasm")) | 38 | |
39 | { $netware=1; require "x86nasm.pl"; } | 39 | if ($#_==-1) { push(@out,"$opcode\n"); } |
40 | elsif ( ($type eq "nw-mwasm")) | 40 | else { push(@out,"$opcode\t".join(',',@_)."\n"); } |
41 | { $netware=1; $mwerks=1; require "x86nasm.pl"; } | 41 | } |
42 | else | 42 | |
43 | { | 43 | sub ::LB |
44 | print STDERR <<"EOF"; | 44 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; |
45 | $1."l"; | ||
46 | } | ||
47 | sub ::HB | ||
48 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; | ||
49 | $1."h"; | ||
50 | } | ||
51 | sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } | ||
52 | sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } | ||
53 | sub ::blindpop { &pop($_[0]); $stack+=4; } | ||
54 | sub ::wparam { &DWP($stack+4*$_[0],"esp"); } | ||
55 | sub ::swtmp { &DWP(4*$_[0],"esp"); } | ||
56 | |||
57 | sub ::bswap | ||
58 | { if ($i386) # emulate bswap for i386 | ||
59 | { &comment("bswap @_"); | ||
60 | &xchg(&HB(@_),&LB(@_)); | ||
61 | &ror (@_,16); | ||
62 | &xchg(&HB(@_),&LB(@_)); | ||
63 | } | ||
64 | else | ||
65 | { &generic("bswap",@_); } | ||
66 | } | ||
67 | # These are made-up opcodes introduced over the years essentially | ||
68 | # by ignorance, just alias them to real ones... | ||
69 | sub ::movb { &mov(@_); } | ||
70 | sub ::xorb { &xor(@_); } | ||
71 | sub ::rotl { &rol(@_); } | ||
72 | sub ::rotr { &ror(@_); } | ||
73 | sub ::exch { &xchg(@_); } | ||
74 | sub ::halt { &hlt; } | ||
75 | sub ::movz { &movzx(@_); } | ||
76 | sub ::pushf { &pushfd; } | ||
77 | sub ::popf { &popfd; } | ||
78 | |||
79 | # 3 argument instructions | ||
80 | sub ::movq | ||
81 | { my($p1,$p2,$optimize)=@_; | ||
82 | |||
83 | if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) | ||
84 | # movq between mmx registers can sink Intel CPUs | ||
85 | { &::pshufw($p1,$p2,0xe4); } | ||
86 | else | ||
87 | { &::generic("movq",@_); } | ||
88 | } | ||
89 | |||
90 | # label management | ||
91 | $lbdecor="L"; # local label decoration, set by package | ||
92 | $label="000"; | ||
93 | |||
94 | sub ::islabel # see is argument is a known label | ||
95 | { my $i; | ||
96 | foreach $i (values %label) { return $i if ($i eq $_[0]); } | ||
97 | $label{$_[0]}; # can be undef | ||
98 | } | ||
99 | |||
100 | sub ::label # instantiate a function-scope label | ||
101 | { if (!defined($label{$_[0]})) | ||
102 | { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } | ||
103 | $label{$_[0]}; | ||
104 | } | ||
105 | |||
106 | sub ::LABEL # instantiate a file-scope label | ||
107 | { $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); | ||
108 | $label{$_[0]}; | ||
109 | } | ||
110 | |||
111 | sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } | ||
112 | |||
113 | sub ::set_label_B { push(@out,"@_:\n"); } | ||
114 | sub ::set_label | ||
115 | { my $label=&::label($_[0]); | ||
116 | &::align($_[1]) if ($_[1]>1); | ||
117 | &::set_label_B($label); | ||
118 | $label; | ||
119 | } | ||
120 | |||
121 | sub ::wipe_labels # wipes function-scope labels | ||
122 | { foreach $i (keys %label) | ||
123 | { delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); } | ||
124 | } | ||
125 | |||
126 | # subroutine management | ||
127 | sub ::function_begin | ||
128 | { &function_begin_B(@_); | ||
129 | $stack=4; | ||
130 | &push("ebp"); | ||
131 | &push("ebx"); | ||
132 | &push("esi"); | ||
133 | &push("edi"); | ||
134 | } | ||
135 | |||
136 | sub ::function_end | ||
137 | { &pop("edi"); | ||
138 | &pop("esi"); | ||
139 | &pop("ebx"); | ||
140 | &pop("ebp"); | ||
141 | &ret(); | ||
142 | &function_end_B(@_); | ||
143 | $stack=0; | ||
144 | &wipe_labels(); | ||
145 | } | ||
146 | |||
147 | sub ::function_end_A | ||
148 | { &pop("edi"); | ||
149 | &pop("esi"); | ||
150 | &pop("ebx"); | ||
151 | &pop("ebp"); | ||
152 | &ret(); | ||
153 | $stack+=16; # readjust esp as if we didn't pop anything | ||
154 | } | ||
155 | |||
156 | sub ::asciz | ||
157 | { my @str=unpack("C*",shift); | ||
158 | push @str,0; | ||
159 | while ($#str>15) { | ||
160 | &data_byte(@str[0..15]); | ||
161 | foreach (0..15) { shift @str; } | ||
162 | } | ||
163 | &data_byte(@str) if (@str); | ||
164 | } | ||
165 | |||
166 | sub ::asm_finish | ||
167 | { &file_end(); | ||
168 | print @out; | ||
169 | } | ||
170 | |||
171 | sub ::asm_init | ||
172 | { my ($type,$fn,$cpu)=@_; | ||
173 | |||
174 | $filename=$fn; | ||
175 | $i386=$cpu; | ||
176 | |||
177 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=0; | ||
178 | if (($type eq "elf")) | ||
179 | { $elf=1; require "x86gas.pl"; } | ||
180 | elsif (($type eq "a\.out")) | ||
181 | { $aout=1; require "x86gas.pl"; } | ||
182 | elsif (($type eq "coff" or $type eq "gaswin")) | ||
183 | { $coff=1; require "x86gas.pl"; } | ||
184 | elsif (($type eq "win32n")) | ||
185 | { $win32=1; require "x86nasm.pl"; } | ||
186 | elsif (($type eq "nw-nasm")) | ||
187 | { $netware=1; require "x86nasm.pl"; } | ||
188 | #elsif (($type eq "nw-mwasm")) | ||
189 | #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } | ||
190 | elsif (($type eq "win32")) | ||
191 | { $win32=1; require "x86masm.pl"; } | ||
192 | elsif (($type eq "macosx")) | ||
193 | { $aout=1; $macosx=1; require "x86gas.pl"; } | ||
194 | elsif (($type eq "openbsd-elf")) | ||
195 | { $openbsd=$elf=1; require "x86gas.pl"; } | ||
196 | elsif (($type eq "openbsd-a.out")) | ||
197 | { $openbsd=1; require "x86gas.pl"; } | ||
198 | else | ||
199 | { print STDERR <<"EOF"; | ||
45 | Pick one target type from | 200 | Pick one target type from |
46 | elf - Linux, FreeBSD, Solaris x86, etc. | 201 | elf - Linux, FreeBSD, Solaris x86, etc. |
47 | a.out - OpenBSD, DJGPP, etc. | 202 | a.out - DJGPP, elder OpenBSD, etc. |
48 | coff - GAS/COFF such as Win32 targets | 203 | coff - GAS/COFF such as Win32 targets |
49 | win32 - Windows 95/Windows NT | ||
50 | win32n - Windows 95/Windows NT NASM format | 204 | win32n - Windows 95/Windows NT NASM format |
51 | openbsd-elf - OpenBSD elf | 205 | openbsd-elf - OpenBSD elf |
52 | openbsd-a.out - OpenBSD a.out | 206 | openbsd-a.out - OpenBSD a.out |
53 | nw-nasm - NetWare NASM format | 207 | nw-nasm - NetWare NASM format |
54 | nw-mwasm- NetWare Metrowerks Assembler | 208 | macosx - Mac OS X |
55 | EOF | 209 | EOF |
56 | exit(1); | 210 | exit(1); |
57 | } | 211 | } |
58 | 212 | ||
59 | $pic=0; | 213 | $pic=0; |
60 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } | 214 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } |
61 | 215 | ||
62 | &asm_init_output(); | 216 | ::emitraw("#include <machine/asm.h>\n") if $openbsd; |
63 | 217 | $filename =~ s/\.pl$//; | |
64 | &comment("Don't even think of reading this code"); | 218 | &file($filename); |
65 | &comment("It was automatically generated by $filename"); | 219 | } |
66 | &comment("Which is a perl program used to generate the x86 assember for"); | ||
67 | &comment("any of ELF, a.out, COFF, Win32, ..."); | ||
68 | &comment("eric <eay\@cryptsoft.com>"); | ||
69 | &comment(""); | ||
70 | |||
71 | $filename =~ s/\.pl$//; | ||
72 | &file($filename); | ||
73 | } | ||
74 | |||
75 | sub asm_finish_cpp | ||
76 | { | ||
77 | return unless $cpp; | ||
78 | |||
79 | local($tmp,$i); | ||
80 | foreach $i (&get_labels()) | ||
81 | { | ||
82 | $tmp.="#define $i _$i\n"; | ||
83 | } | ||
84 | print <<"EOF"; | ||
85 | /* Run the C pre-processor over this file with one of the following defined | ||
86 | * ELF - elf object files, | ||
87 | * OUT - a.out object files, | ||
88 | * BSDI - BSDI style a.out object files | ||
89 | * SOL - Solaris style elf | ||
90 | */ | ||
91 | |||
92 | #define TYPE(a,b) .type a,b | ||
93 | #define SIZE(a,b) .size a,b | ||
94 | |||
95 | #if defined(OUT) || (defined(BSDI) && !defined(ELF)) | ||
96 | $tmp | ||
97 | #endif | ||
98 | |||
99 | #ifdef OUT | ||
100 | #define OK 1 | ||
101 | #define ALIGN 4 | ||
102 | #if defined(__CYGWIN__) || defined(__DJGPP__) || (__MINGW32__) | ||
103 | #undef SIZE | ||
104 | #undef TYPE | ||
105 | #define SIZE(a,b) | ||
106 | #define TYPE(a,b) .def a; .scl 2; .type 32; .endef | ||
107 | #endif /* __CYGWIN || __DJGPP */ | ||
108 | #endif | ||
109 | |||
110 | #if defined(BSDI) && !defined(ELF) | ||
111 | #define OK 1 | ||
112 | #define ALIGN 4 | ||
113 | #undef SIZE | ||
114 | #undef TYPE | ||
115 | #define SIZE(a,b) | ||
116 | #define TYPE(a,b) | ||
117 | #endif | ||
118 | |||
119 | #if defined(ELF) || defined(SOL) | ||
120 | #define OK 1 | ||
121 | #define ALIGN 16 | ||
122 | #endif | ||
123 | |||
124 | #ifndef OK | ||
125 | You need to define one of | ||
126 | ELF - elf systems - linux-elf, NetBSD and DG-UX | ||
127 | OUT - a.out systems - linux-a.out and FreeBSD | ||
128 | SOL - solaris systems, which are elf with strange comment lines | ||
129 | BSDI - a.out with a very primative version of as. | ||
130 | #endif | ||
131 | |||
132 | /* Let the Assembler begin :-) */ | ||
133 | EOF | ||
134 | } | ||
135 | 220 | ||
136 | 1; | 221 | 1; |
diff --git a/src/lib/libcrypto/perlasm/x86gas.pl b/src/lib/libcrypto/perlasm/x86gas.pl index 6eab727fd4..15e17f25d0 100644 --- a/src/lib/libcrypto/perlasm/x86gas.pl +++ b/src/lib/libcrypto/perlasm/x86gas.pl | |||
@@ -180,7 +180,16 @@ sub ::align | |||
180 | sub ::picmeup | 180 | sub ::picmeup |
181 | { my($dst,$sym,$base,$reflabel)=@_; | 181 | { my($dst,$sym,$base,$reflabel)=@_; |
182 | 182 | ||
183 | if ($::pic && ($::elf || $::aout)) | 183 | if ($::openbsd) |
184 | { &::emitraw("#ifdef PIC"); | ||
185 | &::emitraw("PIC_PROLOGUE"); | ||
186 | &::mov($dst, &::DWP("PIC_GOT($sym)")); | ||
187 | &::emitraw("PIC_EPILOGUE"); | ||
188 | &::emitraw("#else /* PIC */"); | ||
189 | &::lea($dst,&::DWP($sym)); | ||
190 | &::emitraw("#endif /* PIC */"); | ||
191 | } | ||
192 | elsif ($::pic && ($::elf || $::aout)) | ||
184 | { if (!defined($base)) | 193 | { if (!defined($base)) |
185 | { &::call(&::label("PIC_me_up")); | 194 | { &::call(&::label("PIC_me_up")); |
186 | &::set_label("PIC_me_up"); | 195 | &::set_label("PIC_me_up"); |
@@ -206,7 +215,18 @@ sub ::picmeup | |||
206 | sub ::initseg | 215 | sub ::initseg |
207 | { my $f=$nmdecor.shift; | 216 | { my $f=$nmdecor.shift; |
208 | 217 | ||
209 | if ($::elf) | 218 | if ($::openbsd) |
219 | { $initseg.=<<___; | ||
220 | .section .init | ||
221 | PIC_PROLOGUE | ||
222 | call PIC_PLT($f) | ||
223 | PIC_EPILOGUE | ||
224 | jmp .Linitalign | ||
225 | .align $align | ||
226 | .Linitalign: | ||
227 | ___ | ||
228 | } | ||
229 | elsif ($::elf) | ||
210 | { $initseg.=<<___; | 230 | { $initseg.=<<___; |
211 | .section .init | 231 | .section .init |
212 | call $f | 232 | call $f |
diff --git a/src/lib/libcrypto/perlasm/x86ms.pl b/src/lib/libcrypto/perlasm/x86ms.pl deleted file mode 100644 index a0be2934c2..0000000000 --- a/src/lib/libcrypto/perlasm/x86ms.pl +++ /dev/null | |||
@@ -1,472 +0,0 @@ | |||
1 | #!/usr/local/bin/perl | ||
2 | |||
3 | package x86ms; | ||
4 | |||
5 | $label="L000"; | ||
6 | |||
7 | %lb=( 'eax', 'al', | ||
8 | 'ebx', 'bl', | ||
9 | 'ecx', 'cl', | ||
10 | 'edx', 'dl', | ||
11 | 'ax', 'al', | ||
12 | 'bx', 'bl', | ||
13 | 'cx', 'cl', | ||
14 | 'dx', 'dl', | ||
15 | ); | ||
16 | |||
17 | %hb=( 'eax', 'ah', | ||
18 | 'ebx', 'bh', | ||
19 | 'ecx', 'ch', | ||
20 | 'edx', 'dh', | ||
21 | 'ax', 'ah', | ||
22 | 'bx', 'bh', | ||
23 | 'cx', 'ch', | ||
24 | 'dx', 'dh', | ||
25 | ); | ||
26 | |||
27 | sub main'asm_init_output { @out=(); } | ||
28 | sub main'asm_get_output { return(@out); } | ||
29 | sub main'get_labels { return(@labels); } | ||
30 | sub main'external_label | ||
31 | { | ||
32 | push(@labels,@_); | ||
33 | foreach (@_) { | ||
34 | push(@out, "EXTRN\t_$_:DWORD\n"); | ||
35 | } | ||
36 | } | ||
37 | |||
38 | sub main'LB | ||
39 | { | ||
40 | (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; | ||
41 | return($lb{$_[0]}); | ||
42 | } | ||
43 | |||
44 | sub main'HB | ||
45 | { | ||
46 | (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; | ||
47 | return($hb{$_[0]}); | ||
48 | } | ||
49 | |||
50 | sub main'BP | ||
51 | { | ||
52 | &get_mem("BYTE",@_); | ||
53 | } | ||
54 | |||
55 | sub main'DWP | ||
56 | { | ||
57 | &get_mem("DWORD",@_); | ||
58 | } | ||
59 | |||
60 | sub main'QWP | ||
61 | { | ||
62 | &get_mem("QWORD",@_); | ||
63 | } | ||
64 | |||
65 | sub main'BC | ||
66 | { | ||
67 | return @_; | ||
68 | } | ||
69 | |||
70 | sub main'DWC | ||
71 | { | ||
72 | return @_; | ||
73 | } | ||
74 | |||
75 | sub main'stack_push | ||
76 | { | ||
77 | local($num)=@_; | ||
78 | $stack+=$num*4; | ||
79 | &main'sub("esp",$num*4); | ||
80 | } | ||
81 | |||
82 | sub main'stack_pop | ||
83 | { | ||
84 | local($num)=@_; | ||
85 | $stack-=$num*4; | ||
86 | &main'add("esp",$num*4); | ||
87 | } | ||
88 | |||
89 | sub get_mem | ||
90 | { | ||
91 | local($size,$addr,$reg1,$reg2,$idx)=@_; | ||
92 | local($t,$post); | ||
93 | local($ret)="$size PTR "; | ||
94 | |||
95 | $addr =~ s/^\s+//; | ||
96 | if ($addr =~ /^(.+)\+(.+)$/) | ||
97 | { | ||
98 | $reg2=&conv($1); | ||
99 | $addr="_$2"; | ||
100 | } | ||
101 | elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) | ||
102 | { | ||
103 | $addr="_$addr"; | ||
104 | } | ||
105 | |||
106 | if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } | ||
107 | |||
108 | $reg1="$regs{$reg1}" if defined($regs{$reg1}); | ||
109 | $reg2="$regs{$reg2}" if defined($regs{$reg2}); | ||
110 | if (($addr ne "") && ($addr ne 0)) | ||
111 | { | ||
112 | if ($addr !~ /^-/) | ||
113 | { $ret.=$addr; } | ||
114 | else { $post=$addr; } | ||
115 | } | ||
116 | if ($reg2 ne "") | ||
117 | { | ||
118 | $t=""; | ||
119 | $t="*$idx" if ($idx != 0); | ||
120 | $reg1="+".$reg1 if ("$reg1$post" ne ""); | ||
121 | $ret.="[$reg2$t$reg1$post]"; | ||
122 | } | ||
123 | else | ||
124 | { | ||
125 | $ret.="[$reg1$post]" | ||
126 | } | ||
127 | $ret =~ s/\[\]//; # in case $addr was the only argument | ||
128 | return($ret); | ||
129 | } | ||
130 | |||
131 | sub main'mov { &out2("mov",@_); } | ||
132 | sub main'movb { &out2("mov",@_); } | ||
133 | sub main'and { &out2("and",@_); } | ||
134 | sub main'or { &out2("or",@_); } | ||
135 | sub main'shl { &out2("shl",@_); } | ||
136 | sub main'shr { &out2("shr",@_); } | ||
137 | sub main'xor { &out2("xor",@_); } | ||
138 | sub main'xorb { &out2("xor",@_); } | ||
139 | sub main'add { &out2("add",@_); } | ||
140 | sub main'adc { &out2("adc",@_); } | ||
141 | sub main'sub { &out2("sub",@_); } | ||
142 | sub main'sbb { &out2("sbb",@_); } | ||
143 | sub main'rotl { &out2("rol",@_); } | ||
144 | sub main'rotr { &out2("ror",@_); } | ||
145 | sub main'exch { &out2("xchg",@_); } | ||
146 | sub main'cmp { &out2("cmp",@_); } | ||
147 | sub main'lea { &out2("lea",@_); } | ||
148 | sub main'mul { &out1("mul",@_); } | ||
149 | sub main'imul { &out2("imul",@_); } | ||
150 | sub main'div { &out1("div",@_); } | ||
151 | sub main'dec { &out1("dec",@_); } | ||
152 | sub main'inc { &out1("inc",@_); } | ||
153 | sub main'jmp { &out1("jmp",@_); } | ||
154 | sub main'jmp_ptr { &out1p("jmp",@_); } | ||
155 | sub main'je { &out1("je",@_); } | ||
156 | sub main'jle { &out1("jle",@_); } | ||
157 | sub main'jz { &out1("jz",@_); } | ||
158 | sub main'jge { &out1("jge",@_); } | ||
159 | sub main'jl { &out1("jl",@_); } | ||
160 | sub main'ja { &out1("ja",@_); } | ||
161 | sub main'jae { &out1("jae",@_); } | ||
162 | sub main'jb { &out1("jb",@_); } | ||
163 | sub main'jbe { &out1("jbe",@_); } | ||
164 | sub main'jc { &out1("jc",@_); } | ||
165 | sub main'jnc { &out1("jnc",@_); } | ||
166 | sub main'jnz { &out1("jnz",@_); } | ||
167 | sub main'jne { &out1("jne",@_); } | ||
168 | sub main'jno { &out1("jno",@_); } | ||
169 | sub main'push { &out1("push",@_); $stack+=4; } | ||
170 | sub main'pop { &out1("pop",@_); $stack-=4; } | ||
171 | sub main'pushf { &out0("pushfd"); $stack+=4; } | ||
172 | sub main'popf { &out0("popfd"); $stack-=4; } | ||
173 | sub main'bswap { &out1("bswap",@_); &using486(); } | ||
174 | sub main'not { &out1("not",@_); } | ||
175 | sub main'call { &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); } | ||
176 | sub main'call_ptr { &out1p("call",@_); } | ||
177 | sub main'ret { &out0("ret"); } | ||
178 | sub main'nop { &out0("nop"); } | ||
179 | sub main'test { &out2("test",@_); } | ||
180 | sub main'bt { &out2("bt",@_); } | ||
181 | sub main'leave { &out0("leave"); } | ||
182 | sub main'cpuid { &out0("DW\t0A20Fh"); } | ||
183 | sub main'rdtsc { &out0("DW\t0310Fh"); } | ||
184 | sub main'halt { &out0("hlt"); } | ||
185 | sub main'movz { &out2("movzx",@_); } | ||
186 | sub main'neg { &out1("neg",@_); } | ||
187 | sub main'cld { &out0("cld"); } | ||
188 | |||
189 | # SSE2 | ||
190 | sub main'emms { &out0("emms"); } | ||
191 | sub main'movd { &out2("movd",@_); } | ||
192 | sub main'movq { &out2("movq",@_); } | ||
193 | sub main'movdqu { &out2("movdqu",@_); } | ||
194 | sub main'movdqa { &out2("movdqa",@_); } | ||
195 | sub main'movdq2q{ &out2("movdq2q",@_); } | ||
196 | sub main'movq2dq{ &out2("movq2dq",@_); } | ||
197 | sub main'paddq { &out2("paddq",@_); } | ||
198 | sub main'pmuludq{ &out2("pmuludq",@_); } | ||
199 | sub main'psrlq { &out2("psrlq",@_); } | ||
200 | sub main'psllq { &out2("psllq",@_); } | ||
201 | sub main'pxor { &out2("pxor",@_); } | ||
202 | sub main'por { &out2("por",@_); } | ||
203 | sub main'pand { &out2("pand",@_); } | ||
204 | |||
205 | sub out2 | ||
206 | { | ||
207 | local($name,$p1,$p2)=@_; | ||
208 | local($l,$t,$line); | ||
209 | |||
210 | $line="\t$name\t"; | ||
211 | $t=&conv($p1).","; | ||
212 | $l=length($t); | ||
213 | $line.="$t"; | ||
214 | $l=4-($l+9)/8; | ||
215 | $line.="\t" x $l; | ||
216 | $line.=&conv($p2); | ||
217 | if ($line=~/\bxmm[0-7]\b/i) { $line=~s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i; } | ||
218 | push(@out,$line."\n"); | ||
219 | } | ||
220 | |||
221 | sub out0 | ||
222 | { | ||
223 | local($name)=@_; | ||
224 | |||
225 | push(@out,"\t$name\n"); | ||
226 | } | ||
227 | |||
228 | sub out1 | ||
229 | { | ||
230 | local($name,$p1)=@_; | ||
231 | local($l,$t); | ||
232 | |||
233 | push(@out,"\t$name\t".&conv($p1)."\n"); | ||
234 | } | ||
235 | |||
236 | sub conv | ||
237 | { | ||
238 | local($p)=@_; | ||
239 | |||
240 | $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; | ||
241 | return $p; | ||
242 | } | ||
243 | |||
244 | sub using486 | ||
245 | { | ||
246 | return if $using486; | ||
247 | $using486++; | ||
248 | grep(s/\.386/\.486/,@out); | ||
249 | } | ||
250 | |||
251 | sub main'file | ||
252 | { | ||
253 | local($file)=@_; | ||
254 | |||
255 | local($tmp)=<<"EOF"; | ||
256 | TITLE $file.asm | ||
257 | .386 | ||
258 | .model FLAT | ||
259 | _TEXT\$ SEGMENT PAGE 'CODE' | ||
260 | |||
261 | EOF | ||
262 | push(@out,$tmp); | ||
263 | } | ||
264 | |||
265 | sub main'function_begin | ||
266 | { | ||
267 | local($func,$extra)=@_; | ||
268 | |||
269 | push(@labels,$func); | ||
270 | |||
271 | local($tmp)=<<"EOF"; | ||
272 | PUBLIC _$func | ||
273 | $extra | ||
274 | _$func PROC NEAR | ||
275 | push ebp | ||
276 | push ebx | ||
277 | push esi | ||
278 | push edi | ||
279 | EOF | ||
280 | push(@out,$tmp); | ||
281 | $stack=20; | ||
282 | } | ||
283 | |||
284 | sub main'function_begin_B | ||
285 | { | ||
286 | local($func,$extra)=@_; | ||
287 | |||
288 | local($tmp)=<<"EOF"; | ||
289 | PUBLIC _$func | ||
290 | $extra | ||
291 | _$func PROC NEAR | ||
292 | EOF | ||
293 | push(@out,$tmp); | ||
294 | $stack=4; | ||
295 | } | ||
296 | |||
297 | sub main'function_end | ||
298 | { | ||
299 | local($func)=@_; | ||
300 | |||
301 | local($tmp)=<<"EOF"; | ||
302 | pop edi | ||
303 | pop esi | ||
304 | pop ebx | ||
305 | pop ebp | ||
306 | ret | ||
307 | _$func ENDP | ||
308 | EOF | ||
309 | push(@out,$tmp); | ||
310 | $stack=0; | ||
311 | %label=(); | ||
312 | } | ||
313 | |||
314 | sub main'function_end_B | ||
315 | { | ||
316 | local($func)=@_; | ||
317 | |||
318 | local($tmp)=<<"EOF"; | ||
319 | _$func ENDP | ||
320 | EOF | ||
321 | push(@out,$tmp); | ||
322 | $stack=0; | ||
323 | %label=(); | ||
324 | } | ||
325 | |||
326 | sub main'function_end_A | ||
327 | { | ||
328 | local($func)=@_; | ||
329 | |||
330 | local($tmp)=<<"EOF"; | ||
331 | pop edi | ||
332 | pop esi | ||
333 | pop ebx | ||
334 | pop ebp | ||
335 | ret | ||
336 | EOF | ||
337 | push(@out,$tmp); | ||
338 | } | ||
339 | |||
340 | sub main'file_end | ||
341 | { | ||
342 | # try to detect if SSE2 or MMX extensions were used... | ||
343 | my $xmmheader=<<___; | ||
344 | .686 | ||
345 | .XMM | ||
346 | IF \@Version LT 800 | ||
347 | XMMWORD STRUCT 16 | ||
348 | DQ 2 dup (?) | ||
349 | XMMWORD ENDS | ||
350 | ENDIF | ||
351 | ___ | ||
352 | if (grep {/\b[x]?mm[0-7]\b/i} @out) { | ||
353 | grep {s/\.[3-7]86/$xmmheader/} @out; | ||
354 | } | ||
355 | push(@out,"_TEXT\$ ENDS\n"); | ||
356 | push(@out,"END\n"); | ||
357 | } | ||
358 | |||
359 | sub main'wparam | ||
360 | { | ||
361 | local($num)=@_; | ||
362 | |||
363 | return(&main'DWP($stack+$num*4,"esp","",0)); | ||
364 | } | ||
365 | |||
366 | sub main'swtmp | ||
367 | { | ||
368 | return(&main'DWP($_[0]*4,"esp","",0)); | ||
369 | } | ||
370 | |||
371 | # Should use swtmp, which is above esp. Linix can trash the stack above esp | ||
372 | #sub main'wtmp | ||
373 | # { | ||
374 | # local($num)=@_; | ||
375 | # | ||
376 | # return(&main'DWP(-(($num+1)*4),"esp","",0)); | ||
377 | # } | ||
378 | |||
379 | sub main'comment | ||
380 | { | ||
381 | foreach (@_) | ||
382 | { | ||
383 | push(@out,"\t; $_\n"); | ||
384 | } | ||
385 | } | ||
386 | |||
387 | sub main'public_label | ||
388 | { | ||
389 | $label{$_[0]}="_$_[0]" if (!defined($label{$_[0]})); | ||
390 | push(@out,"PUBLIC\t$label{$_[0]}\n"); | ||
391 | } | ||
392 | |||
393 | sub main'label | ||
394 | { | ||
395 | if (!defined($label{$_[0]})) | ||
396 | { | ||
397 | $label{$_[0]}="\$${label}${_[0]}"; | ||
398 | $label++; | ||
399 | } | ||
400 | return($label{$_[0]}); | ||
401 | } | ||
402 | |||
403 | sub main'set_label | ||
404 | { | ||
405 | if (!defined($label{$_[0]})) | ||
406 | { | ||
407 | $label{$_[0]}="\$${label}${_[0]}"; | ||
408 | $label++; | ||
409 | } | ||
410 | if ($_[1]!=0 && $_[1]>1) | ||
411 | { | ||
412 | main'align($_[1]); | ||
413 | } | ||
414 | if((defined $_[2]) && ($_[2] == 1)) | ||
415 | { | ||
416 | push(@out,"$label{$_[0]}::\n"); | ||
417 | } | ||
418 | elsif ($label{$_[0]} !~ /^\$/) | ||
419 | { | ||
420 | push(@out,"$label{$_[0]}\tLABEL PTR\n"); | ||
421 | } | ||
422 | else | ||
423 | { | ||
424 | push(@out,"$label{$_[0]}:\n"); | ||
425 | } | ||
426 | } | ||
427 | |||
428 | sub main'data_byte | ||
429 | { | ||
430 | push(@out,"\tDB\t".join(',',@_)."\n"); | ||
431 | } | ||
432 | |||
433 | sub main'data_word | ||
434 | { | ||
435 | push(@out,"\tDD\t".join(',',@_)."\n"); | ||
436 | } | ||
437 | |||
438 | sub main'align | ||
439 | { | ||
440 | push(@out,"\tALIGN\t$_[0]\n"); | ||
441 | } | ||
442 | |||
443 | sub out1p | ||
444 | { | ||
445 | local($name,$p1)=@_; | ||
446 | local($l,$t); | ||
447 | |||
448 | push(@out,"\t$name\t".&conv($p1)."\n"); | ||
449 | } | ||
450 | |||
451 | sub main'picmeup | ||
452 | { | ||
453 | local($dst,$sym)=@_; | ||
454 | &main'lea($dst,&main'DWP($sym)); | ||
455 | } | ||
456 | |||
457 | sub main'blindpop { &out1("pop",@_); } | ||
458 | |||
459 | sub main'initseg | ||
460 | { | ||
461 | local($f)=@_; | ||
462 | local($tmp)=<<___; | ||
463 | OPTION DOTNAME | ||
464 | .CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' | ||
465 | EXTRN _$f:NEAR | ||
466 | DD _$f | ||
467 | .CRT\$XCU ENDS | ||
468 | ___ | ||
469 | push(@out,$tmp); | ||
470 | } | ||
471 | |||
472 | 1; | ||
diff --git a/src/lib/libcrypto/perlasm/x86nasm.pl b/src/lib/libcrypto/perlasm/x86nasm.pl index fa38f89c09..ce2bed9bb2 100644 --- a/src/lib/libcrypto/perlasm/x86nasm.pl +++ b/src/lib/libcrypto/perlasm/x86nasm.pl | |||
@@ -1,455 +1,166 @@ | |||
1 | #!/usr/local/bin/perl | 1 | #!/usr/bin/env perl |
2 | 2 | ||
3 | package x86nasm; | 3 | package x86nasm; |
4 | 4 | ||
5 | $label="L000"; | 5 | *out=\@::out; |
6 | $under=($main'netware)?'':'_'; | ||
7 | 6 | ||
8 | %lb=( 'eax', 'al', | 7 | $::lbdecor="L\$"; # local label decoration |
9 | 'ebx', 'bl', | 8 | $nmdecor=$::netware?"":"_"; # external name decoration |
10 | 'ecx', 'cl', | 9 | $drdecor=$::mwerks?".":""; # directive decoration |
11 | 'edx', 'dl', | ||
12 | 'ax', 'al', | ||
13 | 'bx', 'bl', | ||
14 | 'cx', 'cl', | ||
15 | 'dx', 'dl', | ||
16 | ); | ||
17 | 10 | ||
18 | %hb=( 'eax', 'ah', | 11 | $initseg=""; |
19 | 'ebx', 'bh', | ||
20 | 'ecx', 'ch', | ||
21 | 'edx', 'dh', | ||
22 | 'ax', 'ah', | ||
23 | 'bx', 'bh', | ||
24 | 'cx', 'ch', | ||
25 | 'dx', 'dh', | ||
26 | ); | ||
27 | 12 | ||
28 | sub main'asm_init_output { @out=(); } | 13 | sub ::generic |
29 | sub main'asm_get_output { return(@out); } | 14 | { my $opcode=shift; |
30 | sub main'get_labels { return(@labels); } | 15 | my $tmp; |
31 | 16 | ||
32 | sub main'external_label | 17 | if (!$::mwerks) |
33 | { | 18 | { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps |
34 | push(@labels,@_); | 19 | { $_[0] = "NEAR $_[0]"; } |
35 | foreach (@_) { | 20 | elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea |
36 | push(@out,".") if ($main'mwerks); | 21 | { $_[1] =~ s/^[^\[]*\[/\[/o; } |
37 | push(@out, "extern\t${under}$_\n"); | 22 | } |
38 | } | 23 | &::emit($opcode,@_); |
24 | 1; | ||
39 | } | 25 | } |
40 | 26 | # | |
41 | sub main'LB | 27 | # opcodes not covered by ::generic above, mostly inconsistent namings... |
42 | { | 28 | # |
43 | (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; | 29 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } |
44 | return($lb{$_[0]}); | 30 | sub ::call_ptr { &::emit("call",@_); } |
45 | } | 31 | sub ::jmp_ptr { &::emit("jmp",@_); } |
46 | |||
47 | sub main'HB | ||
48 | { | ||
49 | (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; | ||
50 | return($hb{$_[0]}); | ||
51 | } | ||
52 | |||
53 | sub main'BP | ||
54 | { | ||
55 | &get_mem("BYTE",@_); | ||
56 | } | ||
57 | |||
58 | sub main'DWP | ||
59 | { | ||
60 | &get_mem("DWORD",@_); | ||
61 | } | ||
62 | |||
63 | sub main'QWP | ||
64 | { | ||
65 | &get_mem("",@_); | ||
66 | } | ||
67 | |||
68 | sub main'BC | ||
69 | { | ||
70 | return (($main'mwerks)?"":"BYTE ")."@_"; | ||
71 | } | ||
72 | |||
73 | sub main'DWC | ||
74 | { | ||
75 | return (($main'mwerks)?"":"DWORD ")."@_"; | ||
76 | } | ||
77 | |||
78 | sub main'stack_push | ||
79 | { | ||
80 | my($num)=@_; | ||
81 | $stack+=$num*4; | ||
82 | &main'sub("esp",$num*4); | ||
83 | } | ||
84 | |||
85 | sub main'stack_pop | ||
86 | { | ||
87 | my($num)=@_; | ||
88 | $stack-=$num*4; | ||
89 | &main'add("esp",$num*4); | ||
90 | } | ||
91 | 32 | ||
92 | sub get_mem | 33 | sub get_mem |
93 | { | 34 | { my($size,$addr,$reg1,$reg2,$idx)=@_; |
94 | my($size,$addr,$reg1,$reg2,$idx)=@_; | 35 | my($post,$ret); |
95 | my($t,$post); | 36 | |
96 | my($ret)=$size; | 37 | if ($size ne "") |
97 | if ($ret ne "") | 38 | { $ret .= "$size"; |
98 | { | 39 | $ret .= " PTR" if ($::mwerks); |
99 | $ret .= " PTR" if ($main'mwerks); | 40 | $ret .= " "; |
100 | $ret .= " "; | 41 | } |
101 | } | 42 | $ret .= "["; |
102 | $ret .= "["; | 43 | |
103 | $addr =~ s/^\s+//; | 44 | $addr =~ s/^\s+//; |
104 | if ($addr =~ /^(.+)\+(.+)$/) | 45 | # prepend global references with optional underscore |
105 | { | 46 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; |
106 | $reg2=&conv($1); | 47 | # put address arithmetic expression in parenthesis |
107 | $addr="$under$2"; | 48 | $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); |
108 | } | 49 | |
109 | elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) | 50 | if (($addr ne "") && ($addr ne 0)) |
110 | { | 51 | { if ($addr !~ /^-/) { $ret .= "$addr+"; } |
111 | $addr="$under$addr"; | 52 | else { $post=$addr; } |
112 | } | 53 | } |
113 | 54 | ||
114 | if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } | 55 | if ($reg2 ne "") |
115 | 56 | { $idx!=0 or $idx=1; | |
116 | $reg1="$regs{$reg1}" if defined($regs{$reg1}); | 57 | $ret .= "$reg2*$idx"; |
117 | $reg2="$regs{$reg2}" if defined($regs{$reg2}); | 58 | $ret .= "+$reg1" if ($reg1 ne ""); |
118 | if (($addr ne "") && ($addr ne 0)) | 59 | } |
119 | { | 60 | else |
120 | if ($addr !~ /^-/) | 61 | { $ret .= "$reg1"; } |
121 | { $ret.="${addr}+"; } | 62 | |
122 | else { $post=$addr; } | 63 | $ret .= "$post]"; |
123 | } | 64 | $ret =~ s/\+\]/]/; # in case $addr was the only argument |
124 | if ($reg2 ne "") | 65 | |
125 | { | 66 | $ret; |
126 | $t=""; | 67 | } |
127 | $t="*$idx" if ($idx != 0); | 68 | sub ::BP { &get_mem("BYTE",@_); } |
128 | $reg1="+".$reg1 if ("$reg1$post" ne ""); | 69 | sub ::DWP { &get_mem("DWORD",@_); } |
129 | $ret.="$reg2$t$reg1$post]"; | 70 | sub ::QWP { &get_mem("",@_); } |
130 | } | 71 | sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } |
131 | else | 72 | sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } |
132 | { | 73 | |
133 | $ret.="$reg1$post]" | 74 | sub ::file |
134 | } | 75 | { if ($::mwerks) { push(@out,".section\t.text,64\n"); } |
135 | $ret =~ s/\+\]/]/; # in case $addr was the only argument | 76 | else |
136 | return($ret); | 77 | { my $tmp=<<___; |
137 | } | 78 | %ifidn __OUTPUT_FORMAT__,obj |
138 | 79 | section code use32 class=code align=64 | |
139 | sub main'mov { &out2("mov",@_); } | 80 | %elifidn __OUTPUT_FORMAT__,win32 |
140 | sub main'movb { &out2("mov",@_); } | 81 | \$\@feat.00 equ 1 |
141 | sub main'and { &out2("and",@_); } | 82 | section .text code align=64 |
142 | sub main'or { &out2("or",@_); } | ||
143 | sub main'shl { &out2("shl",@_); } | ||
144 | sub main'shr { &out2("shr",@_); } | ||
145 | sub main'xor { &out2("xor",@_); } | ||
146 | sub main'xorb { &out2("xor",@_); } | ||
147 | sub main'add { &out2("add",@_); } | ||
148 | sub main'adc { &out2("adc",@_); } | ||
149 | sub main'sub { &out2("sub",@_); } | ||
150 | sub main'sbb { &out2("sbb",@_); } | ||
151 | sub main'rotl { &out2("rol",@_); } | ||
152 | sub main'rotr { &out2("ror",@_); } | ||
153 | sub main'exch { &out2("xchg",@_); } | ||
154 | sub main'cmp { &out2("cmp",@_); } | ||
155 | sub main'lea { &out2("lea",@_); } | ||
156 | sub main'mul { &out1("mul",@_); } | ||
157 | sub main'imul { &out2("imul",@_); } | ||
158 | sub main'div { &out1("div",@_); } | ||
159 | sub main'dec { &out1("dec",@_); } | ||
160 | sub main'inc { &out1("inc",@_); } | ||
161 | sub main'jmp { &out1("jmp",@_); } | ||
162 | sub main'jmp_ptr { &out1p("jmp",@_); } | ||
163 | |||
164 | # This is a bit of a kludge: declare all branches as NEAR. | ||
165 | $near=($main'mwerks)?'':'NEAR'; | ||
166 | sub main'je { &out1("je $near",@_); } | ||
167 | sub main'jle { &out1("jle $near",@_); } | ||
168 | sub main'jz { &out1("jz $near",@_); } | ||
169 | sub main'jge { &out1("jge $near",@_); } | ||
170 | sub main'jl { &out1("jl $near",@_); } | ||
171 | sub main'ja { &out1("ja $near",@_); } | ||
172 | sub main'jae { &out1("jae $near",@_); } | ||
173 | sub main'jb { &out1("jb $near",@_); } | ||
174 | sub main'jbe { &out1("jbe $near",@_); } | ||
175 | sub main'jc { &out1("jc $near",@_); } | ||
176 | sub main'jnc { &out1("jnc $near",@_); } | ||
177 | sub main'jnz { &out1("jnz $near",@_); } | ||
178 | sub main'jne { &out1("jne $near",@_); } | ||
179 | sub main'jno { &out1("jno $near",@_); } | ||
180 | |||
181 | sub main'push { &out1("push",@_); $stack+=4; } | ||
182 | sub main'pop { &out1("pop",@_); $stack-=4; } | ||
183 | sub main'pushf { &out0("pushfd"); $stack+=4; } | ||
184 | sub main'popf { &out0("popfd"); $stack-=4; } | ||
185 | sub main'bswap { &out1("bswap",@_); &using486(); } | ||
186 | sub main'not { &out1("not",@_); } | ||
187 | sub main'call { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); } | ||
188 | sub main'call_ptr { &out1p("call",@_); } | ||
189 | sub main'ret { &out0("ret"); } | ||
190 | sub main'nop { &out0("nop"); } | ||
191 | sub main'test { &out2("test",@_); } | ||
192 | sub main'bt { &out2("bt",@_); } | ||
193 | sub main'leave { &out0("leave"); } | ||
194 | sub main'cpuid { &out0("cpuid"); } | ||
195 | sub main'rdtsc { &out0("rdtsc"); } | ||
196 | sub main'halt { &out0("hlt"); } | ||
197 | sub main'movz { &out2("movzx",@_); } | ||
198 | sub main'neg { &out1("neg",@_); } | ||
199 | sub main'cld { &out0("cld"); } | ||
200 | |||
201 | # SSE2 | ||
202 | sub main'emms { &out0("emms"); } | ||
203 | sub main'movd { &out2("movd",@_); } | ||
204 | sub main'movq { &out2("movq",@_); } | ||
205 | sub main'movdqu { &out2("movdqu",@_); } | ||
206 | sub main'movdqa { &out2("movdqa",@_); } | ||
207 | sub main'movdq2q{ &out2("movdq2q",@_); } | ||
208 | sub main'movq2dq{ &out2("movq2dq",@_); } | ||
209 | sub main'paddq { &out2("paddq",@_); } | ||
210 | sub main'pmuludq{ &out2("pmuludq",@_); } | ||
211 | sub main'psrlq { &out2("psrlq",@_); } | ||
212 | sub main'psllq { &out2("psllq",@_); } | ||
213 | sub main'pxor { &out2("pxor",@_); } | ||
214 | sub main'por { &out2("por",@_); } | ||
215 | sub main'pand { &out2("pand",@_); } | ||
216 | |||
217 | sub out2 | ||
218 | { | ||
219 | my($name,$p1,$p2)=@_; | ||
220 | my($l,$t); | ||
221 | |||
222 | push(@out,"\t$name\t"); | ||
223 | if (!$main'mwerks and $name eq "lea") | ||
224 | { | ||
225 | $p1 =~ s/^[^\[]*\[/\[/; | ||
226 | $p2 =~ s/^[^\[]*\[/\[/; | ||
227 | } | ||
228 | $t=&conv($p1).","; | ||
229 | $l=length($t); | ||
230 | push(@out,$t); | ||
231 | $l=4-($l+9)/8; | ||
232 | push(@out,"\t" x $l); | ||
233 | push(@out,&conv($p2)); | ||
234 | push(@out,"\n"); | ||
235 | } | ||
236 | |||
237 | sub out0 | ||
238 | { | ||
239 | my($name)=@_; | ||
240 | |||
241 | push(@out,"\t$name\n"); | ||
242 | } | ||
243 | |||
244 | sub out1 | ||
245 | { | ||
246 | my($name,$p1)=@_; | ||
247 | my($l,$t); | ||
248 | push(@out,"\t$name\t".&conv($p1)."\n"); | ||
249 | } | ||
250 | |||
251 | sub conv | ||
252 | { | ||
253 | my($p)=@_; | ||
254 | $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; | ||
255 | return $p; | ||
256 | } | ||
257 | |||
258 | sub using486 | ||
259 | { | ||
260 | return if $using486; | ||
261 | $using486++; | ||
262 | grep(s/\.386/\.486/,@out); | ||
263 | } | ||
264 | |||
265 | sub main'file | ||
266 | { | ||
267 | if ($main'mwerks) { push(@out,".section\t.text\n"); } | ||
268 | else { | ||
269 | local $tmp=<<___; | ||
270 | %ifdef __omf__ | ||
271 | section code use32 class=code | ||
272 | %else | 83 | %else |
273 | section .text | 84 | section .text code |
274 | %endif | 85 | %endif |
275 | ___ | 86 | ___ |
276 | push(@out,$tmp); | ||
277 | } | ||
278 | } | ||
279 | |||
280 | sub main'function_begin | ||
281 | { | ||
282 | my($func,$extra)=@_; | ||
283 | |||
284 | push(@labels,$func); | ||
285 | push(@out,".") if ($main'mwerks); | ||
286 | my($tmp)=<<"EOF"; | ||
287 | global $under$func | ||
288 | $under$func: | ||
289 | push ebp | ||
290 | push ebx | ||
291 | push esi | ||
292 | push edi | ||
293 | EOF | ||
294 | push(@out,$tmp); | ||
295 | $stack=20; | ||
296 | } | ||
297 | |||
298 | sub main'function_begin_B | ||
299 | { | ||
300 | my($func,$extra)=@_; | ||
301 | push(@out,".") if ($main'mwerks); | ||
302 | my($tmp)=<<"EOF"; | ||
303 | global $under$func | ||
304 | $under$func: | ||
305 | EOF | ||
306 | push(@out,$tmp); | ||
307 | $stack=4; | ||
308 | } | ||
309 | |||
310 | sub main'function_end | ||
311 | { | ||
312 | my($func)=@_; | ||
313 | |||
314 | my($tmp)=<<"EOF"; | ||
315 | pop edi | ||
316 | pop esi | ||
317 | pop ebx | ||
318 | pop ebp | ||
319 | ret | ||
320 | EOF | ||
321 | push(@out,$tmp); | 87 | push(@out,$tmp); |
322 | $stack=0; | 88 | } |
323 | %label=(); | 89 | } |
324 | } | ||
325 | |||
326 | sub main'function_end_B | ||
327 | { | ||
328 | $stack=0; | ||
329 | %label=(); | ||
330 | } | ||
331 | |||
332 | sub main'function_end_A | ||
333 | { | ||
334 | my($func)=@_; | ||
335 | |||
336 | my($tmp)=<<"EOF"; | ||
337 | pop edi | ||
338 | pop esi | ||
339 | pop ebx | ||
340 | pop ebp | ||
341 | ret | ||
342 | EOF | ||
343 | push(@out,$tmp); | ||
344 | } | ||
345 | |||
346 | sub main'file_end | ||
347 | { | ||
348 | } | ||
349 | |||
350 | sub main'wparam | ||
351 | { | ||
352 | my($num)=@_; | ||
353 | |||
354 | return(&main'DWP($stack+$num*4,"esp","",0)); | ||
355 | } | ||
356 | 90 | ||
357 | sub main'swtmp | 91 | sub ::function_begin_B |
358 | { | 92 | { my $func=shift; |
359 | return(&main'DWP($_[0]*4,"esp","",0)); | 93 | my $global=($func !~ /^_/); |
360 | } | 94 | my $begin="${::lbdecor}_${func}_begin"; |
361 | 95 | ||
362 | # Should use swtmp, which is above esp. Linix can trash the stack above esp | 96 | $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops |
363 | #sub main'wtmp | ||
364 | # { | ||
365 | # my($num)=@_; | ||
366 | # | ||
367 | # return(&main'DWP(-(($num+1)*4),"esp","",0)); | ||
368 | # } | ||
369 | 97 | ||
370 | sub main'comment | 98 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); |
371 | { | 99 | $func=$nmdecor.$func; |
372 | foreach (@_) | ||
373 | { | ||
374 | push(@out,"\t; $_\n"); | ||
375 | } | ||
376 | } | ||
377 | 100 | ||
378 | sub main'public_label | 101 | push(@out,"${drdecor}global $func\n") if ($global); |
379 | { | 102 | push(@out,"${drdecor}align 16\n"); |
380 | $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); | 103 | push(@out,"$func:\n"); |
381 | push(@out,".") if ($main'mwerks); | 104 | push(@out,"$begin:\n") if ($global); |
382 | push(@out,"global\t$label{$_[0]}\n"); | 105 | $::stack=4; |
383 | } | 106 | } |
384 | 107 | ||
385 | sub main'label | 108 | sub ::function_end_B |
386 | { | 109 | { $::stack=0; |
387 | if (!defined($label{$_[0]})) | 110 | &::wipe_labels(); |
388 | { | 111 | } |
389 | $label{$_[0]}="\@${label}${_[0]}"; | ||
390 | $label++; | ||
391 | } | ||
392 | return($label{$_[0]}); | ||
393 | } | ||
394 | 112 | ||
395 | sub main'set_label | 113 | sub ::file_end |
396 | { | 114 | { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) |
397 | if (!defined($label{$_[0]})) | 115 | { my $comm=<<___; |
398 | { | 116 | ${drdecor}segment .bss |
399 | $label{$_[0]}="\@${label}${_[0]}"; | 117 | ${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 4 |
400 | $label++; | 118 | ___ |
401 | } | 119 | # comment out OPENSSL_ia32cap_P declarations |
402 | if ($_[1]!=0 && $_[1]>1) | 120 | grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; |
403 | { | 121 | push (@out,$comm) |
404 | main'align($_[1]); | 122 | } |
405 | } | 123 | push (@out,$initseg) if ($initseg); |
406 | push(@out,"$label{$_[0]}:\n"); | 124 | } |
407 | } | ||
408 | 125 | ||
409 | sub main'data_byte | 126 | sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } |
410 | { | ||
411 | push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n"); | ||
412 | } | ||
413 | 127 | ||
414 | sub main'data_word | 128 | sub ::external_label |
415 | { | 129 | { foreach(@_) |
416 | push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); | 130 | { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } |
417 | } | 131 | } |
418 | 132 | ||
419 | sub main'align | 133 | sub ::public_label |
420 | { | 134 | { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } |
421 | push(@out,".") if ($main'mwerks); | ||
422 | push(@out,"align\t$_[0]\n"); | ||
423 | } | ||
424 | 135 | ||
425 | sub out1p | 136 | sub ::data_byte |
426 | { | 137 | { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } |
427 | my($name,$p1)=@_; | ||
428 | my($l,$t); | ||
429 | 138 | ||
430 | push(@out,"\t$name\t".&conv($p1)."\n"); | 139 | sub ::data_word |
431 | } | 140 | { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } |
432 | 141 | ||
433 | sub main'picmeup | 142 | sub ::align |
434 | { | 143 | { push(@out,"${drdecor}align\t$_[0]\n"); } |
435 | local($dst,$sym)=@_; | ||
436 | &main'lea($dst,&main'DWP($sym)); | ||
437 | } | ||
438 | 144 | ||
439 | sub main'blindpop { &out1("pop",@_); } | 145 | sub ::picmeup |
146 | { my($dst,$sym)=@_; | ||
147 | &::lea($dst,&::DWP($sym)); | ||
148 | } | ||
440 | 149 | ||
441 | sub main'initseg | 150 | sub ::initseg |
442 | { | 151 | { my $f=$nmdecor.shift; |
443 | local($f)=@_; | 152 | if ($::win32) |
444 | if ($main'win32) | 153 | { $initseg=<<___; |
445 | { | 154 | segment .CRT\$XCU data align=4 |
446 | local($tmp)=<<___; | 155 | extern $f |
447 | segment .CRT\$XCU data | 156 | dd $f |
448 | extern $under$f | ||
449 | DD $under$f | ||
450 | ___ | 157 | ___ |
451 | push(@out,$tmp); | 158 | } |
452 | } | 159 | } |
453 | } | 160 | |
161 | sub ::dataseg | ||
162 | { if ($mwerks) { push(@out,".section\t.data,4\n"); } | ||
163 | else { push(@out,"section\t.data align=4\n"); } | ||
164 | } | ||
454 | 165 | ||
455 | 1; | 166 | 1; |
diff --git a/src/lib/libcrypto/perlasm/x86unix.pl b/src/lib/libcrypto/perlasm/x86unix.pl deleted file mode 100644 index ae8f0964dc..0000000000 --- a/src/lib/libcrypto/perlasm/x86unix.pl +++ /dev/null | |||
@@ -1,808 +0,0 @@ | |||
1 | #!/usr/local/bin/perl | ||
2 | |||
3 | package x86unix; # GAS actually... | ||
4 | |||
5 | $label="L000"; | ||
6 | $const=""; | ||
7 | $constl=0; | ||
8 | |||
9 | $align=($main'aout)?"4":"16"; | ||
10 | $under=($main'aout or $main'coff)?"_":""; | ||
11 | $dot=($main'aout)?"":"."; | ||
12 | $com_start="#" if ($main'aout or $main'coff); | ||
13 | |||
14 | sub main'asm_init_output { @out=(); } | ||
15 | sub main'asm_get_output { return(@out); } | ||
16 | sub main'get_labels { return(@labels); } | ||
17 | sub main'external_label { push(@labels,@_); } | ||
18 | |||
19 | if ($main'openbsd) | ||
20 | { | ||
21 | $com_start='/*'; | ||
22 | $com_end='*/'; | ||
23 | } | ||
24 | |||
25 | if ($main'cpp) | ||
26 | { | ||
27 | $align="ALIGN"; | ||
28 | $under=""; | ||
29 | $com_start='/*'; | ||
30 | $com_end='*/'; | ||
31 | } | ||
32 | |||
33 | %lb=( 'eax', '%al', | ||
34 | 'ebx', '%bl', | ||
35 | 'ecx', '%cl', | ||
36 | 'edx', '%dl', | ||
37 | 'ax', '%al', | ||
38 | 'bx', '%bl', | ||
39 | 'cx', '%cl', | ||
40 | 'dx', '%dl', | ||
41 | ); | ||
42 | |||
43 | %hb=( 'eax', '%ah', | ||
44 | 'ebx', '%bh', | ||
45 | 'ecx', '%ch', | ||
46 | 'edx', '%dh', | ||
47 | 'ax', '%ah', | ||
48 | 'bx', '%bh', | ||
49 | 'cx', '%ch', | ||
50 | 'dx', '%dh', | ||
51 | ); | ||
52 | |||
53 | %regs=( 'eax', '%eax', | ||
54 | 'ebx', '%ebx', | ||
55 | 'ecx', '%ecx', | ||
56 | 'edx', '%edx', | ||
57 | 'esi', '%esi', | ||
58 | 'edi', '%edi', | ||
59 | 'ebp', '%ebp', | ||
60 | 'esp', '%esp', | ||
61 | |||
62 | 'mm0', '%mm0', | ||
63 | 'mm1', '%mm1', | ||
64 | 'mm2', '%mm2', | ||
65 | 'mm3', '%mm3', | ||
66 | 'mm4', '%mm4', | ||
67 | 'mm5', '%mm5', | ||
68 | 'mm6', '%mm6', | ||
69 | 'mm7', '%mm7', | ||
70 | |||
71 | 'xmm0', '%xmm0', | ||
72 | 'xmm1', '%xmm1', | ||
73 | 'xmm2', '%xmm2', | ||
74 | 'xmm3', '%xmm3', | ||
75 | 'xmm4', '%xmm4', | ||
76 | 'xmm5', '%xmm5', | ||
77 | 'xmm6', '%xmm6', | ||
78 | 'xmm7', '%xmm7', | ||
79 | ); | ||
80 | |||
81 | %reg_val=( | ||
82 | 'eax', 0x00, | ||
83 | 'ebx', 0x03, | ||
84 | 'ecx', 0x01, | ||
85 | 'edx', 0x02, | ||
86 | 'esi', 0x06, | ||
87 | 'edi', 0x07, | ||
88 | 'ebp', 0x05, | ||
89 | 'esp', 0x04, | ||
90 | ); | ||
91 | |||
92 | sub main'LB | ||
93 | { | ||
94 | (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; | ||
95 | return($lb{$_[0]}); | ||
96 | } | ||
97 | |||
98 | sub main'HB | ||
99 | { | ||
100 | (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; | ||
101 | return($hb{$_[0]}); | ||
102 | } | ||
103 | |||
104 | sub main'DWP | ||
105 | { | ||
106 | local($addr,$reg1,$reg2,$idx)=@_; | ||
107 | |||
108 | $ret=""; | ||
109 | $addr =~ s/(^|[+ \t])([A-Za-z_]+[A-Za-z0-9_]+)($|[+ \t])/$1$under$2$3/; | ||
110 | $reg1="$regs{$reg1}" if defined($regs{$reg1}); | ||
111 | $reg2="$regs{$reg2}" if defined($regs{$reg2}); | ||
112 | $ret.=$addr if ($addr ne "") && ($addr ne 0); | ||
113 | if ($reg2 ne "") | ||
114 | { | ||
115 | if($idx ne "" && $idx != 0) | ||
116 | { $ret.="($reg1,$reg2,$idx)"; } | ||
117 | else | ||
118 | { $ret.="($reg1,$reg2)"; } | ||
119 | } | ||
120 | elsif ($reg1 ne "") | ||
121 | { $ret.="($reg1)" } | ||
122 | return($ret); | ||
123 | } | ||
124 | |||
125 | sub main'QWP | ||
126 | { | ||
127 | return(&main'DWP(@_)); | ||
128 | } | ||
129 | |||
130 | sub main'BP | ||
131 | { | ||
132 | return(&main'DWP(@_)); | ||
133 | } | ||
134 | |||
135 | sub main'BC | ||
136 | { | ||
137 | return @_; | ||
138 | } | ||
139 | |||
140 | sub main'DWC | ||
141 | { | ||
142 | return @_; | ||
143 | } | ||
144 | |||
145 | #sub main'BP | ||
146 | # { | ||
147 | # local($addr,$reg1,$reg2,$idx)=@_; | ||
148 | # | ||
149 | # $ret=""; | ||
150 | # | ||
151 | # $addr =~ s/(^|[+ \t])([A-Za-z_]+)($|[+ \t])/$1$under$2$3/; | ||
152 | # $reg1="$regs{$reg1}" if defined($regs{$reg1}); | ||
153 | # $reg2="$regs{$reg2}" if defined($regs{$reg2}); | ||
154 | # $ret.=$addr if ($addr ne "") && ($addr ne 0); | ||
155 | # if ($reg2 ne "") | ||
156 | # { $ret.="($reg1,$reg2,$idx)"; } | ||
157 | # else | ||
158 | # { $ret.="($reg1)" } | ||
159 | # return($ret); | ||
160 | # } | ||
161 | |||
162 | sub main'mov { &out2("movl",@_); } | ||
163 | sub main'movb { &out2("movb",@_); } | ||
164 | sub main'and { &out2("andl",@_); } | ||
165 | sub main'or { &out2("orl",@_); } | ||
166 | sub main'shl { &out2("sall",@_); } | ||
167 | sub main'shr { &out2("shrl",@_); } | ||
168 | sub main'xor { &out2("xorl",@_); } | ||
169 | sub main'xorb { &out2("xorb",@_); } | ||
170 | sub main'add { &out2($_[0]=~/%[a-d][lh]/?"addb":"addl",@_); } | ||
171 | sub main'adc { &out2("adcl",@_); } | ||
172 | sub main'sub { &out2("subl",@_); } | ||
173 | sub main'sbb { &out2("sbbl",@_); } | ||
174 | sub main'rotl { &out2("roll",@_); } | ||
175 | sub main'rotr { &out2("rorl",@_); } | ||
176 | sub main'exch { &out2($_[0]=~/%[a-d][lh]/?"xchgb":"xchgl",@_); } | ||
177 | sub main'cmp { &out2("cmpl",@_); } | ||
178 | sub main'lea { &out2("leal",@_); } | ||
179 | sub main'mul { &out1("mull",@_); } | ||
180 | sub main'imul { &out2("imull",@_); } | ||
181 | sub main'div { &out1("divl",@_); } | ||
182 | sub main'jmp { &out1("jmp",@_); } | ||
183 | sub main'jmp_ptr { &out1p("jmp",@_); } | ||
184 | sub main'je { &out1("je",@_); } | ||
185 | sub main'jle { &out1("jle",@_); } | ||
186 | sub main'jne { &out1("jne",@_); } | ||
187 | sub main'jnz { &out1("jnz",@_); } | ||
188 | sub main'jz { &out1("jz",@_); } | ||
189 | sub main'jge { &out1("jge",@_); } | ||
190 | sub main'jl { &out1("jl",@_); } | ||
191 | sub main'ja { &out1("ja",@_); } | ||
192 | sub main'jae { &out1("jae",@_); } | ||
193 | sub main'jb { &out1("jb",@_); } | ||
194 | sub main'jbe { &out1("jbe",@_); } | ||
195 | sub main'jc { &out1("jc",@_); } | ||
196 | sub main'jnc { &out1("jnc",@_); } | ||
197 | sub main'jno { &out1("jno",@_); } | ||
198 | sub main'dec { &out1("decl",@_); } | ||
199 | sub main'inc { &out1($_[0]=~/%[a-d][hl]/?"incb":"incl",@_); } | ||
200 | sub main'push { &out1("pushl",@_); $stack+=4; } | ||
201 | sub main'pop { &out1("popl",@_); $stack-=4; } | ||
202 | sub main'pushf { &out0("pushfl"); $stack+=4; } | ||
203 | sub main'popf { &out0("popfl"); $stack-=4; } | ||
204 | sub main'not { &out1("notl",@_); } | ||
205 | sub main'call { my $pre=$under; | ||
206 | foreach $i (%label) | ||
207 | { if ($label{$i} eq $_[0]) { $pre=''; last; } } | ||
208 | &out1("call",$pre.$_[0]); | ||
209 | } | ||
210 | sub main'call_ptr { &out1p("call",@_); } | ||
211 | sub main'ret { &out0("ret"); } | ||
212 | sub main'nop { &out0("nop"); } | ||
213 | sub main'test { &out2("testl",@_); } | ||
214 | sub main'bt { &out2("btl",@_); } | ||
215 | sub main'leave { &out0("leave"); } | ||
216 | sub main'cpuid { &out0(".byte\t0x0f,0xa2"); } | ||
217 | sub main'rdtsc { &out0(".byte\t0x0f,0x31"); } | ||
218 | sub main'halt { &out0("hlt"); } | ||
219 | sub main'movz { &out2("movzbl",@_); } | ||
220 | sub main'neg { &out1("negl",@_); } | ||
221 | sub main'cld { &out0("cld"); } | ||
222 | |||
223 | # SSE2 | ||
224 | sub main'emms { &out0("emms"); } | ||
225 | sub main'movd { &out2("movd",@_); } | ||
226 | sub main'movdqu { &out2("movdqu",@_); } | ||
227 | sub main'movdqa { &out2("movdqa",@_); } | ||
228 | sub main'movdq2q{ &out2("movdq2q",@_); } | ||
229 | sub main'movq2dq{ &out2("movq2dq",@_); } | ||
230 | sub main'paddq { &out2("paddq",@_); } | ||
231 | sub main'pmuludq{ &out2("pmuludq",@_); } | ||
232 | sub main'psrlq { &out2("psrlq",@_); } | ||
233 | sub main'psllq { &out2("psllq",@_); } | ||
234 | sub main'pxor { &out2("pxor",@_); } | ||
235 | sub main'por { &out2("por",@_); } | ||
236 | sub main'pand { &out2("pand",@_); } | ||
237 | sub main'movq { | ||
238 | local($p1,$p2,$optimize)=@_; | ||
239 | if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) | ||
240 | # movq between mmx registers can sink Intel CPUs | ||
241 | { push(@out,"\tpshufw\t\$0xe4,%$p2,%$p1\n"); } | ||
242 | else { &out2("movq",@_); } | ||
243 | } | ||
244 | |||
245 | # The bswapl instruction is new for the 486. Emulate if i386. | ||
246 | sub main'bswap | ||
247 | { | ||
248 | if ($main'i386) | ||
249 | { | ||
250 | &main'comment("bswapl @_"); | ||
251 | &main'exch(main'HB(@_),main'LB(@_)); | ||
252 | &main'rotr(@_,16); | ||
253 | &main'exch(main'HB(@_),main'LB(@_)); | ||
254 | } | ||
255 | else | ||
256 | { | ||
257 | &out1("bswapl",@_); | ||
258 | } | ||
259 | } | ||
260 | |||
261 | sub out2 | ||
262 | { | ||
263 | local($name,$p1,$p2)=@_; | ||
264 | local($l,$ll,$t); | ||
265 | local(%special)=( "roll",0xD1C0,"rorl",0xD1C8, | ||
266 | "rcll",0xD1D0,"rcrl",0xD1D8, | ||
267 | "shll",0xD1E0,"shrl",0xD1E8, | ||
268 | "sarl",0xD1F8); | ||
269 | |||
270 | if ((defined($special{$name})) && defined($regs{$p1}) && ($p2 == 1)) | ||
271 | { | ||
272 | $op=$special{$name}|$reg_val{$p1}; | ||
273 | $tmp1=sprintf(".byte %d\n",($op>>8)&0xff); | ||
274 | $tmp2=sprintf(".byte %d\t",$op &0xff); | ||
275 | push(@out,$tmp1); | ||
276 | push(@out,$tmp2); | ||
277 | |||
278 | $p2=&conv($p2); | ||
279 | $p1=&conv($p1); | ||
280 | &main'comment("$name $p2 $p1"); | ||
281 | return; | ||
282 | } | ||
283 | |||
284 | push(@out,"\t$name\t"); | ||
285 | $t=&conv($p2).","; | ||
286 | $l=length($t); | ||
287 | push(@out,$t); | ||
288 | $ll=4-($l+9)/8; | ||
289 | $tmp1=sprintf("\t" x $ll); | ||
290 | push(@out,$tmp1); | ||
291 | push(@out,&conv($p1)."\n"); | ||
292 | } | ||
293 | |||
294 | sub out1 | ||
295 | { | ||
296 | local($name,$p1)=@_; | ||
297 | local($l,$t); | ||
298 | local(%special)=("bswapl",0x0FC8); | ||
299 | |||
300 | if ((defined($special{$name})) && defined($regs{$p1})) | ||
301 | { | ||
302 | $op=$special{$name}|$reg_val{$p1}; | ||
303 | $tmp1=sprintf(".byte %d\n",($op>>8)&0xff); | ||
304 | $tmp2=sprintf(".byte %d\t",$op &0xff); | ||
305 | push(@out,$tmp1); | ||
306 | push(@out,$tmp2); | ||
307 | |||
308 | $p2=&conv($p2); | ||
309 | $p1=&conv($p1); | ||
310 | &main'comment("$name $p2 $p1"); | ||
311 | return; | ||
312 | } | ||
313 | |||
314 | push(@out,"\t$name\t".&conv($p1)."\n"); | ||
315 | } | ||
316 | |||
317 | sub out1p | ||
318 | { | ||
319 | local($name,$p1)=@_; | ||
320 | local($l,$t); | ||
321 | |||
322 | push(@out,"\t$name\t*".&conv($p1)."\n"); | ||
323 | } | ||
324 | |||
325 | sub out0 | ||
326 | { | ||
327 | push(@out,"\t$_[0]\n"); | ||
328 | } | ||
329 | |||
330 | sub conv | ||
331 | { | ||
332 | local($p)=@_; | ||
333 | |||
334 | # $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; | ||
335 | |||
336 | $p=$regs{$p} if (defined($regs{$p})); | ||
337 | |||
338 | $p =~ s/^(-{0,1}[0-9A-Fa-f]+)$/\$$1/; | ||
339 | $p =~ s/^(0x[0-9A-Fa-f]+)$/\$$1/; | ||
340 | return $p; | ||
341 | } | ||
342 | |||
343 | sub main'file | ||
344 | { | ||
345 | local($file)=@_; | ||
346 | |||
347 | if ($main'openbsd) | ||
348 | { push(@out,"#include <machine/asm.h>\n"); } | ||
349 | |||
350 | local($tmp)=<<"EOF"; | ||
351 | .file "$file.s" | ||
352 | EOF | ||
353 | push(@out,$tmp); | ||
354 | } | ||
355 | |||
356 | sub main'function_begin | ||
357 | { | ||
358 | local($func,$junk,$llabel)=@_; | ||
359 | |||
360 | &main'external_label($func); | ||
361 | $func=$under.$func; | ||
362 | |||
363 | if ($main'openbsd) | ||
364 | { | ||
365 | push (@out, "\nENTRY($func)\n"); | ||
366 | push (@out, "$llabel:\n") if $llabel; | ||
367 | goto skip; | ||
368 | } | ||
369 | |||
370 | local($tmp)=<<"EOF"; | ||
371 | .text | ||
372 | .globl $func | ||
373 | EOF | ||
374 | push(@out,$tmp); | ||
375 | if ($main'cpp) | ||
376 | { $tmp=push(@out,"TYPE($func,\@function)\n"); } | ||
377 | elsif ($main'coff) | ||
378 | { $tmp=push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } | ||
379 | elsif ($main'aout and !$main'pic) | ||
380 | { } | ||
381 | else { $tmp=push(@out,".type\t$func,\@function\n"); } | ||
382 | push(@out,".align\t$align\n"); | ||
383 | push(@out,"$func:\n"); | ||
384 | skip: | ||
385 | $tmp=<<"EOF"; | ||
386 | pushl %ebp | ||
387 | pushl %ebx | ||
388 | pushl %esi | ||
389 | pushl %edi | ||
390 | |||
391 | EOF | ||
392 | push(@out,$tmp); | ||
393 | $stack=20; | ||
394 | } | ||
395 | |||
396 | sub main'function_begin_B | ||
397 | { | ||
398 | local($func,$extra)=@_; | ||
399 | |||
400 | &main'external_label($func); | ||
401 | $func=$under.$func; | ||
402 | |||
403 | if ($main'openbsd) | ||
404 | { push(@out, "\nENTRY($func)\n"); goto skip; } | ||
405 | |||
406 | local($tmp)=<<"EOF"; | ||
407 | .text | ||
408 | .globl $func | ||
409 | EOF | ||
410 | push(@out,$tmp); | ||
411 | if ($main'cpp) | ||
412 | { push(@out,"TYPE($func,\@function)\n"); } | ||
413 | elsif ($main'coff) | ||
414 | { $tmp=push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } | ||
415 | elsif ($main'aout and !$main'pic) | ||
416 | { } | ||
417 | else { push(@out,".type $func,\@function\n"); } | ||
418 | push(@out,".align\t$align\n"); | ||
419 | push(@out,"$func:\n"); | ||
420 | skip: | ||
421 | $stack=4; | ||
422 | } | ||
423 | |||
424 | # Like function_begin_B but with static linkage | ||
425 | sub main'function_begin_C | ||
426 | { | ||
427 | local($func,$extra)=@_; | ||
428 | |||
429 | &main'external_label($func); | ||
430 | $func=$under.$func; | ||
431 | |||
432 | if ($main'openbsd) | ||
433 | { | ||
434 | local($tmp)=<<"EOF"; | ||
435 | .text | ||
436 | _ALIGN_TEXT | ||
437 | .type $func,\@function | ||
438 | $func: | ||
439 | EOF | ||
440 | push(@out, $tmp); | ||
441 | goto skip; | ||
442 | } | ||
443 | |||
444 | local($tmp)=<<"EOF"; | ||
445 | .text | ||
446 | .globl $func | ||
447 | EOF | ||
448 | push(@out,$tmp); | ||
449 | if ($main'cpp) | ||
450 | { push(@out,"TYPE($func,\@function)\n"); } | ||
451 | elsif ($main'coff) | ||
452 | { $tmp=push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } | ||
453 | elsif ($main'aout and !$main'pic) | ||
454 | { } | ||
455 | else { push(@out,".type $func,\@function\n"); } | ||
456 | push(@out,".align\t$align\n"); | ||
457 | push(@out,"$func:\n"); | ||
458 | skip: | ||
459 | $stack=4; | ||
460 | } | ||
461 | |||
462 | sub main'function_end | ||
463 | { | ||
464 | local($func)=@_; | ||
465 | |||
466 | $func=$under.$func; | ||
467 | |||
468 | local($tmp)=<<"EOF"; | ||
469 | popl %edi | ||
470 | popl %esi | ||
471 | popl %ebx | ||
472 | popl %ebp | ||
473 | ret | ||
474 | ${dot}L_${func}_end: | ||
475 | EOF | ||
476 | push(@out,$tmp); | ||
477 | |||
478 | if ($main'cpp) | ||
479 | { push(@out,"SIZE($func,${dot}L_${func}_end-$func)\n"); } | ||
480 | elsif ($main'coff or $main'aout) | ||
481 | { } | ||
482 | else { push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); } | ||
483 | push(@out,".ident \"$func\"\n"); | ||
484 | $stack=0; | ||
485 | %label=(); | ||
486 | } | ||
487 | |||
488 | sub main'function_end_A | ||
489 | { | ||
490 | local($func)=@_; | ||
491 | |||
492 | local($tmp)=<<"EOF"; | ||
493 | popl %edi | ||
494 | popl %esi | ||
495 | popl %ebx | ||
496 | popl %ebp | ||
497 | ret | ||
498 | EOF | ||
499 | push(@out,$tmp); | ||
500 | } | ||
501 | |||
502 | sub main'function_end_B | ||
503 | { | ||
504 | local($func)=@_; | ||
505 | |||
506 | $func=$under.$func; | ||
507 | |||
508 | push(@out,"${dot}L_${func}_end:\n"); | ||
509 | if ($main'cpp) | ||
510 | { push(@out,"SIZE($func,${dot}L_${func}_end-$func)\n"); } | ||
511 | elsif ($main'coff or $main'aout) | ||
512 | { } | ||
513 | else { push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); } | ||
514 | push(@out,".ident \"$func\"\n"); | ||
515 | $stack=0; | ||
516 | %label=(); | ||
517 | } | ||
518 | |||
519 | sub main'function_end_C { function_end_B(@_); } | ||
520 | |||
521 | sub main'wparam | ||
522 | { | ||
523 | local($num)=@_; | ||
524 | |||
525 | return(&main'DWP($stack+$num*4,"esp","",0)); | ||
526 | } | ||
527 | |||
528 | sub main'stack_push | ||
529 | { | ||
530 | local($num)=@_; | ||
531 | $stack+=$num*4; | ||
532 | &main'sub("esp",$num*4); | ||
533 | } | ||
534 | |||
535 | sub main'stack_pop | ||
536 | { | ||
537 | local($num)=@_; | ||
538 | $stack-=$num*4; | ||
539 | &main'add("esp",$num*4); | ||
540 | } | ||
541 | |||
542 | sub main'swtmp | ||
543 | { | ||
544 | return(&main'DWP($_[0]*4,"esp","",0)); | ||
545 | } | ||
546 | |||
547 | # Should use swtmp, which is above esp. Linix can trash the stack above esp | ||
548 | #sub main'wtmp | ||
549 | # { | ||
550 | # local($num)=@_; | ||
551 | # | ||
552 | # return(&main'DWP(-($num+1)*4,"esp","",0)); | ||
553 | # } | ||
554 | |||
555 | sub main'comment | ||
556 | { | ||
557 | if (!defined($com_start) or (!$main'openbsd && $main'elf)) | ||
558 | { # Regarding $main'elf above... | ||
559 | # GNU and SVR4 as'es use different comment delimiters, | ||
560 | push(@out,"\n"); # so we just skip ELF comments... | ||
561 | return; | ||
562 | } | ||
563 | foreach (@_) | ||
564 | { | ||
565 | if (/^\s*$/) | ||
566 | { push(@out,"\n"); } | ||
567 | else | ||
568 | { push(@out,"\t$com_start $_ $com_end\n"); } | ||
569 | } | ||
570 | } | ||
571 | |||
572 | sub main'public_label | ||
573 | { | ||
574 | $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); | ||
575 | push(@out,".globl\t$label{$_[0]}\n"); | ||
576 | } | ||
577 | |||
578 | sub main'label | ||
579 | { | ||
580 | if (!defined($label{$_[0]})) | ||
581 | { | ||
582 | $label{$_[0]}="${dot}${label}${_[0]}"; | ||
583 | $label++; | ||
584 | } | ||
585 | return($label{$_[0]}); | ||
586 | } | ||
587 | |||
588 | sub main'set_label | ||
589 | { | ||
590 | if (!defined($label{$_[0]})) | ||
591 | { | ||
592 | $label{$_[0]}="${dot}${label}${_[0]}"; | ||
593 | $label++; | ||
594 | } | ||
595 | if ($_[1]!=0) | ||
596 | { | ||
597 | if ($_[1]>1) { main'align($_[1]); } | ||
598 | else | ||
599 | { | ||
600 | if ($main'openbsd) | ||
601 | { push(@out,"_ALIGN_TEXT\n"); } | ||
602 | else | ||
603 | { push(@out,".align $align\n"); } | ||
604 | } | ||
605 | } | ||
606 | push(@out,"$label{$_[0]}:\n"); | ||
607 | } | ||
608 | |||
609 | sub main'file_end | ||
610 | { | ||
611 | # try to detect if SSE2 or MMX extensions were used on ELF platform... | ||
612 | if ($main'elf && grep {/\b%[x]*mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out) { | ||
613 | local($tmp); | ||
614 | |||
615 | push (@out,"\n.section\t.bss\n"); | ||
616 | push (@out,".comm\t${under}OPENSSL_ia32cap_P,4,4\n"); | ||
617 | |||
618 | return; | ||
619 | } | ||
620 | |||
621 | if ($const ne "") | ||
622 | { | ||
623 | push(@out,".section .rodata\n"); | ||
624 | push(@out,$const); | ||
625 | $const=""; | ||
626 | } | ||
627 | } | ||
628 | |||
629 | sub main'data_byte | ||
630 | { | ||
631 | push(@out,"\t.byte\t".join(',',@_)."\n"); | ||
632 | } | ||
633 | |||
634 | sub main'data_word | ||
635 | { | ||
636 | push(@out,"\t.long\t".join(',',@_)."\n"); | ||
637 | } | ||
638 | |||
639 | sub main'align | ||
640 | { | ||
641 | my $val=$_[0],$p2,$i; | ||
642 | if ($main'aout) { | ||
643 | for ($p2=0;$val!=0;$val>>=1) { $p2++; } | ||
644 | $val=$p2-1; | ||
645 | $val.=",0x90"; | ||
646 | } | ||
647 | push(@out,".align\t$val\n"); | ||
648 | if ($main'openbsd) | ||
649 | { push(@out,"_ALIGN_TEXT\n"); } | ||
650 | else | ||
651 | { push(@out,".align $tval\n"); } | ||
652 | } | ||
653 | |||
654 | # debug output functions: puts, putx, printf | ||
655 | |||
656 | sub main'puts | ||
657 | { | ||
658 | &pushvars(); | ||
659 | &main'push('$Lstring' . ++$constl); | ||
660 | &main'call('puts'); | ||
661 | $stack-=4; | ||
662 | &main'add("esp",4); | ||
663 | &popvars(); | ||
664 | |||
665 | $const .= "Lstring$constl:\n\t.string \"@_[0]\"\n"; | ||
666 | } | ||
667 | |||
668 | sub main'putx | ||
669 | { | ||
670 | &pushvars(); | ||
671 | &main'push($_[0]); | ||
672 | &main'push('$Lstring' . ++$constl); | ||
673 | &main'call('printf'); | ||
674 | &main'add("esp",8); | ||
675 | $stack-=8; | ||
676 | &popvars(); | ||
677 | |||
678 | $const .= "Lstring$constl:\n\t.string \"\%X\"\n"; | ||
679 | } | ||
680 | |||
681 | sub main'printf | ||
682 | { | ||
683 | $ostack = $stack; | ||
684 | &pushvars(); | ||
685 | for ($i = @_ - 1; $i >= 0; $i--) | ||
686 | { | ||
687 | if ($i == 0) # change this to support %s format strings | ||
688 | { | ||
689 | &main'push('$Lstring' . ++$constl); | ||
690 | $const .= "Lstring$constl:\n\t.string \"@_[$i]\"\n"; | ||
691 | } | ||
692 | else | ||
693 | { | ||
694 | if ($_[$i] =~ /([0-9]*)\(%esp\)/) | ||
695 | { | ||
696 | &main'push(($1 + $stack - $ostack) . '(%esp)'); | ||
697 | } | ||
698 | else | ||
699 | { | ||
700 | &main'push($_[$i]); | ||
701 | } | ||
702 | } | ||
703 | } | ||
704 | &main'call('printf'); | ||
705 | $stack-=4*@_; | ||
706 | &main'add("esp",4*@_); | ||
707 | &popvars(); | ||
708 | } | ||
709 | |||
710 | sub pushvars | ||
711 | { | ||
712 | &main'pushf(); | ||
713 | &main'push("edx"); | ||
714 | &main'push("ecx"); | ||
715 | &main'push("eax"); | ||
716 | } | ||
717 | |||
718 | sub popvars | ||
719 | { | ||
720 | &main'pop("eax"); | ||
721 | &main'pop("ecx"); | ||
722 | &main'pop("edx"); | ||
723 | &main'popf(); | ||
724 | } | ||
725 | |||
726 | sub main'picmeup | ||
727 | { | ||
728 | local($dst,$sym)=@_; | ||
729 | if ($main'cpp) | ||
730 | { | ||
731 | local($tmp)=<<___; | ||
732 | #if (defined(ELF) || defined(SOL)) && defined(PIC) | ||
733 | call 1f | ||
734 | 1: popl $regs{$dst} | ||
735 | addl \$_GLOBAL_OFFSET_TABLE_+[.-1b],$regs{$dst} | ||
736 | movl $sym\@GOT($regs{$dst}),$regs{$dst} | ||
737 | #else | ||
738 | leal $sym,$regs{$dst} | ||
739 | #endif | ||
740 | ___ | ||
741 | push(@out,$tmp); | ||
742 | } | ||
743 | elsif ($main'openbsd) | ||
744 | { | ||
745 | push(@out, "#ifdef PIC\n"); | ||
746 | push(@out, "\tPIC_PROLOGUE\n"); | ||
747 | &main'mov($dst,"PIC_GOT($sym)"); | ||
748 | push(@out, "\tPIC_EPILOGUE\n"); | ||
749 | push(@out, "#else\n"); | ||
750 | &main'lea($dst,&main'DWP($sym)); | ||
751 | push(@out, "#endif\n"); | ||
752 | } | ||
753 | elsif ($main'pic && ($main'elf || $main'aout)) | ||
754 | { | ||
755 | &main'call(&main'label("PIC_me_up")); | ||
756 | &main'set_label("PIC_me_up"); | ||
757 | &main'blindpop($dst); | ||
758 | &main'add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-". | ||
759 | &main'label("PIC_me_up") . "]"); | ||
760 | &main'mov($dst,&main'DWP($under.$sym."\@GOT",$dst)); | ||
761 | } | ||
762 | else | ||
763 | { | ||
764 | &main'lea($dst,&main'DWP($sym)); | ||
765 | } | ||
766 | } | ||
767 | |||
768 | sub main'blindpop { &out1("popl",@_); } | ||
769 | |||
770 | sub main'initseg | ||
771 | { | ||
772 | local($f)=@_; | ||
773 | local($tmp); | ||
774 | if ($main'elf) | ||
775 | { | ||
776 | $tmp=<<___; | ||
777 | .section .init | ||
778 | PIC_PROLOGUE | ||
779 | call PIC_PLT($under$f) | ||
780 | PIC_EPILOGUE | ||
781 | jmp .Linitalign | ||
782 | .align $align | ||
783 | .Linitalign: | ||
784 | ___ | ||
785 | } | ||
786 | elsif ($main'coff) | ||
787 | { | ||
788 | $tmp=<<___; # applies to both Cygwin and Mingw | ||
789 | .section .ctors | ||
790 | .long $under$f | ||
791 | ___ | ||
792 | } | ||
793 | elsif ($main'aout) | ||
794 | { | ||
795 | local($ctor)="${under}_GLOBAL_\$I\$$f"; | ||
796 | $tmp=".text\n"; | ||
797 | $tmp.=".type $ctor,\@function\n" if ($main'pic); | ||
798 | $tmp.=<<___; # OpenBSD way... | ||
799 | .globl $ctor | ||
800 | .align 2 | ||
801 | $ctor: | ||
802 | jmp $under$f | ||
803 | ___ | ||
804 | } | ||
805 | push(@out,$tmp) if ($tmp); | ||
806 | } | ||
807 | |||
808 | 1; | ||