Whirlpool hash implementation. The fact that subdirectory and .h file are
[openssl.git] / crypto / perlasm / x86nasm.pl
1 #!/usr/local/bin/perl
2
3 package x86nasm;
4
5 $label="L000";
6 $under=($main'netware)?'':'_';
7
8 %lb=(   'eax',  'al',
9         'ebx',  'bl',
10         'ecx',  'cl',
11         'edx',  'dl',
12         'ax',   'al',
13         'bx',   'bl',
14         'cx',   'cl',
15         'dx',   'dl',
16         );
17
18 %hb=(   'eax',  'ah',
19         'ebx',  'bh',
20         'ecx',  'ch',
21         'edx',  'dh',
22         'ax',   'ah',
23         'bx',   'bh',
24         'cx',   'ch',
25         'dx',   'dh',
26         );
27
28 sub main'asm_init_output { @out=(); }
29 sub main'asm_get_output { return(@out); }
30 sub main'get_labels { return(@labels); }
31
32 sub main'external_label
33 {
34         push(@labels,@_);
35         foreach (@_) {
36                 push(@out,".") if ($main'mwerks);
37                 push(@out, "extern\t${under}$_\n");
38         }
39 }
40
41 sub main'LB
42         {
43         (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
44         return($lb{$_[0]});
45         }
46
47 sub main'HB
48         {
49         (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
50         return($hb{$_[0]});
51         }
52
53 sub main'BP
54         {
55         &get_mem("BYTE",@_);
56         }
57
58 sub main'DWP
59         {
60         &get_mem("DWORD",@_);
61         }
62
63 sub main'QWP
64         {
65         &get_mem("",@_);
66         }
67
68 sub main'BC
69         {
70         return (($main'mwerks)?"":"BYTE ")."@_";
71         }
72
73 sub main'DWC
74         {
75         return (($main'mwerks)?"":"DWORD ")."@_";
76         }
77
78 sub main'stack_push
79         {
80         my($num)=@_;
81         $stack+=$num*4;
82         &main'sub("esp",$num*4);
83         }
84
85 sub main'stack_pop
86         {
87         my($num)=@_;
88         $stack-=$num*4;
89         &main'add("esp",$num*4);
90         }
91
92 sub get_mem
93         {
94         my($size,$addr,$reg1,$reg2,$idx)=@_;
95         my($t,$post);
96         my($ret)=$size;
97         if ($ret ne "")
98                 {
99                 $ret .= " PTR" if ($main'mwerks);
100                 $ret .= " ";
101                 }
102         $ret .= "[";
103         $addr =~ s/^\s+//;
104         if ($addr =~ /^(.+)\+(.+)$/)
105                 {
106                 $reg2=&conv($1);
107                 $addr="$under$2";
108                 }
109         elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
110                 {
111                 $addr="$under$addr";
112                 }
113
114         if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
115
116         $reg1="$regs{$reg1}" if defined($regs{$reg1});
117         $reg2="$regs{$reg2}" if defined($regs{$reg2});
118         if (($addr ne "") && ($addr ne 0))
119                 {
120                 if ($addr !~ /^-/)
121                         { $ret.="${addr}+"; }
122                 else    { $post=$addr; }
123                 }
124         if ($reg2 ne "")
125                 {
126                 $t="";
127                 $t="*$idx" if ($idx != 0);
128                 $reg1="+".$reg1 if ("$reg1$post" ne "");
129                 $ret.="$reg2$t$reg1$post]";
130                 }
131         else
132                 {
133                 $ret.="$reg1$post]"
134                 }
135         $ret =~ s/\+\]/]/; # in case $addr was the only argument
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'sbb    { &out2("sbb",@_); }
151 sub main'rotl   { &out2("rol",@_); }
152 sub main'rotr   { &out2("ror",@_); }
153 sub main'exch   { &out2("xchg",@_); }
154 sub main'cmp    { &out2("cmp",@_); }
155 sub main'lea    { &out2("lea",@_); }
156 sub main'mul    { &out1("mul",@_); }
157 sub main'div    { &out1("div",@_); }
158 sub main'dec    { &out1("dec",@_); }
159 sub main'inc    { &out1("inc",@_); }
160 sub main'jmp    { &out1("jmp",@_); }
161 sub main'jmp_ptr { &out1p("jmp",@_); }
162
163 # This is a bit of a kludge: declare all branches as NEAR.
164 $near=($main'mwerks)?'':'NEAR';
165 sub main'je     { &out1("je $near",@_); }
166 sub main'jle    { &out1("jle $near",@_); }
167 sub main'jz     { &out1("jz $near",@_); }
168 sub main'jge    { &out1("jge $near",@_); }
169 sub main'jl     { &out1("jl $near",@_); }
170 sub main'ja     { &out1("ja $near",@_); }
171 sub main'jae    { &out1("jae $near",@_); }
172 sub main'jb     { &out1("jb $near",@_); }
173 sub main'jbe    { &out1("jbe $near",@_); }
174 sub main'jc     { &out1("jc $near",@_); }
175 sub main'jnc    { &out1("jnc $near",@_); }
176 sub main'jnz    { &out1("jnz $near",@_); }
177 sub main'jne    { &out1("jne $near",@_); }
178 sub main'jno    { &out1("jno $near",@_); }
179
180 sub main'push   { &out1("push",@_); $stack+=4; }
181 sub main'pop    { &out1("pop",@_); $stack-=4; }
182 sub main'pushf  { &out0("pushfd"); $stack+=4; }
183 sub main'popf   { &out0("popfd"); $stack-=4; }
184 sub main'bswap  { &out1("bswap",@_); &using486(); }
185 sub main'not    { &out1("not",@_); }
186 sub main'call   { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }
187 sub main'ret    { &out0("ret"); }
188 sub main'nop    { &out0("nop"); }
189 sub main'test   { &out2("test",@_); }
190 sub main'bt     { &out2("bt",@_); }
191 sub main'leave  { &out0("leave"); }
192 sub main'cpuid  { &out0("cpuid"); }
193 sub main'rdtsc  { &out0("rdtsc"); }
194 sub main'halt   { &out0("hlt"); }
195 sub main'movz   { &out2("movzx",@_); }
196 sub main'neg    { &out1("neg",@_); }
197 sub main'cld    { &out0("cld"); }
198
199 # SSE2
200 sub main'emms   { &out0("emms"); }
201 sub main'movd   { &out2("movd",@_); }
202 sub main'movq   { &out2("movq",@_); }
203 sub main'movdqu { &out2("movdqu",@_); }
204 sub main'movdqa { &out2("movdqa",@_); }
205 sub main'movdq2q{ &out2("movdq2q",@_); }
206 sub main'movq2dq{ &out2("movq2dq",@_); }
207 sub main'paddq  { &out2("paddq",@_); }
208 sub main'pmuludq{ &out2("pmuludq",@_); }
209 sub main'psrlq  { &out2("psrlq",@_); }
210 sub main'psllq  { &out2("psllq",@_); }
211 sub main'pxor   { &out2("pxor",@_); }
212 sub main'por    { &out2("por",@_); }
213 sub main'pand   { &out2("pand",@_); }
214
215 sub out2
216         {
217         my($name,$p1,$p2)=@_;
218         my($l,$t);
219
220         push(@out,"\t$name\t");
221         if (!$main'mwerks and $name eq "lea")
222                 {
223                 $p1 =~ s/^[^\[]*\[/\[/;
224                 $p2 =~ s/^[^\[]*\[/\[/;
225                 }
226         $t=&conv($p1).",";
227         $l=length($t);
228         push(@out,$t);
229         $l=4-($l+9)/8;
230         push(@out,"\t" x $l);
231         push(@out,&conv($p2));
232         push(@out,"\n");
233         }
234
235 sub out0
236         {
237         my($name)=@_;
238
239         push(@out,"\t$name\n");
240         }
241
242 sub out1
243         {
244         my($name,$p1)=@_;
245         my($l,$t);
246         push(@out,"\t$name\t".&conv($p1)."\n");
247         }
248
249 sub conv
250         {
251         my($p)=@_;
252         $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
253         return $p;
254         }
255
256 sub using486
257         {
258         return if $using486;
259         $using486++;
260         grep(s/\.386/\.486/,@out);
261         }
262
263 sub main'file
264         {
265         if ($main'mwerks)       { push(@out,".section\t.text\n"); }
266         else    {
267                 local $tmp=<<___;
268 %ifdef __omf__
269 section code    use32 class=code
270 %else
271 section .text
272 %endif
273 ___
274                 push(@out,$tmp);
275                 }
276         }
277
278 sub main'function_begin
279         {
280         my($func,$extra)=@_;
281
282         push(@labels,$func);
283         my($tmp)=<<"EOF";
284 global  $under$func
285 $under$func:
286         push    ebp
287         push    ebx
288         push    esi
289         push    edi
290 EOF
291         push(@out,$tmp);
292         $stack=20;
293         }
294
295 sub main'function_begin_B
296         {
297         my($func,$extra)=@_;
298         my($tmp)=<<"EOF";
299 global  $under$func
300 $under$func:
301 EOF
302         push(@out,$tmp);
303         $stack=4;
304         }
305
306 sub main'function_end
307         {
308         my($func)=@_;
309
310         my($tmp)=<<"EOF";
311         pop     edi
312         pop     esi
313         pop     ebx
314         pop     ebp
315         ret
316 EOF
317         push(@out,$tmp);
318         $stack=0;
319         %label=();
320         }
321
322 sub main'function_end_B
323         {
324         $stack=0;
325         %label=();
326         }
327
328 sub main'function_end_A
329         {
330         my($func)=@_;
331
332         my($tmp)=<<"EOF";
333         pop     edi
334         pop     esi
335         pop     ebx
336         pop     ebp
337         ret
338 EOF
339         push(@out,$tmp);
340         }
341
342 sub main'file_end
343         {
344         }
345
346 sub main'wparam
347         {
348         my($num)=@_;
349
350         return(&main'DWP($stack+$num*4,"esp","",0));
351         }
352
353 sub main'swtmp
354         {
355         return(&main'DWP($_[0]*4,"esp","",0));
356         }
357
358 # Should use swtmp, which is above esp.  Linix can trash the stack above esp
359 #sub main'wtmp
360 #       {
361 #       my($num)=@_;
362 #
363 #       return(&main'DWP(-(($num+1)*4),"esp","",0));
364 #       }
365
366 sub main'comment
367         {
368         foreach (@_)
369                 {
370                 push(@out,"\t; $_\n");
371                 }
372         }
373
374 sub main'public_label
375         {
376         $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
377         push(@out,"global\t$label{$_[0]}\n");
378         }
379
380 sub main'label
381         {
382         if (!defined($label{$_[0]}))
383                 {
384                 $label{$_[0]}="\@${label}${_[0]}";
385                 $label++;
386                 }
387         return($label{$_[0]});
388         }
389
390 sub main'set_label
391         {
392         if (!defined($label{$_[0]}))
393                 {
394                 $label{$_[0]}="\@${label}${_[0]}";
395                 $label++;
396                 }
397         if ($_[1]!=0 && $_[1]>1)
398                 {
399                 main'align($_[1]);
400                 }
401         push(@out,"$label{$_[0]}:\n");
402         }
403
404 sub main'data_byte
405         {
406         push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n");
407         }
408
409 sub main'data_word
410         {
411         push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
412         }
413
414 sub main'align
415         {
416         push(@out,".") if ($main'mwerks);
417         push(@out,"align\t$_[0]\n");
418         }
419
420 sub out1p
421         {
422         my($name,$p1)=@_;
423         my($l,$t);
424
425         push(@out,"\t$name\t ".&conv($p1)."\n");
426         }
427
428 sub main'picmeup
429         {
430         local($dst,$sym)=@_;
431         &main'lea($dst,&main'DWP($sym));
432         }
433
434 sub main'blindpop { &out1("pop",@_); }
435
436 sub main'initseg
437         {
438         local($f)=@_;
439         if ($main'win32)
440                 {
441                 local($tmp)=<<___;
442 segment .CRT\$XIU data
443 extern  $under$f
444 DD      $under$f
445 ___
446                 push(@out,$tmp);
447                 }
448         }
449
450 1;