1#!/usr/local/bin/perl
2
3package 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
28sub main'asm_init_output { @out=(); }
29sub main'asm_get_output { return(@out); }
30sub main'get_labels { return(@labels); }
31
32sub 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
41sub main'LB
42	{
43	(defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
44	return($lb{$_[0]});
45	}
46
47sub main'HB
48	{
49	(defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
50	return($hb{$_[0]});
51	}
52
53sub main'BP
54	{
55	&get_mem("BYTE",@_);
56	}
57
58sub main'DWP
59	{
60	&get_mem("DWORD",@_);
61	}
62
63sub main'QWP
64	{
65	&get_mem("",@_);
66	}
67
68sub main'BC
69	{
70	return (($main'mwerks)?"":"BYTE ")."@_";
71	}
72
73sub main'DWC
74	{
75	return (($main'mwerks)?"":"DWORD ")."@_";
76	}
77
78sub main'stack_push
79	{
80	my($num)=@_;
81	$stack+=$num*4;
82	&main'sub("esp",$num*4);
83	}
84
85sub main'stack_pop
86	{
87	my($num)=@_;
88	$stack-=$num*4;
89	&main'add("esp",$num*4);
90	}
91
92sub 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
139sub main'mov	{ &out2("mov",@_); }
140sub main'movb	{ &out2("mov",@_); }
141sub main'and	{ &out2("and",@_); }
142sub main'or	{ &out2("or",@_); }
143sub main'shl	{ &out2("shl",@_); }
144sub main'shr	{ &out2("shr",@_); }
145sub main'xor	{ &out2("xor",@_); }
146sub main'xorb	{ &out2("xor",@_); }
147sub main'add	{ &out2("add",@_); }
148sub main'adc	{ &out2("adc",@_); }
149sub main'sub	{ &out2("sub",@_); }
150sub main'sbb	{ &out2("sbb",@_); }
151sub main'rotl	{ &out2("rol",@_); }
152sub main'rotr	{ &out2("ror",@_); }
153sub main'exch	{ &out2("xchg",@_); }
154sub main'cmp	{ &out2("cmp",@_); }
155sub main'lea	{ &out2("lea",@_); }
156sub main'mul	{ &out1("mul",@_); }
157sub main'div	{ &out1("div",@_); }
158sub main'dec	{ &out1("dec",@_); }
159sub main'inc	{ &out1("inc",@_); }
160sub main'jmp	{ &out1("jmp",@_); }
161sub main'jmp_ptr { &out1p("jmp",@_); }
162
163# This is a bit of a kludge: declare all branches as NEAR.
164$near=($main'mwerks)?'':'NEAR';
165sub main'je	{ &out1("je $near",@_); }
166sub main'jle	{ &out1("jle $near",@_); }
167sub main'jz	{ &out1("jz $near",@_); }
168sub main'jge	{ &out1("jge $near",@_); }
169sub main'jl	{ &out1("jl $near",@_); }
170sub main'ja	{ &out1("ja $near",@_); }
171sub main'jae	{ &out1("jae $near",@_); }
172sub main'jb	{ &out1("jb $near",@_); }
173sub main'jbe	{ &out1("jbe $near",@_); }
174sub main'jc	{ &out1("jc $near",@_); }
175sub main'jnc	{ &out1("jnc $near",@_); }
176sub main'jnz	{ &out1("jnz $near",@_); }
177sub main'jne	{ &out1("jne $near",@_); }
178sub main'jno	{ &out1("jno $near",@_); }
179
180sub main'push	{ &out1("push",@_); $stack+=4; }
181sub main'pop	{ &out1("pop",@_); $stack-=4; }
182sub main'pushf	{ &out0("pushfd"); $stack+=4; }
183sub main'popf	{ &out0("popfd"); $stack-=4; }
184sub main'bswap	{ &out1("bswap",@_); &using486(); }
185sub main'not	{ &out1("not",@_); }
186sub main'call	{ &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }
187sub main'ret	{ &out0("ret"); }
188sub main'nop	{ &out0("nop"); }
189sub main'test	{ &out2("test",@_); }
190sub main'bt	{ &out2("bt",@_); }
191sub main'leave	{ &out0("leave"); }
192sub main'cpuid	{ &out0("cpuid"); }
193sub main'rdtsc	{ &out0("rdtsc"); }
194sub main'halt	{ &out0("hlt"); }
195sub main'movz	{ &out2("movzx",@_); }
196sub main'neg	{ &out1("neg",@_); }
197sub main'cld	{ &out0("cld"); }
198
199# SSE2
200sub main'emms	{ &out0("emms"); }
201sub main'movd	{ &out2("movd",@_); }
202sub main'movq	{ &out2("movq",@_); }
203sub main'movdqu	{ &out2("movdqu",@_); }
204sub main'movdqa	{ &out2("movdqa",@_); }
205sub main'movdq2q{ &out2("movdq2q",@_); }
206sub main'movq2dq{ &out2("movq2dq",@_); }
207sub main'paddq	{ &out2("paddq",@_); }
208sub main'pmuludq{ &out2("pmuludq",@_); }
209sub main'psrlq	{ &out2("psrlq",@_); }
210sub main'psllq	{ &out2("psllq",@_); }
211sub main'pxor	{ &out2("pxor",@_); }
212sub main'por	{ &out2("por",@_); }
213sub main'pand	{ &out2("pand",@_); }
214
215sub out2
216	{
217	my($name,$p1,$p2)=@_;
218	my($l,$t);
219
220	push(@out,"\t$name\t");
221	if (!$main'mwerks and $name eq "lea")
222		{
223		$p1 =~ s/^[^\[]*\[/\[/;
224		$p2 =~ s/^[^\[]*\[/\[/;
225		}
226	$t=&conv($p1).",";
227	$l=length($t);
228	push(@out,$t);
229	$l=4-($l+9)/8;
230	push(@out,"\t" x $l);
231	push(@out,&conv($p2));
232	push(@out,"\n");
233	}
234
235sub out0
236	{
237	my($name)=@_;
238
239	push(@out,"\t$name\n");
240	}
241
242sub out1
243	{
244	my($name,$p1)=@_;
245	my($l,$t);
246	push(@out,"\t$name\t".&conv($p1)."\n");
247	}
248
249sub conv
250	{
251	my($p)=@_;
252	$p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
253	return $p;
254	}
255
256sub using486
257	{
258	return if $using486;
259	$using486++;
260	grep(s/\.386/\.486/,@out);
261	}
262
263sub main'file
264	{
265	if ($main'mwerks)	{ push(@out,".section\t.text\n"); }
266	else	{
267		local $tmp=<<___;
268%ifdef __omf__
269section	code	use32 class=code
270%else
271section	.text
272%endif
273___
274		push(@out,$tmp);
275		}
276	}
277
278sub main'function_begin
279	{
280	my($func,$extra)=@_;
281
282	push(@labels,$func);
283	my($tmp)=<<"EOF";
284global	$under$func
285$under$func:
286	push	ebp
287	push	ebx
288	push	esi
289	push	edi
290EOF
291	push(@out,$tmp);
292	$stack=20;
293	}
294
295sub main'function_begin_B
296	{
297	my($func,$extra)=@_;
298	my($tmp)=<<"EOF";
299global	$under$func
300$under$func:
301EOF
302	push(@out,$tmp);
303	$stack=4;
304	}
305
306sub main'function_end
307	{
308	my($func)=@_;
309
310	my($tmp)=<<"EOF";
311	pop	edi
312	pop	esi
313	pop	ebx
314	pop	ebp
315	ret
316EOF
317	push(@out,$tmp);
318	$stack=0;
319	%label=();
320	}
321
322sub main'function_end_B
323	{
324	$stack=0;
325	%label=();
326	}
327
328sub main'function_end_A
329	{
330	my($func)=@_;
331
332	my($tmp)=<<"EOF";
333	pop	edi
334	pop	esi
335	pop	ebx
336	pop	ebp
337	ret
338EOF
339	push(@out,$tmp);
340	}
341
342sub main'file_end
343	{
344	}
345
346sub main'wparam
347	{
348	my($num)=@_;
349
350	return(&main'DWP($stack+$num*4,"esp","",0));
351	}
352
353sub main'swtmp
354	{
355	return(&main'DWP($_[0]*4,"esp","",0));
356	}
357
358# Should use swtmp, which is above esp.  Linix can trash the stack above esp
359#sub main'wtmp
360#	{
361#	my($num)=@_;
362#
363#	return(&main'DWP(-(($num+1)*4),"esp","",0));
364#	}
365
366sub main'comment
367	{
368	foreach (@_)
369		{
370		push(@out,"\t; $_\n");
371		}
372	}
373
374sub main'public_label
375	{
376	$label{$_[0]}="${under}${_[0]}"	if (!defined($label{$_[0]}));
377	push(@out,"global\t$label{$_[0]}\n");
378	}
379
380sub main'label
381	{
382	if (!defined($label{$_[0]}))
383		{
384		$label{$_[0]}="\@${label}${_[0]}";
385		$label++;
386		}
387	return($label{$_[0]});
388	}
389
390sub main'set_label
391	{
392	if (!defined($label{$_[0]}))
393		{
394		$label{$_[0]}="\@${label}${_[0]}";
395		$label++;
396		}
397	if ($_[1]!=0 && $_[1]>1)
398		{
399		main'align($_[1]);
400		}
401	push(@out,"$label{$_[0]}:\n");
402	}
403
404sub main'data_word
405	{
406	push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
407	}
408
409sub main'align
410	{
411	push(@out,".") if ($main'mwerks);
412	push(@out,"align\t$_[0]\n");
413	}
414
415sub out1p
416	{
417	my($name,$p1)=@_;
418	my($l,$t);
419
420	push(@out,"\t$name\t ".&conv($p1)."\n");
421	}
422
423sub main'picmeup
424	{
425	local($dst,$sym)=@_;
426	&main'lea($dst,&main'DWP($sym));
427	}
428
429sub main'blindpop { &out1("pop",@_); }
430
431sub main'initseg
432	{
433	local($f)=@_;
434	if ($main'win32)
435		{
436		local($tmp)=<<___;
437segment	.CRT\$XIU data
438extern	$under$f
439DD	$under$f
440___
441		push(@out,$tmp);
442		}
443	}
444
4451;
446