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