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