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