604f58a2d91370d33c9fe1fdff39a772f3646037
[openssl.git] / crypto / perlasm / x86nasm.pl
1 #!/usr/bin/env perl
2
3 package x86nasm;
4
5 *out=\@::out;
6
7 $lbdecor="\@L";                 # local label decoration
8 $nmdecor=$::netware?"":"_";     # external name decoration
9 $drdecor=$::mwerks?".":"";      # directive decoration
10
11 $label="000";
12 $initseg="";
13
14 sub ::generic
15 { my $opcode=shift;
16   my $tmp;
17
18     if (!$::mwerks)
19     {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
20         {   $_[0] = "NEAR $_[0]";       }
21         elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
22         {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
23     }
24     &::emit($opcode,@_);
25   1;
26 }
27 #
28 # opcodes not covered by ::generic above, mostly inconsistent namings...
29 #
30 sub ::movz      { &::movzx(@_);         }
31 sub ::pushf     { &::pushfd;            }
32 sub ::popf      { &::popfd;             }
33
34 sub ::call      { &::emit("call",(&islabel($_[0]) or "$nmdecor$_[0]")); }
35 sub ::call_ptr  { &::emit("call",@_);   }
36 sub ::jmp_ptr   { &::emit("jmp",@_);    }
37
38 # chosen SSE instructions
39 sub ::movq
40 { my($p1,$p2,$optimize)=@_;
41
42     if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
43     # movq between mmx registers can sink Intel CPUs
44     {   &::pshufw($p1,$p2,0xe4);                }
45     else
46     {   &::emit("movq",@_);                     }
47 }
48 sub ::pshufw { &::emit("pshufw",@_); }
49
50 sub get_mem
51 { my($size,$addr,$reg1,$reg2,$idx)=@_;
52   my($post,$ret);
53
54     if ($size ne "")
55     {   $ret .= "$size";
56         $ret .= " PTR" if ($::mwerks);
57         $ret .= " ";
58     }
59     $ret .= "[";
60
61     $addr =~ s/^\s+//;
62     # prepend global references with optional underscore
63     $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$nmdecor$1"/ige;
64     # put address arithmetic expression in parenthesis
65     $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
66
67     if (($addr ne "") && ($addr ne 0))
68     {   if ($addr !~ /^-/)      { $ret .= "$addr+"; }
69         else                    { $post=$addr;      }
70     }
71
72     if ($reg2 ne "")
73     {   $idx!=0 or $idx=1;
74         $ret .= "$reg2*$idx";
75         $ret .= "+$reg1" if ($reg1 ne "");
76     }
77     else
78     {   $ret .= "$reg1";   }
79
80     $ret .= "$post]";
81     $ret =~ s/\+\]/]/; # in case $addr was the only argument
82
83   $ret;
84 }
85 sub ::BP        { &get_mem("BYTE",@_);  }
86 sub ::DWP       { &get_mem("DWORD",@_); }
87 sub ::QWP       { &get_mem("",@_);      }
88 sub ::BC        { (($::mwerks)?"":"BYTE ")."@_";  }
89 sub ::DWC       { (($::mwerks)?"":"DWORD ")."@_"; }
90
91 sub ::file
92 {   if ($::mwerks)      { push(@out,".section\t.text\n"); }
93     else
94     { my $tmp=<<___;
95 %ifdef __omf__
96 section code    use32 class=code align=64
97 %else
98 section .text   code align=64
99 %endif
100 ___
101         push(@out,$tmp);
102     }
103 }
104
105 sub ::function_begin_B
106 { my $func=shift;
107   my $global=($func !~ /^_/);
108   my $begin="${lbdecor}_${func}_begin";
109
110     $label{$func}=$global?"$begin":"$nmdecor$func";
111     $func=$nmdecor.$func;
112
113     push(@out,"${drdecor}global $func\n")       if ($global);
114     push(@out,"${drdecor}align  16\n");
115     push(@out,"$func:\n");
116     push(@out,"$begin:\n")                      if ($global);
117     $::stack=4;
118 }
119 sub ::function_end_B
120 { my $i;
121     foreach $i (keys %label)
122     {   delete $label{$i} if ($label{$i} =~ /^${lbdecor}[0-9]{3}/);     }
123     $::stack=0;
124 }
125
126 sub ::file_end
127 {   # try to detect if SSE2 or MMX extensions were used on Win32...
128     if ($::win32 && grep {/\b[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out)
129     {   # $1<<10 sets a reserved bit to signal that variable
130         # was initialized already...
131         my $code=<<___;
132 align   16
133 ${lbdecor}OPENSSL_ia32cap_init:
134         lea     edx,[${nmdecor}OPENSSL_ia32cap_P]
135         cmp     DWORD [edx],0
136         jne     NEAR ${lbdecor}nocpuid
137         mov     DWORD [edx],1<<10
138         pushfd
139         pop     eax
140         mov     ecx,eax
141         xor     eax,1<<21
142         push    eax
143         popfd
144         pushfd
145         pop     eax
146         xor     eax,ecx
147         bt      eax,21
148         jnc     NEAR ${lbdecor}nocpuid
149         push    ebp
150         push    edi
151         push    ebx
152         mov     edi,edx
153         xor     eax,eax
154         cpuid
155         xor     eax,eax
156         cmp     ebx,'Genu'
157         setne   al
158         mov     ebp,eax
159         cmp     edx,'ineI'
160         setne   al
161         or      ebp,eax
162         cmp     eax,'ntel'
163         setne   al
164         or      ebp,eax
165         mov     eax,1
166         cpuid
167         cmp     ebp,0
168         jne     ${lbdecor}notP4
169         and     ah,15
170         cmp     ah,15
171         jne     ${lbdecor}notP4
172         or      edx,1<<20
173 ${lbdecor}notP4:
174         bt      edx,28
175         jnc     ${lbdecor}done
176         shr     ebx,16
177         cmp     bl,1
178         ja      ${lbdecor}done
179         and     edx,0xefffffff
180 ${lbdecor}done:
181         or      edx,1<<10
182         mov     DWORD [edi],edx
183         pop     ebx
184         pop     edi
185         pop     ebp
186 ${lbdecor}nocpuid:
187         ret
188 segment .CRT\$XCU data align=4
189 dd      ${lbdecor}OPENSSL_ia32cap_init
190 ___
191         my $data=<<___;
192 segment .bss
193 common  ${nmdecor}OPENSSL_ia32cap_P 4
194 ___
195
196         #<not needed in OpenSSL context>#push (@out,$code);
197
198         # comment out OPENSSL_ia32cap_P declarations
199         grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
200         push (@out,$data)
201     }
202     push (@out,$initseg) if ($initseg);         
203 }
204
205 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
206
207 sub islabel     # see is argument is known label
208 { my $i;
209     foreach $i (values %label) { return $i if ($i eq $_[0]); }
210   $label{$_[0]};        # can be undef
211 }
212
213 sub ::external_label
214 {   push(@labels,@_);
215     foreach (@_)
216     {   push(@out, "${drdecor}extern\t${nmdecor}$_\n"); }
217 }
218
219 sub ::public_label
220 {   $label{$_[0]}="${nmdecor}${_[0]}" if (!defined($label{$_[0]}));
221     push(@out,"${drdecor}global\t$label{$_[0]}\n");
222 }
223
224 sub ::label
225 {   if (!defined($label{$_[0]}))
226     {   $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
227   $label{$_[0]};
228 }
229
230 sub ::set_label
231 { my $label=&::label($_[0]);
232     &::align($_[1]) if ($_[1]>1);
233     push(@out,"$label{$_[0]}:\n");
234 }
235
236 sub ::data_byte
237 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
238
239 sub ::data_word
240 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
241
242 sub ::align
243 {   push(@out,"${drdecor}align\t$_[0]\n");      }
244
245 sub ::picmeup
246 { my($dst,$sym)=@_;
247     &::lea($dst,&::DWP($sym));
248 }
249
250 sub ::initseg
251 { my($f)=$nmdecor.shift;
252     if ($::win32)
253     {   $initseg=<<___;
254 segment .CRT\$XCU data align=4
255 extern  $f
256 dd      $f
257 ___
258     }
259 }
260
261 1;