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