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