OLD | NEW |
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; |
| 25 } |
| 26 # |
| 27 # opcodes not covered by ::generic above, mostly inconsistent namings... |
| 28 # |
| 29 sub ::call» { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } |
| 30 sub ::call_ptr» { &::emit("call",@_);» } |
| 31 sub ::jmp_ptr» { &::emit("jmp",@_);» } |
| 32 |
| 33 sub get_mem |
| 34 { my($size,$addr,$reg1,$reg2,$idx)=@_; |
| 35 my($post,$ret); |
| 36 |
| 37 if ($size ne "") |
| 38 {» $ret .= "$size"; |
| 39 » $ret .= " PTR" if ($::mwerks); |
| 40 » $ret .= " "; |
| 41 } |
| 42 $ret .= "["; |
| 43 |
| 44 $addr =~ s/^\s+//; |
| 45 # prepend global references with optional underscore |
| 46 $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; |
| 47 # put address arithmetic expression in parenthesis |
| 48 $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); |
| 49 |
| 50 if (($addr ne "") && ($addr ne 0)) |
| 51 {» if ($addr !~ /^-/)» { $ret .= "$addr+"; } |
| 52 » else» » » { $post=$addr; } |
| 53 } |
| 54 |
| 55 if ($reg2 ne "") |
| 56 {» $idx!=0 or $idx=1; |
| 57 » $ret .= "$reg2*$idx"; |
| 58 » $ret .= "+$reg1" if ($reg1 ne ""); |
| 59 } |
| 60 else |
| 61 {» $ret .= "$reg1"; } |
| 62 |
| 63 $ret .= "$post]"; |
| 64 $ret =~ s/\+\]/]/; # in case $addr was the only argument |
| 65 |
| 66 $ret; |
| 67 } |
| 68 sub ::BP» { &get_mem("BYTE",@_); } |
| 69 sub ::DWP» { &get_mem("DWORD",@_); } |
| 70 sub ::QWP» { &get_mem("",@_); } |
| 71 sub ::BC» { (($::mwerks)?"":"BYTE ")."@_"; } |
| 72 sub ::DWC» { (($::mwerks)?"":"DWORD ")."@_"; } |
| 73 |
| 74 sub ::file |
| 75 { if ($::mwerks)» { push(@out,".section\t.text,64\n"); } |
| 76 else |
| 77 { my $tmp=<<___; |
| 78 %ifidn __OUTPUT_FORMAT__,obj |
| 79 section»code» use32 class=code align=64 |
| 80 %elifidn __OUTPUT_FORMAT__,win32 |
| 81 \$\@feat.00 equ 1 |
| 82 section».text» code align=64 |
| 83 %else |
| 84 section».text» code |
| 85 %endif |
| 86 ___ |
| 87 » push(@out,$tmp); |
| 88 } |
39 } | 89 } |
40 | 90 |
41 sub main'LB | 91 sub ::function_begin_B |
42 » { | 92 { my $func=shift; |
43 » (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; | 93 my $global=($func !~ /^_/); |
44 » return($lb{$_[0]}); | 94 my $begin="${::lbdecor}_${func}_begin"; |
45 » } | |
46 | 95 |
47 sub main'HB | 96 $begin =~ s/^\@/./ if ($::mwerks);» # the torture never stops |
48 » { | |
49 » (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; | |
50 » return($hb{$_[0]}); | |
51 » } | |
52 | 97 |
53 sub main'BP | 98 &::LABEL($func,$global?"$begin":"$nmdecor$func"); |
54 » { | 99 $func=$nmdecor.$func; |
55 » &get_mem("BYTE",@_); | |
56 » } | |
57 | 100 |
58 sub main'DWP | 101 push(@out,"${drdecor}global»$func\n")» if ($global); |
59 » { | 102 push(@out,"${drdecor}align» 16\n"); |
60 » &get_mem("DWORD",@_); | 103 push(@out,"$func:\n"); |
61 » } | 104 push(@out,"$begin:\n")» » » if ($global); |
| 105 $::stack=4; |
| 106 } |
62 | 107 |
63 sub main'QWP | 108 sub ::function_end_B |
64 » { | 109 { $::stack=0; |
65 » &get_mem("",@_); | 110 &::wipe_labels(); |
66 » } | 111 } |
67 | 112 |
68 sub main'BC | 113 sub ::file_end |
69 » { | 114 { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) |
70 » return (($main'mwerks)?"":"BYTE ")."@_"; | 115 {» my $comm=<<___; |
71 » } | 116 ${drdecor}segment» .bss |
| 117 ${drdecor}common» ${nmdecor}OPENSSL_ia32cap_P 4 |
| 118 ___ |
| 119 » # comment out OPENSSL_ia32cap_P declarations |
| 120 » grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; |
| 121 » push (@out,$comm) |
| 122 } |
| 123 push (@out,$initseg) if ($initseg);»» |
| 124 } |
72 | 125 |
73 sub main'DWC | 126 sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } |
74 » { | |
75 » return (($main'mwerks)?"":"DWORD ")."@_"; | |
76 » } | |
77 | 127 |
78 sub main'stack_push | 128 sub ::external_label |
79 » { | 129 { foreach(@_) |
80 » my($num)=@_; | 130 {» push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } |
81 » $stack+=$num*4; | 131 } |
82 » &main'sub("esp",$num*4); | |
83 » } | |
84 | 132 |
85 sub main'stack_pop | 133 sub ::public_label |
86 » { | 134 { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } |
87 » my($num)=@_; | |
88 » $stack-=$num*4; | |
89 » &main'add("esp",$num*4); | |
90 » } | |
91 | 135 |
92 sub get_mem | 136 sub ::data_byte |
93 » { | 137 { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");» } |
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 | 138 |
114 » if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } | 139 sub ::data_word |
| 140 { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");» } |
115 | 141 |
116 » $reg1="$regs{$reg1}" if defined($regs{$reg1}); | 142 sub ::align |
117 » $reg2="$regs{$reg2}" if defined($regs{$reg2}); | 143 { push(@out,"${drdecor}align\t$_[0]\n");» } |
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 | 144 |
139 sub main'mov» { &out2("mov",@_); } | 145 sub ::picmeup |
140 sub main'movb» { &out2("mov",@_); } | 146 { my($dst,$sym)=@_; |
141 sub main'and» { &out2("and",@_); } | 147 &::lea($dst,&::DWP($sym)); |
142 sub main'or» { &out2("or",@_); } | 148 } |
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 | 149 |
164 # This is a bit of a kludge: declare all branches as NEAR. | 150 sub ::initseg |
165 $near=($main'mwerks)?'':'NEAR'; | 151 { my $f=$nmdecor.shift; |
166 sub main'je» { &out1("je $near",@_); } | 152 if ($::win32) |
167 sub main'jle» { &out1("jle $near",@_); } | 153 {» $initseg=<<___; |
168 sub main'jz» { &out1("jz $near",@_); } | 154 segment».CRT\$XCU data align=4 |
169 sub main'jge» { &out1("jge $near",@_); } | 155 extern» $f |
170 sub main'jl» { &out1("jl $near",@_); } | 156 dd» $f |
171 sub main'ja» { &out1("ja $near",@_); } | 157 ___ |
172 sub main'jae» { &out1("jae $near",@_); } | 158 } |
173 sub main'jb» { &out1("jb $near",@_); } | 159 } |
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 | 160 |
181 sub main'push» { &out1("push",@_); $stack+=4; } | 161 sub ::dataseg |
182 sub main'pop» { &out1("pop",@_); $stack-=4; } | 162 { if ($mwerks)» { push(@out,".section\t.data,4\n"); } |
183 sub main'pushf» { &out0("pushfd"); $stack+=4; } | 163 else» » { push(@out,"section\t.data align=4\n"); } |
184 sub main'popf» { &out0("popfd"); $stack-=4; } | 164 } |
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 | 165 |
455 1; | 166 1; |
OLD | NEW |