]>
Commit | Line | Data |
---|---|---|
43d8f27d AP |
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 | ||
12 | sub ::generic | |
13 | { my ($opcode,@arg)=@_; | |
14 | ||
15 | # fix hexadecimal constants | |
16 | $arg[0] =~ s/0x([0-9a-f]+)/0$1h/oi if (defined($arg[0])); | |
17 | $arg[1] =~ s/0x([0-9a-f]+)/0$1h/oi if (defined($arg[1])); | |
18 | ||
19 | &::emit($opcode,@arg); | |
20 | 1; | |
21 | } | |
22 | # | |
23 | # opcodes not covered by ::generic above, mostly inconsistent namings... | |
24 | # | |
25 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } | |
26 | sub ::call_ptr { &::emit("call",@_); } | |
27 | sub ::jmp_ptr { &::emit("jmp",@_); } | |
28 | ||
29 | sub get_mem | |
30 | { my($size,$addr,$reg1,$reg2,$idx)=@_; | |
31 | my($post,$ret); | |
32 | ||
33 | $ret .= "$size PTR " if ($size ne ""); | |
34 | ||
35 | $addr =~ s/^\s+//; | |
36 | # prepend global references with optional underscore | |
37 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; | |
38 | # put address arithmetic expression in parenthesis | |
39 | $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); | |
40 | ||
41 | if (($addr ne "") && ($addr ne 0)) | |
42 | { if ($addr !~ /^-/) { $ret .= "$addr"; } | |
43 | else { $post=$addr; } | |
44 | } | |
45 | $ret .= "["; | |
46 | ||
47 | if ($reg2 ne "") | |
48 | { $idx!=0 or $idx=1; | |
49 | $ret .= "$reg2*$idx"; | |
50 | $ret .= "+$reg1" if ($reg1 ne ""); | |
51 | } | |
52 | else | |
53 | { $ret .= "$reg1"; } | |
54 | ||
55 | $ret .= "$post]"; | |
56 | $ret =~ s/\+\]/]/; # in case $addr was the only argument | |
57 | $ret =~ s/\[\s*\]//; | |
58 | ||
59 | $ret; | |
60 | } | |
61 | sub ::BP { &get_mem("BYTE",@_); } | |
62 | sub ::DWP { &get_mem("DWORD",@_); } | |
63 | sub ::QWP { &get_mem("QWORD",@_); } | |
64 | sub ::BC { "@_"; } | |
65 | sub ::DWC { "@_"; } | |
66 | ||
67 | sub ::file | |
68 | { my $tmp=<<___; | |
69 | TITLE $_[0].asm | |
70 | .486 | |
71 | .MODEL FLAT | |
72 | OPTION DOTNAME | |
73 | .TEXT\$ SEGMENT PAGE 'CODE' | |
74 | ___ | |
75 | push(@out,$tmp); | |
76 | } | |
77 | ||
78 | sub ::function_begin_B | |
79 | { my $func=shift; | |
80 | my $global=($func !~ /^_/); | |
81 | my $begin="${::lbdecor}_${func}_begin"; | |
82 | ||
83 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); | |
84 | $func=$nmdecor.$func."\tPROC"; | |
85 | ||
86 | if ($global) { $func.=" PUBLIC\n${begin}::\n"; } | |
87 | else { $func.=" PRIVATE\n"; } | |
88 | push(@out,$func); | |
89 | $::stack=4; | |
90 | } | |
91 | sub ::function_end_B | |
92 | { my $func=shift; | |
93 | ||
94 | push(@out,"$nmdecor$func ENDP\n"); | |
95 | $::stack=0; | |
96 | &::wipe_labels(); | |
97 | } | |
98 | ||
99 | sub ::file_end | |
100 | { my $xmmheader=<<___; | |
101 | .686 | |
102 | .XMM | |
103 | IF \@Version LT 800 | |
104 | XMMWORD STRUCT 16 | |
105 | DQ 2 dup (?) | |
106 | XMMWORD ENDS | |
107 | ENDIF | |
108 | ___ | |
109 | if (grep {/\b[x]?mm[0-7]\b/i} @out) { | |
110 | grep {s/\.[3-7]86/$xmmheader/} @out; | |
111 | } | |
112 | ||
113 | push(@out,".TEXT\$ ENDS\n"); | |
114 | ||
115 | if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) | |
116 | { my $comm=<<___; | |
117 | _DATA SEGMENT | |
118 | COMM ${nmdecor}OPENSSL_ia32cap_P:DWORD | |
119 | _DATA ENDS | |
120 | ___ | |
121 | # comment out OPENSSL_ia32cap_P declarations | |
122 | grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; | |
123 | push (@out,$comm); | |
124 | } | |
125 | push (@out,$initseg) if ($initseg); | |
126 | push (@out,"END\n"); | |
127 | } | |
128 | ||
129 | sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } | |
130 | ||
131 | *::set_label_B = sub | |
132 | { my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; | |
133 | ||
134 | sub ::external_label | |
135 | { push(@out, "EXTERN\t".&::LABEL($_[0],$nmdecor.$_[0]).":NEAR\n"); } | |
136 | ||
137 | sub ::public_label | |
138 | { push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | |
139 | ||
140 | sub ::data_byte | |
141 | { push(@out,("DB\t").join(',',@_)."\n"); } | |
142 | ||
143 | sub ::data_word | |
144 | { push(@out,("DD\t").join(',',@_)."\n"); } | |
145 | ||
146 | sub ::align | |
147 | { push(@out,"ALIGN\t$_[0]\n"); } | |
148 | ||
149 | sub ::picmeup | |
150 | { my($dst,$sym)=@_; | |
151 | &::lea($dst,&::DWP($sym)); | |
152 | } | |
153 | ||
154 | sub ::initseg | |
155 | { my $f=$nmdecor.shift; | |
156 | ||
157 | $initseg.=<<___; | |
158 | .CRT\$XCU SEGMENT DWORD PUBLIC DATA | |
159 | EXTERN $f:NEAR | |
160 | DD $f | |
161 | .CRT\$XCU ENDS | |
162 | ___ | |
163 | } | |
164 | ||
165 | 1; |