diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm/x86nasm.pl')
-rw-r--r-- | src/lib/libcrypto/perlasm/x86nasm.pl | 455 |
1 files changed, 455 insertions, 0 deletions
diff --git a/src/lib/libcrypto/perlasm/x86nasm.pl b/src/lib/libcrypto/perlasm/x86nasm.pl new file mode 100644 index 0000000000..fa38f89c09 --- /dev/null +++ b/src/lib/libcrypto/perlasm/x86nasm.pl | |||
@@ -0,0 +1,455 @@ | |||
1 | #!/usr/local/bin/perl | ||
2 | |||
3 | package x86nasm; | ||
4 | |||
5 | $label="L000"; | ||
6 | $under=($main'netware)?'':'_'; | ||
7 | |||
8 | %lb=( 'eax', 'al', | ||
9 | 'ebx', 'bl', | ||
10 | 'ecx', 'cl', | ||
11 | 'edx', 'dl', | ||
12 | 'ax', 'al', | ||
13 | 'bx', 'bl', | ||
14 | 'cx', 'cl', | ||
15 | 'dx', 'dl', | ||
16 | ); | ||
17 | |||
18 | %hb=( 'eax', 'ah', | ||
19 | 'ebx', 'bh', | ||
20 | 'ecx', 'ch', | ||
21 | 'edx', 'dh', | ||
22 | 'ax', 'ah', | ||
23 | 'bx', 'bh', | ||
24 | 'cx', 'ch', | ||
25 | 'dx', 'dh', | ||
26 | ); | ||
27 | |||
28 | sub main'asm_init_output { @out=(); } | ||
29 | sub main'asm_get_output { return(@out); } | ||
30 | sub main'get_labels { return(@labels); } | ||
31 | |||
32 | sub main'external_label | ||
33 | { | ||
34 | push(@labels,@_); | ||
35 | foreach (@_) { | ||
36 | push(@out,".") if ($main'mwerks); | ||
37 | push(@out, "extern\t${under}$_\n"); | ||
38 | } | ||
39 | } | ||
40 | |||
41 | sub main'LB | ||
42 | { | ||
43 | (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; | ||
44 | return($lb{$_[0]}); | ||
45 | } | ||
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 | |||
92 | sub get_mem | ||
93 | { | ||
94 | my($size,$addr,$reg1,$reg2,$idx)=@_; | ||
95 | my($t,$post); | ||
96 | my($ret)=$size; | ||
97 | if ($ret ne "") | ||
98 | { | ||
99 | $ret .= " PTR" if ($main'mwerks); | ||
100 | $ret .= " "; | ||
101 | } | ||
102 | $ret .= "["; | ||
103 | $addr =~ s/^\s+//; | ||
104 | if ($addr =~ /^(.+)\+(.+)$/) | ||
105 | { | ||
106 | $reg2=&conv($1); | ||
107 | $addr="$under$2"; | ||
108 | } | ||
109 | elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) | ||
110 | { | ||
111 | $addr="$under$addr"; | ||
112 | } | ||
113 | |||
114 | if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } | ||
115 | |||
116 | $reg1="$regs{$reg1}" if defined($regs{$reg1}); | ||
117 | $reg2="$regs{$reg2}" if defined($regs{$reg2}); | ||
118 | if (($addr ne "") && ($addr ne 0)) | ||
119 | { | ||
120 | if ($addr !~ /^-/) | ||
121 | { $ret.="${addr}+"; } | ||
122 | else { $post=$addr; } | ||
123 | } | ||
124 | if ($reg2 ne "") | ||
125 | { | ||
126 | $t=""; | ||
127 | $t="*$idx" if ($idx != 0); | ||
128 | $reg1="+".$reg1 if ("$reg1$post" ne ""); | ||
129 | $ret.="$reg2$t$reg1$post]"; | ||
130 | } | ||
131 | else | ||
132 | { | ||
133 | $ret.="$reg1$post]" | ||
134 | } | ||
135 | $ret =~ s/\+\]/]/; # in case $addr was the only argument | ||
136 | return($ret); | ||
137 | } | ||
138 | |||
139 | sub main'mov { &out2("mov",@_); } | ||
140 | sub main'movb { &out2("mov",@_); } | ||
141 | sub main'and { &out2("and",@_); } | ||
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 | ||
273 | section .text | ||
274 | %endif | ||
275 | ___ | ||
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); | ||
322 | $stack=0; | ||
323 | %label=(); | ||
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 | |||
357 | sub main'swtmp | ||
358 | { | ||
359 | return(&main'DWP($_[0]*4,"esp","",0)); | ||
360 | } | ||
361 | |||
362 | # Should use swtmp, which is above esp. Linix can trash the stack above esp | ||
363 | #sub main'wtmp | ||
364 | # { | ||
365 | # my($num)=@_; | ||
366 | # | ||
367 | # return(&main'DWP(-(($num+1)*4),"esp","",0)); | ||
368 | # } | ||
369 | |||
370 | sub main'comment | ||
371 | { | ||
372 | foreach (@_) | ||
373 | { | ||
374 | push(@out,"\t; $_\n"); | ||
375 | } | ||
376 | } | ||
377 | |||
378 | sub main'public_label | ||
379 | { | ||
380 | $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); | ||
381 | push(@out,".") if ($main'mwerks); | ||
382 | push(@out,"global\t$label{$_[0]}\n"); | ||
383 | } | ||
384 | |||
385 | sub main'label | ||
386 | { | ||
387 | if (!defined($label{$_[0]})) | ||
388 | { | ||
389 | $label{$_[0]}="\@${label}${_[0]}"; | ||
390 | $label++; | ||
391 | } | ||
392 | return($label{$_[0]}); | ||
393 | } | ||
394 | |||
395 | sub main'set_label | ||
396 | { | ||
397 | if (!defined($label{$_[0]})) | ||
398 | { | ||
399 | $label{$_[0]}="\@${label}${_[0]}"; | ||
400 | $label++; | ||
401 | } | ||
402 | if ($_[1]!=0 && $_[1]>1) | ||
403 | { | ||
404 | main'align($_[1]); | ||
405 | } | ||
406 | push(@out,"$label{$_[0]}:\n"); | ||
407 | } | ||
408 | |||
409 | sub main'data_byte | ||
410 | { | ||
411 | push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n"); | ||
412 | } | ||
413 | |||
414 | sub main'data_word | ||
415 | { | ||
416 | push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); | ||
417 | } | ||
418 | |||
419 | sub main'align | ||
420 | { | ||
421 | push(@out,".") if ($main'mwerks); | ||
422 | push(@out,"align\t$_[0]\n"); | ||
423 | } | ||
424 | |||
425 | sub out1p | ||
426 | { | ||
427 | my($name,$p1)=@_; | ||
428 | my($l,$t); | ||
429 | |||
430 | push(@out,"\t$name\t".&conv($p1)."\n"); | ||
431 | } | ||
432 | |||
433 | sub main'picmeup | ||
434 | { | ||
435 | local($dst,$sym)=@_; | ||
436 | &main'lea($dst,&main'DWP($sym)); | ||
437 | } | ||
438 | |||
439 | sub main'blindpop { &out1("pop",@_); } | ||
440 | |||
441 | sub main'initseg | ||
442 | { | ||
443 | local($f)=@_; | ||
444 | if ($main'win32) | ||
445 | { | ||
446 | local($tmp)=<<___; | ||
447 | segment .CRT\$XCU data | ||
448 | extern $under$f | ||
449 | DD $under$f | ||
450 | ___ | ||
451 | push(@out,$tmp); | ||
452 | } | ||
453 | } | ||
454 | |||
455 | 1; | ||