1#!/usr/local/bin/perl
2
3package x86ms;
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); }
30sub main'external_label
31{
32	push(@labels,@_);
33	foreach (@_) {
34		push(@out, "EXTRN\t_$_:DWORD\n");
35	}
36}
37
38sub main'LB
39	{
40	(defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
41	return($lb{$_[0]});
42	}
43
44sub main'HB
45	{
46	(defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
47	return($hb{$_[0]});
48	}
49
50sub main'BP
51	{
52	&get_mem("BYTE",@_);
53	}
54
55sub main'DWP
56	{
57	&get_mem("DWORD",@_);
58	}
59
60sub main'QWP
61	{
62	&get_mem("QWORD",@_);
63	}
64
65sub main'BC
66	{
67	return @_;
68	}
69
70sub main'DWC
71	{
72	return @_;
73	}
74
75sub main'stack_push
76	{
77	local($num)=@_;
78	$stack+=$num*4;
79	&main'sub("esp",$num*4);
80	}
81
82sub main'stack_pop
83	{
84	local($num)=@_;
85	$stack-=$num*4;
86	&main'add("esp",$num*4);
87	}
88
89sub get_mem
90	{
91	local($size,$addr,$reg1,$reg2,$idx)=@_;
92	local($t,$post);
93	local($ret)="$size PTR ";
94
95	$addr =~ s/^\s+//;
96	if ($addr =~ /^(.+)\+(.+)$/)
97		{
98		$reg2=&conv($1);
99		$addr="_$2";
100		}
101	elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
102		{
103		$addr="_$addr";
104		}
105
106	if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
107
108	$reg1="$regs{$reg1}" if defined($regs{$reg1});
109	$reg2="$regs{$reg2}" if defined($regs{$reg2});
110	if (($addr ne "") && ($addr ne 0))
111		{
112		if ($addr !~ /^-/)
113			{ $ret.=$addr; }
114		else	{ $post=$addr; }
115		}
116	if ($reg2 ne "")
117		{
118		$t="";
119		$t="*$idx" if ($idx != 0);
120		$reg1="+".$reg1 if ("$reg1$post" ne "");
121		$ret.="[$reg2$t$reg1$post]";
122		}
123	else
124		{
125		$ret.="[$reg1$post]"
126		}
127	$ret =~ s/\[\]//;	# in case $addr was the only argument
128	return($ret);
129	}
130
131sub main'mov	{ &out2("mov",@_); }
132sub main'movb	{ &out2("mov",@_); }
133sub main'and	{ &out2("and",@_); }
134sub main'or	{ &out2("or",@_); }
135sub main'shl	{ &out2("shl",@_); }
136sub main'shr	{ &out2("shr",@_); }
137sub main'xor	{ &out2("xor",@_); }
138sub main'xorb	{ &out2("xor",@_); }
139sub main'add	{ &out2("add",@_); }
140sub main'adc	{ &out2("adc",@_); }
141sub main'sub	{ &out2("sub",@_); }
142sub main'sbb	{ &out2("sbb",@_); }
143sub main'rotl	{ &out2("rol",@_); }
144sub main'rotr	{ &out2("ror",@_); }
145sub main'exch	{ &out2("xchg",@_); }
146sub main'cmp	{ &out2("cmp",@_); }
147sub main'lea	{ &out2("lea",@_); }
148sub main'mul	{ &out1("mul",@_); }
149sub main'imul	{ &out2("imul",@_); }
150sub main'div	{ &out1("div",@_); }
151sub main'dec	{ &out1("dec",@_); }
152sub main'inc	{ &out1("inc",@_); }
153sub main'jmp	{ &out1("jmp",@_); }
154sub main'jmp_ptr { &out1p("jmp",@_); }
155sub main'je	{ &out1("je",@_); }
156sub main'jle	{ &out1("jle",@_); }
157sub main'jz	{ &out1("jz",@_); }
158sub main'jge	{ &out1("jge",@_); }
159sub main'jl	{ &out1("jl",@_); }
160sub main'ja	{ &out1("ja",@_); }
161sub main'jae	{ &out1("jae",@_); }
162sub main'jb	{ &out1("jb",@_); }
163sub main'jbe	{ &out1("jbe",@_); }
164sub main'jc	{ &out1("jc",@_); }
165sub main'jnc	{ &out1("jnc",@_); }
166sub main'jnz	{ &out1("jnz",@_); }
167sub main'jne	{ &out1("jne",@_); }
168sub main'jno	{ &out1("jno",@_); }
169sub main'push	{ &out1("push",@_); $stack+=4; }
170sub main'pop	{ &out1("pop",@_); $stack-=4; }
171sub main'pushf	{ &out0("pushfd"); $stack+=4; }
172sub main'popf	{ &out0("popfd"); $stack-=4; }
173sub main'bswap	{ &out1("bswap",@_); &using486(); }
174sub main'not	{ &out1("not",@_); }
175sub main'call	{ &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); }
176sub main'call_ptr { &out1p("call",@_); }
177sub main'ret	{ &out0("ret"); }
178sub main'nop	{ &out0("nop"); }
179sub main'test	{ &out2("test",@_); }
180sub main'bt	{ &out2("bt",@_); }
181sub main'leave	{ &out0("leave"); }
182sub main'cpuid  { &out0("DW\t0A20Fh"); }
183sub main'rdtsc  { &out0("DW\t0310Fh"); }
184sub main'halt	{ &out0("hlt"); }
185sub main'movz	{ &out2("movzx",@_); }
186sub main'neg	{ &out1("neg",@_); }
187sub main'cld	{ &out0("cld"); }
188
189# SSE2
190sub main'emms	{ &out0("emms"); }
191sub main'movd	{ &out2("movd",@_); }
192sub main'movq	{ &out2("movq",@_); }
193sub main'movdqu	{ &out2("movdqu",@_); }
194sub main'movdqa	{ &out2("movdqa",@_); }
195sub main'movdq2q{ &out2("movdq2q",@_); }
196sub main'movq2dq{ &out2("movq2dq",@_); }
197sub main'paddq	{ &out2("paddq",@_); }
198sub main'pmuludq{ &out2("pmuludq",@_); }
199sub main'psrlq	{ &out2("psrlq",@_); }
200sub main'psllq	{ &out2("psllq",@_); }
201sub main'pxor	{ &out2("pxor",@_); }
202sub main'por	{ &out2("por",@_); }
203sub main'pand	{ &out2("pand",@_); }
204
205sub out2
206	{
207	local($name,$p1,$p2)=@_;
208	local($l,$t,$line);
209
210	$line="\t$name\t";
211	$t=&conv($p1).",";
212	$l=length($t);
213	$line.="$t";
214	$l=4-($l+9)/8;
215	$line.="\t" x $l;
216	$line.=&conv($p2);
217	if ($line=~/\bxmm[0-7]\b/i) { $line=~s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i; }
218	push(@out,$line."\n");
219	}
220
221sub out0
222	{
223	local($name)=@_;
224
225	push(@out,"\t$name\n");
226	}
227
228sub out1
229	{
230	local($name,$p1)=@_;
231	local($l,$t);
232
233	push(@out,"\t$name\t".&conv($p1)."\n");
234	}
235
236sub conv
237	{
238	local($p)=@_;
239
240	$p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
241	return $p;
242	}
243
244sub using486
245	{
246	return if $using486;
247	$using486++;
248	grep(s/\.386/\.486/,@out);
249	}
250
251sub main'file
252	{
253	local($file)=@_;
254
255	local($tmp)=<<"EOF";
256	TITLE	$file.asm
257        .386
258.model	FLAT
259_TEXT\$	SEGMENT PAGE 'CODE'
260
261EOF
262	push(@out,$tmp);
263	}
264
265sub main'function_begin
266	{
267	local($func,$extra)=@_;
268
269	push(@labels,$func);
270
271	local($tmp)=<<"EOF";
272PUBLIC	_$func
273$extra
274_$func PROC NEAR
275	push	ebp
276	push	ebx
277	push	esi
278	push	edi
279EOF
280	push(@out,$tmp);
281	$stack=20;
282	}
283
284sub main'function_begin_B
285	{
286	local($func,$extra)=@_;
287
288	local($tmp)=<<"EOF";
289PUBLIC	_$func
290$extra
291_$func PROC NEAR
292EOF
293	push(@out,$tmp);
294	$stack=4;
295	}
296
297sub main'function_end
298	{
299	local($func)=@_;
300
301	local($tmp)=<<"EOF";
302	pop	edi
303	pop	esi
304	pop	ebx
305	pop	ebp
306	ret
307_$func ENDP
308EOF
309	push(@out,$tmp);
310	$stack=0;
311	%label=();
312	}
313
314sub main'function_end_B
315	{
316	local($func)=@_;
317
318	local($tmp)=<<"EOF";
319_$func ENDP
320EOF
321	push(@out,$tmp);
322	$stack=0;
323	%label=();
324	}
325
326sub main'function_end_A
327	{
328	local($func)=@_;
329
330	local($tmp)=<<"EOF";
331	pop	edi
332	pop	esi
333	pop	ebx
334	pop	ebp
335	ret
336EOF
337	push(@out,$tmp);
338	}
339
340sub main'file_end
341	{
342	# try to detect if SSE2 or MMX extensions were used...
343	my $xmmheader=<<___;
344.686
345.XMM
346IF \@Version LT 800
347XMMWORD STRUCT 16
348	DQ  2 dup (?)
349XMMWORD ENDS
350ENDIF
351___
352	if (grep {/\b[x]?mm[0-7]\b/i} @out) {
353		grep {s/\.[3-7]86/$xmmheader/} @out;
354		}
355	push(@out,"_TEXT\$	ENDS\n");
356	push(@out,"END\n");
357	}
358
359sub main'wparam
360	{
361	local($num)=@_;
362
363	return(&main'DWP($stack+$num*4,"esp","",0));
364	}
365
366sub main'swtmp
367	{
368	return(&main'DWP($_[0]*4,"esp","",0));
369	}
370
371# Should use swtmp, which is above esp.  Linix can trash the stack above esp
372#sub main'wtmp
373#	{
374#	local($num)=@_;
375#
376#	return(&main'DWP(-(($num+1)*4),"esp","",0));
377#	}
378
379sub main'comment
380	{
381	foreach (@_)
382		{
383		push(@out,"\t; $_\n");
384		}
385	}
386
387sub main'public_label
388	{
389	$label{$_[0]}="_$_[0]"	if (!defined($label{$_[0]}));
390	push(@out,"PUBLIC\t$label{$_[0]}\n");
391	}
392
393sub main'label
394	{
395	if (!defined($label{$_[0]}))
396		{
397		$label{$_[0]}="\$${label}${_[0]}";
398		$label++;
399		}
400	return($label{$_[0]});
401	}
402
403sub main'set_label
404	{
405	if (!defined($label{$_[0]}))
406		{
407		$label{$_[0]}="\$${label}${_[0]}";
408		$label++;
409		}
410	if ($_[1]!=0 && $_[1]>1)
411		{
412		main'align($_[1]);
413		}
414	if((defined $_[2]) && ($_[2] == 1))
415		{
416		push(@out,"$label{$_[0]}::\n");
417		}
418	elsif ($label{$_[0]} !~ /^\$/)
419		{
420		push(@out,"$label{$_[0]}\tLABEL PTR\n");
421		}
422	else
423		{
424		push(@out,"$label{$_[0]}:\n");
425		}
426	}
427
428sub main'data_byte
429	{
430	push(@out,"\tDB\t".join(',',@_)."\n");
431	}
432
433sub main'data_word
434	{
435	push(@out,"\tDD\t".join(',',@_)."\n");
436	}
437
438sub main'align
439	{
440	push(@out,"\tALIGN\t$_[0]\n");
441	}
442
443sub out1p
444	{
445	local($name,$p1)=@_;
446	local($l,$t);
447
448	push(@out,"\t$name\t".&conv($p1)."\n");
449	}
450
451sub main'picmeup
452	{
453	local($dst,$sym)=@_;
454	&main'lea($dst,&main'DWP($sym));
455	}
456
457sub main'blindpop { &out1("pop",@_); }
458
459sub main'initseg
460	{
461	local($f)=@_;
462	local($tmp)=<<___;
463OPTION	DOTNAME
464.CRT\$XCU	SEGMENT DWORD PUBLIC 'DATA'
465EXTRN	_$f:NEAR
466DD	_$f
467.CRT\$XCU	ENDS
468___
469	push(@out,$tmp);
470	}
471
4721;
473