1#!/usr/bin/env perl
2
3package x86masm;
4
5*out=\@::out;
6
7$::lbdecor="\$L";	# local label decoration
8$nmdecor="_";		# external name decoration
9
10$initseg="";
11$segment="";
12
13sub ::generic
14{ my ($opcode,@arg)=@_;
15
16    # fix hexadecimal constants
17    for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; }
18
19    if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/)	# no []
20    {	$opcode="mov";	}
21    elsif ($opcode !~ /mov[dq]$/)
22    {	# fix xmm references
23	$arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[-1]=~/\bxmm[0-7]\b/i);
24	$arg[-1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i);
25    }
26
27    &::emit($opcode,@arg);
28  1;
29}
30#
31# opcodes not covered by ::generic above, mostly inconsistent namings...
32#
33sub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
34sub ::call_ptr	{ &::emit("call",@_);	}
35sub ::jmp_ptr	{ &::emit("jmp",@_);	}
36sub ::lock	{ &::data_byte(0xf0);	}
37
38sub get_mem
39{ my($size,$addr,$reg1,$reg2,$idx)=@_;
40  my($post,$ret);
41
42    if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
43
44    $ret .= "$size PTR " if ($size ne "");
45
46    $addr =~ s/^\s+//;
47    # prepend global references with optional underscore
48    $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige;
49    # put address arithmetic expression in parenthesis
50    $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
51
52    if (($addr ne "") && ($addr ne 0))
53    {	if ($addr !~ /^-/)	{ $ret .= "$addr";  }
54	else			{ $post=$addr;      }
55    }
56    $ret .= "[";
57
58    if ($reg2 ne "")
59    {	$idx!=0 or $idx=1;
60	$ret .= "$reg2*$idx";
61	$ret .= "+$reg1" if ($reg1 ne "");
62    }
63    else
64    {	$ret .= "$reg1";   }
65
66    $ret .= "$post]";
67    $ret =~ s/\+\]/]/; # in case $addr was the only argument
68    $ret =~ s/\[\s*\]//;
69
70  $ret;
71}
72sub ::BP	{ &get_mem("BYTE",@_);  }
73sub ::WP	{ &get_mem("WORD",@_);	}
74sub ::DWP	{ &get_mem("DWORD",@_); }
75sub ::QWP	{ &get_mem("QWORD",@_); }
76sub ::BC	{ "@_";  }
77sub ::DWC	{ "@_"; }
78
79sub ::file
80{ my $tmp=<<___;
81TITLE	$_[0].asm
82IF \@Version LT 800
83ECHO MASM version 8.00 or later is strongly recommended.
84ENDIF
85.686
86.MODEL	FLAT
87OPTION	DOTNAME
88IF \@Version LT 800
89.text\$	SEGMENT PAGE 'CODE'
90ELSE
91.text\$	SEGMENT ALIGN(64) 'CODE'
92ENDIF
93___
94    push(@out,$tmp);
95    $segment = ".text\$";
96}
97
98sub ::function_begin_B
99{ my $func=shift;
100  my $global=($func !~ /^_/);
101  my $begin="${::lbdecor}_${func}_begin";
102
103    &::LABEL($func,$global?"$begin":"$nmdecor$func");
104    $func="ALIGN\t16\n".$nmdecor.$func."\tPROC";
105
106    if ($global)    { $func.=" PUBLIC\n${begin}::\n"; }
107    else	    { $func.=" PRIVATE\n";            }
108    push(@out,$func);
109    $::stack=4;
110}
111sub ::function_end_B
112{ my $func=shift;
113
114    push(@out,"$nmdecor$func ENDP\n");
115    $::stack=0;
116    &::wipe_labels();
117}
118
119sub ::file_end
120{ my $xmmheader=<<___;
121.686
122.XMM
123IF \@Version LT 800
124XMMWORD STRUCT 16
125DQ	2 dup (?)
126XMMWORD	ENDS
127ENDIF
128___
129    if (grep {/\b[x]?mm[0-7]\b/i} @out) {
130	grep {s/\.[3-7]86/$xmmheader/} @out;
131    }
132
133    push(@out,"$segment	ENDS\n");
134
135    if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
136    {	my $comm=<<___;
137.bss	SEGMENT 'BSS'
138COMM	${nmdecor}OPENSSL_ia32cap_P:DWORD:4
139.bss	ENDS
140___
141	# comment out OPENSSL_ia32cap_P declarations
142	grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
143	push (@out,$comm);
144    }
145    push (@out,$initseg) if ($initseg);
146    push (@out,"END\n");
147}
148
149sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
150
151*::set_label_B = sub
152{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); };
153
154sub ::external_label
155{   foreach(@_)
156    {	push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n");   }
157}
158
159sub ::public_label
160{   push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
161
162sub ::data_byte
163{   push(@out,("DB\t").join(',',splice(@_,0,16))."\n") while(@_);	}
164
165sub ::data_short
166{   push(@out,("DW\t").join(',',splice(@_,0,8))."\n") while(@_);	}
167
168sub ::data_word
169{   push(@out,("DD\t").join(',',splice(@_,0,4))."\n") while(@_);	}
170
171sub ::align
172{   push(@out,"ALIGN\t$_[0]\n");	}
173
174sub ::picmeup
175{ my($dst,$sym)=@_;
176    &::lea($dst,&::DWP($sym));
177}
178
179sub ::initseg
180{ my $f=$nmdecor.shift;
181
182    $initseg.=<<___;
183.CRT\$XCU	SEGMENT DWORD PUBLIC 'DATA'
184EXTERN	$f:NEAR
185DD	$f
186.CRT\$XCU	ENDS
187___
188}
189
190sub ::dataseg
191{   push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA";   }
192
193sub ::safeseh
194{ my $nm=shift;
195    push(@out,"IF \@Version GE 710\n");
196    push(@out,".SAFESEH	".&::LABEL($nm,$nmdecor.$nm)."\n");
197    push(@out,"ENDIF\n");
198}
199
2001;
201