]>
Commit | Line | Data |
---|---|---|
72e2ffee DSH |
1 | #!/usr/local/bin/perl |
2 | ||
3 | package x86nasm; | |
4 | ||
5 | $label="L000"; | |
a8c65b40 | 6 | $under=($main'netware)?'':'_'; |
72e2ffee DSH |
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); } | |
bbdb5438 DSH |
31 | |
32 | sub main'external_label | |
33 | { | |
34 | push(@labels,@_); | |
35 | foreach (@_) { | |
a8c65b40 AP |
36 | push(@out,".") if ($main'mwerks); |
37 | push(@out, "extern\t${under}$_\n"); | |
bbdb5438 DSH |
38 | } |
39 | } | |
72e2ffee DSH |
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 | ||
10e7d6d5 AP |
63 | sub main'QWP |
64 | { | |
a8c65b40 | 65 | &get_mem("",@_); |
10e7d6d5 AP |
66 | } |
67 | ||
bbdb5438 DSH |
68 | sub main'BC |
69 | { | |
a8c65b40 | 70 | return (($main'mwerks)?"":"BYTE ")."@_"; |
bbdb5438 DSH |
71 | } |
72 | ||
73 | sub main'DWC | |
74 | { | |
a8c65b40 | 75 | return (($main'mwerks)?"":"DWORD ")."@_"; |
bbdb5438 DSH |
76 | } |
77 | ||
72e2ffee DSH |
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); | |
a8c65b40 AP |
96 | my($ret)=$size; |
97 | if ($ret ne "") | |
98 | { | |
99 | $ret .= " PTR" if ($main'mwerks); | |
100 | $ret .= " "; | |
101 | } | |
102 | $ret .= "["; | |
72e2ffee DSH |
103 | $addr =~ s/^\s+//; |
104 | if ($addr =~ /^(.+)\+(.+)$/) | |
105 | { | |
106 | $reg2=&conv($1); | |
a8c65b40 | 107 | $addr="$under$2"; |
72e2ffee | 108 | } |
556b8f3f | 109 | elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) |
72e2ffee | 110 | { |
a8c65b40 | 111 | $addr="$under$addr"; |
72e2ffee DSH |
112 | } |
113 | ||
270fa8ae AP |
114 | if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } |
115 | ||
72e2ffee DSH |
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 | } | |
270fa8ae | 135 | $ret =~ s/\+\]/]/; # in case $addr was the only argument |
72e2ffee DSH |
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",@_); } | |
c85c5c40 | 150 | sub main'sbb { &out2("sbb",@_); } |
72e2ffee DSH |
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'div { &out1("div",@_); } | |
158 | sub main'dec { &out1("dec",@_); } | |
159 | sub main'inc { &out1("inc",@_); } | |
160 | sub main'jmp { &out1("jmp",@_); } | |
161 | sub main'jmp_ptr { &out1p("jmp",@_); } | |
162 | ||
163 | # This is a bit of a kludge: declare all branches as NEAR. | |
a8c65b40 AP |
164 | $near=($main'mwerks)?'':'NEAR'; |
165 | sub main'je { &out1("je $near",@_); } | |
166 | sub main'jle { &out1("jle $near",@_); } | |
167 | sub main'jz { &out1("jz $near",@_); } | |
168 | sub main'jge { &out1("jge $near",@_); } | |
169 | sub main'jl { &out1("jl $near",@_); } | |
170 | sub main'ja { &out1("ja $near",@_); } | |
171 | sub main'jae { &out1("jae $near",@_); } | |
172 | sub main'jb { &out1("jb $near",@_); } | |
173 | sub main'jbe { &out1("jbe $near",@_); } | |
174 | sub main'jc { &out1("jc $near",@_); } | |
175 | sub main'jnc { &out1("jnc $near",@_); } | |
176 | sub main'jnz { &out1("jnz $near",@_); } | |
177 | sub main'jne { &out1("jne $near",@_); } | |
178 | sub main'jno { &out1("jno $near",@_); } | |
72e2ffee DSH |
179 | |
180 | sub main'push { &out1("push",@_); $stack+=4; } | |
181 | sub main'pop { &out1("pop",@_); $stack-=4; } | |
c85c5c40 AP |
182 | sub main'pushf { &out0("pushfd"); $stack+=4; } |
183 | sub main'popf { &out0("popfd"); $stack-=4; } | |
72e2ffee DSH |
184 | sub main'bswap { &out1("bswap",@_); &using486(); } |
185 | sub main'not { &out1("not",@_); } | |
a8c65b40 | 186 | sub main'call { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); } |
72e2ffee DSH |
187 | sub main'ret { &out0("ret"); } |
188 | sub main'nop { &out0("nop"); } | |
10e7d6d5 AP |
189 | sub main'test { &out2("test",@_); } |
190 | sub main'bt { &out2("bt",@_); } | |
191 | sub main'leave { &out0("leave"); } | |
14e21f86 AP |
192 | sub main'cpuid { &out0("cpuid"); } |
193 | sub main'rdtsc { &out0("rdtsc"); } | |
c85c5c40 | 194 | sub main'halt { &out0("hlt"); } |
914c2a28 | 195 | sub main'movz { &out2("movzx",@_); } |
10e7d6d5 AP |
196 | |
197 | # SSE2 | |
198 | sub main'emms { &out0("emms"); } | |
199 | sub main'movd { &out2("movd",@_); } | |
200 | sub main'movq { &out2("movq",@_); } | |
201 | sub main'movdqu { &out2("movdqu",@_); } | |
202 | sub main'movdqa { &out2("movdqa",@_); } | |
203 | sub main'movdq2q{ &out2("movdq2q",@_); } | |
204 | sub main'movq2dq{ &out2("movq2dq",@_); } | |
205 | sub main'paddq { &out2("paddq",@_); } | |
206 | sub main'pmuludq{ &out2("pmuludq",@_); } | |
207 | sub main'psrlq { &out2("psrlq",@_); } | |
208 | sub main'psllq { &out2("psllq",@_); } | |
209 | sub main'pxor { &out2("pxor",@_); } | |
210 | sub main'por { &out2("por",@_); } | |
211 | sub main'pand { &out2("pand",@_); } | |
72e2ffee DSH |
212 | |
213 | sub out2 | |
214 | { | |
215 | my($name,$p1,$p2)=@_; | |
216 | my($l,$t); | |
217 | ||
218 | push(@out,"\t$name\t"); | |
a8c65b40 AP |
219 | if (!$main'mwerks and $name eq "lea") |
220 | { | |
221 | $p1 =~ s/^[^\[]*\[/\[/; | |
222 | $p2 =~ s/^[^\[]*\[/\[/; | |
223 | } | |
72e2ffee DSH |
224 | $t=&conv($p1).","; |
225 | $l=length($t); | |
226 | push(@out,$t); | |
227 | $l=4-($l+9)/8; | |
228 | push(@out,"\t" x $l); | |
229 | push(@out,&conv($p2)); | |
230 | push(@out,"\n"); | |
231 | } | |
232 | ||
233 | sub out0 | |
234 | { | |
235 | my($name)=@_; | |
236 | ||
237 | push(@out,"\t$name\n"); | |
238 | } | |
239 | ||
240 | sub out1 | |
241 | { | |
242 | my($name,$p1)=@_; | |
243 | my($l,$t); | |
244 | push(@out,"\t$name\t".&conv($p1)."\n"); | |
245 | } | |
246 | ||
247 | sub conv | |
248 | { | |
249 | my($p)=@_; | |
250 | $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; | |
251 | return $p; | |
252 | } | |
253 | ||
254 | sub using486 | |
255 | { | |
256 | return if $using486; | |
257 | $using486++; | |
258 | grep(s/\.386/\.486/,@out); | |
259 | } | |
260 | ||
261 | sub main'file | |
262 | { | |
a8c65b40 AP |
263 | push(@out,".") if ($main'mwerks); |
264 | push(@out,"section\t.text\n"); | |
72e2ffee DSH |
265 | } |
266 | ||
267 | sub main'function_begin | |
268 | { | |
269 | my($func,$extra)=@_; | |
270 | ||
271 | push(@labels,$func); | |
272 | my($tmp)=<<"EOF"; | |
a8c65b40 AP |
273 | global $under$func |
274 | $under$func: | |
72e2ffee DSH |
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 | my($func,$extra)=@_; | |
287 | my($tmp)=<<"EOF"; | |
a8c65b40 AP |
288 | global $under$func |
289 | $under$func: | |
72e2ffee DSH |
290 | EOF |
291 | push(@out,$tmp); | |
292 | $stack=4; | |
293 | } | |
294 | ||
295 | sub main'function_end | |
296 | { | |
297 | my($func)=@_; | |
298 | ||
299 | my($tmp)=<<"EOF"; | |
300 | pop edi | |
301 | pop esi | |
302 | pop ebx | |
303 | pop ebp | |
304 | ret | |
305 | EOF | |
306 | push(@out,$tmp); | |
307 | $stack=0; | |
308 | %label=(); | |
309 | } | |
310 | ||
311 | sub main'function_end_B | |
312 | { | |
313 | $stack=0; | |
314 | %label=(); | |
315 | } | |
316 | ||
317 | sub main'function_end_A | |
318 | { | |
319 | my($func)=@_; | |
320 | ||
321 | my($tmp)=<<"EOF"; | |
322 | pop edi | |
323 | pop esi | |
324 | pop ebx | |
325 | pop ebp | |
326 | ret | |
327 | EOF | |
328 | push(@out,$tmp); | |
329 | } | |
330 | ||
331 | sub main'file_end | |
332 | { | |
333 | } | |
334 | ||
335 | sub main'wparam | |
336 | { | |
337 | my($num)=@_; | |
338 | ||
339 | return(&main'DWP($stack+$num*4,"esp","",0)); | |
340 | } | |
341 | ||
342 | sub main'swtmp | |
343 | { | |
344 | return(&main'DWP($_[0]*4,"esp","",0)); | |
345 | } | |
346 | ||
347 | # Should use swtmp, which is above esp. Linix can trash the stack above esp | |
348 | #sub main'wtmp | |
349 | # { | |
350 | # my($num)=@_; | |
351 | # | |
352 | # return(&main'DWP(-(($num+1)*4),"esp","",0)); | |
353 | # } | |
354 | ||
355 | sub main'comment | |
356 | { | |
357 | foreach (@_) | |
358 | { | |
359 | push(@out,"\t; $_\n"); | |
360 | } | |
361 | } | |
362 | ||
d1df5b43 AP |
363 | sub main'public_label |
364 | { | |
365 | $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); | |
366 | push(@out,"global\t$label{$_[0]}\n"); | |
367 | } | |
368 | ||
72e2ffee DSH |
369 | sub main'label |
370 | { | |
371 | if (!defined($label{$_[0]})) | |
372 | { | |
a8c65b40 | 373 | $label{$_[0]}="\@${label}${_[0]}"; |
72e2ffee DSH |
374 | $label++; |
375 | } | |
376 | return($label{$_[0]}); | |
377 | } | |
378 | ||
379 | sub main'set_label | |
380 | { | |
381 | if (!defined($label{$_[0]})) | |
382 | { | |
a8c65b40 | 383 | $label{$_[0]}="\@${label}${_[0]}"; |
72e2ffee DSH |
384 | $label++; |
385 | } | |
d1df5b43 AP |
386 | if ($_[1]!=0 && $_[1]>1) |
387 | { | |
388 | main'align($_[1]); | |
389 | } | |
72e2ffee DSH |
390 | push(@out,"$label{$_[0]}:\n"); |
391 | } | |
392 | ||
393 | sub main'data_word | |
394 | { | |
a8c65b40 | 395 | push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); |
10e7d6d5 AP |
396 | } |
397 | ||
398 | sub main'align | |
399 | { | |
a8c65b40 AP |
400 | push(@out,".") if ($main'mwerks); |
401 | push(@out,"align\t$_[0]\n"); | |
72e2ffee DSH |
402 | } |
403 | ||
404 | sub out1p | |
405 | { | |
406 | my($name,$p1)=@_; | |
407 | my($l,$t); | |
408 | ||
409 | push(@out,"\t$name\t ".&conv($p1)."\n"); | |
410 | } | |
6f7ac8e1 | 411 | |
02bf9a15 AP |
412 | sub main'picmeup |
413 | { | |
414 | local($dst,$sym)=@_; | |
415 | &main'lea($dst,&main'DWP($sym)); | |
416 | } | |
417 | ||
6f7ac8e1 | 418 | sub main'blindpop { &out1("pop",@_); } |
a8c65b40 AP |
419 | |
420 | sub main'initseg | |
421 | { | |
422 | local($f)=@_; | |
423 | if ($main'win32) | |
424 | { | |
425 | local($tmp)=<<___; | |
426 | segment .CRT\$XIU data | |
427 | extern $under$f | |
428 | DD $under$f | |
429 | ___ | |
430 | push(@out,$tmp); | |
431 | } | |
432 | } | |
433 | ||
434 | 1; |