1#!/usr/local/bin/perl
2
3package x86nasm;
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
27sub main'asm_init_output { @out=(); }
28sub main'asm_get_output { return(@out); }
29sub main'get_labels { return(@labels); }
30
31sub main'external_label
32{
33	push(@labels,@_);
34	foreach (@_) {
35		push(@out, "extern\t_$_\n");
36	}
37}
38
39sub main'LB
40	{
41	(defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
42	return($lb{$_[0]});
43	}
44
45sub main'HB
46	{
47	(defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
48	return($hb{$_[0]});
49	}
50
51sub main'BP
52	{
53	&get_mem("BYTE",@_);
54	}
55
56sub main'DWP
57	{
58	&get_mem("DWORD",@_);
59	}
60
61sub main'BC
62	{
63	return "BYTE @_";
64	}
65
66sub main'DWC
67	{
68	return "DWORD @_";
69	}
70
71sub main'stack_push
72	{
73	my($num)=@_;
74	$stack+=$num*4;
75	&main'sub("esp",$num*4);
76	}
77
78sub main'stack_pop
79	{
80	my($num)=@_;
81	$stack-=$num*4;
82	&main'add("esp",$num*4);
83	}
84
85sub get_mem
86	{
87	my($size,$addr,$reg1,$reg2,$idx)=@_;
88	my($t,$post);
89	my($ret)="[";
90	$addr =~ s/^\s+//;
91	if ($addr =~ /^(.+)\+(.+)$/)
92		{
93		$reg2=&conv($1);
94		$addr="_$2";
95		}
96	elsif ($addr =~ /^[_a-zA-Z]/)
97		{
98		$addr="_$addr";
99		}
100
101	if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
102
103	$reg1="$regs{$reg1}" if defined($regs{$reg1});
104	$reg2="$regs{$reg2}" if defined($regs{$reg2});
105	if (($addr ne "") && ($addr ne 0))
106		{
107		if ($addr !~ /^-/)
108			{ $ret.="${addr}+"; }
109		else	{ $post=$addr; }
110		}
111	if ($reg2 ne "")
112		{
113		$t="";
114		$t="*$idx" if ($idx != 0);
115		$reg1="+".$reg1 if ("$reg1$post" ne "");
116		$ret.="$reg2$t$reg1$post]";
117		}
118	else
119		{
120		$ret.="$reg1$post]"
121		}
122	$ret =~ s/\+\]/]/; # in case $addr was the only argument
123	return($ret);
124	}
125
126sub main'mov	{ &out2("mov",@_); }
127sub main'movb	{ &out2("mov",@_); }
128sub main'and	{ &out2("and",@_); }
129sub main'or	{ &out2("or",@_); }
130sub main'shl	{ &out2("shl",@_); }
131sub main'shr	{ &out2("shr",@_); }
132sub main'xor	{ &out2("xor",@_); }
133sub main'xorb	{ &out2("xor",@_); }
134sub main'add	{ &out2("add",@_); }
135sub main'adc	{ &out2("adc",@_); }
136sub main'sub	{ &out2("sub",@_); }
137sub main'rotl	{ &out2("rol",@_); }
138sub main'rotr	{ &out2("ror",@_); }
139sub main'exch	{ &out2("xchg",@_); }
140sub main'cmp	{ &out2("cmp",@_); }
141sub main'lea	{ &out2("lea",@_); }
142sub main'mul	{ &out1("mul",@_); }
143sub main'div	{ &out1("div",@_); }
144sub main'dec	{ &out1("dec",@_); }
145sub main'inc	{ &out1("inc",@_); }
146sub main'jmp	{ &out1("jmp",@_); }
147sub main'jmp_ptr { &out1p("jmp",@_); }
148
149# This is a bit of a kludge: declare all branches as NEAR.
150sub main'je	{ &out1("je NEAR",@_); }
151sub main'jle	{ &out1("jle NEAR",@_); }
152sub main'jz	{ &out1("jz NEAR",@_); }
153sub main'jge	{ &out1("jge NEAR",@_); }
154sub main'jl	{ &out1("jl NEAR",@_); }
155sub main'ja	{ &out1("ja NEAR",@_); }
156sub main'jae	{ &out1("jae NEAR",@_); }
157sub main'jb	{ &out1("jb NEAR",@_); }
158sub main'jbe	{ &out1("jbe NEAR",@_); }
159sub main'jc	{ &out1("jc NEAR",@_); }
160sub main'jnc	{ &out1("jnc NEAR",@_); }
161sub main'jnz	{ &out1("jnz NEAR",@_); }
162sub main'jne	{ &out1("jne NEAR",@_); }
163sub main'jno	{ &out1("jno NEAR",@_); }
164
165sub main'push	{ &out1("push",@_); $stack+=4; }
166sub main'pop	{ &out1("pop",@_); $stack-=4; }
167sub main'bswap	{ &out1("bswap",@_); &using486(); }
168sub main'not	{ &out1("not",@_); }
169sub main'call	{ &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); }
170sub main'ret	{ &out0("ret"); }
171sub main'nop	{ &out0("nop"); }
172sub main'movz	{ &out2("movzx",@_); }
173
174sub out2
175	{
176	my($name,$p1,$p2)=@_;
177	my($l,$t);
178
179	push(@out,"\t$name\t");
180	$t=&conv($p1).",";
181	$l=length($t);
182	push(@out,$t);
183	$l=4-($l+9)/8;
184	push(@out,"\t" x $l);
185	push(@out,&conv($p2));
186	push(@out,"\n");
187	}
188
189sub out0
190	{
191	my($name)=@_;
192
193	push(@out,"\t$name\n");
194	}
195
196sub out1
197	{
198	my($name,$p1)=@_;
199	my($l,$t);
200	push(@out,"\t$name\t".&conv($p1)."\n");
201	}
202
203sub conv
204	{
205	my($p)=@_;
206	$p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
207	return $p;
208	}
209
210sub using486
211	{
212	return if $using486;
213	$using486++;
214	grep(s/\.386/\.486/,@out);
215	}
216
217sub main'file
218	{
219	push(@out, "segment .text use32\n");
220	}
221
222sub main'function_begin
223	{
224	my($func,$extra)=@_;
225
226	push(@labels,$func);
227	my($tmp)=<<"EOF";
228global	_$func
229_$func:
230	push	ebp
231	push	ebx
232	push	esi
233	push	edi
234EOF
235	push(@out,$tmp);
236	$stack=20;
237	}
238
239sub main'function_begin_B
240	{
241	my($func,$extra)=@_;
242	my($tmp)=<<"EOF";
243global	_$func
244_$func:
245EOF
246	push(@out,$tmp);
247	$stack=4;
248	}
249
250sub main'function_end
251	{
252	my($func)=@_;
253
254	my($tmp)=<<"EOF";
255	pop	edi
256	pop	esi
257	pop	ebx
258	pop	ebp
259	ret
260EOF
261	push(@out,$tmp);
262	$stack=0;
263	%label=();
264	}
265
266sub main'function_end_B
267	{
268	$stack=0;
269	%label=();
270	}
271
272sub main'function_end_A
273	{
274	my($func)=@_;
275
276	my($tmp)=<<"EOF";
277	pop	edi
278	pop	esi
279	pop	ebx
280	pop	ebp
281	ret
282EOF
283	push(@out,$tmp);
284	}
285
286sub main'file_end
287	{
288	}
289
290sub main'wparam
291	{
292	my($num)=@_;
293
294	return(&main'DWP($stack+$num*4,"esp","",0));
295	}
296
297sub main'swtmp
298	{
299	return(&main'DWP($_[0]*4,"esp","",0));
300	}
301
302# Should use swtmp, which is above esp.  Linix can trash the stack above esp
303#sub main'wtmp
304#	{
305#	my($num)=@_;
306#
307#	return(&main'DWP(-(($num+1)*4),"esp","",0));
308#	}
309
310sub main'comment
311	{
312	foreach (@_)
313		{
314		push(@out,"\t; $_\n");
315		}
316	}
317
318sub main'label
319	{
320	if (!defined($label{$_[0]}))
321		{
322		$label{$_[0]}="\$${label}${_[0]}";
323		$label++;
324		}
325	return($label{$_[0]});
326	}
327
328sub main'set_label
329	{
330	if (!defined($label{$_[0]}))
331		{
332		$label{$_[0]}="\$${label}${_[0]}";
333		$label++;
334		}
335	push(@out,"$label{$_[0]}:\n");
336	}
337
338sub main'data_word
339	{
340	push(@out,"\tDD\t$_[0]\n");
341	}
342
343sub out1p
344	{
345	my($name,$p1)=@_;
346	my($l,$t);
347
348	push(@out,"\t$name\t ".&conv($p1)."\n");
349	}
350
351sub main'picmeup
352	{
353	local($dst,$sym)=@_;
354	&main'lea($dst,&main'DWP($sym));
355	}
356
357sub main'blindpop { &out1("pop",@_); }
358