x86 perlasm updates.
[openssl.git] / crypto / perlasm / x86unix.pl
1 #!/usr/bin/env perl
2
3 package x86unix;        # GAS actually...
4
5 *out=\@::out;
6
7 $label="L000";
8
9 $align=($::aout)?"4":"16";
10 $under=($::aout or $::coff)?"_":"";
11 $dot=($::aout)?"":".";
12 $com_start="#" if ($::aout or $::coff);
13
14 sub opsize()
15 { my $reg=shift;
16     if    ($reg =~ m/^%e/o)             { "l"; }
17     elsif ($reg =~ m/^%[a-d][hl]$/o)    { "b"; }
18     elsif ($reg =~ m/^%[xm]/o)          { undef; }
19     else                                { "w"; }
20 }
21
22 # swap arguments;
23 # expand opcode with size suffix;
24 # prefix numeric constants with $;
25 sub ::generic
26 { my($opcode,$dst,$src)=@_;
27   my($tmp,$suffix,@arg);
28
29     if (defined($src))
30     {   $src =~ s/^(e?[a-dsixphl]{2})$/%$1/o;
31         $src =~ s/^(x?mm[0-7])$/%$1/o;
32         $src =~ s/^(\-?[0-9]+)$/\$$1/o;
33         $src =~ s/^(\-?0x[0-9a-f]+)$/\$$1/o;
34         push(@arg,$src);
35     }
36     if (defined($dst))
37     {   $dst =~ s/^(\*?)(e?[a-dsixphl]{2})$/$1%$2/o;
38         $dst =~ s/^(x?mm[0-7])$/%$1/o;
39         $dst =~ s/^(\-?[0-9]+)$/\$$1/o          if(!defined($src));
40         $dst =~ s/^(\-?0x[0-9a-f]+)$/\$$1/o     if(!defined($src));
41         push(@arg,$dst);
42     }
43
44     if    ($dst =~ m/^%/o)      { $suffix=&opsize($dst); }
45     elsif ($src =~ m/^%/o)      { $suffix=&opsize($src); }
46     else                        { $suffix="l";           }
47     undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o);
48
49     if ($#_==0)                         { &::emit($opcode);             }
50     elsif ($opcode =~ m/^j/o && $#_==1) { &::emit($opcode,@arg);        }
51     elsif ($opcode eq "call" && $#_==1) { &::emit($opcode,@arg);        }
52     elsif ($opcode =~ m/^set/&& $#_==1) { &::emit($opcode,@arg);        }
53     else                                { &::emit($opcode.$suffix,@arg);}
54
55   1;
56 }
57 #
58 # opcodes not covered by ::generic above, mostly inconsistent namings...
59 #
60 sub ::movz      { &::movzb(@_);                 }
61 sub ::pushf     { &::pushfl;                    }
62 sub ::popf      { &::popfl;                     }
63 sub ::cpuid     { &::emit(".byte\t0x0f,0xa2");  }
64 sub ::rdtsc     { &::emit(".byte\t0x0f,0x31");  }
65
66 sub ::call      { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); }
67 sub ::call_ptr  { &::generic("call","*$_[0]");  }
68 sub ::jmp_ptr   { &::generic("jmp","*$_[0]");   }
69
70 *::bswap = sub  { &::emit("bswap","%$_[0]");    } if (!$::i386);
71
72 # chosen SSE instructions
73 sub ::movq
74 { my($p1,$p2,$optimize)=@_;
75     if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
76     # movq between mmx registers can sink Intel CPUs
77     {   &::pshufw($p1,$p2,0xe4);        }
78     else
79     {   &::generic("movq",@_);  }
80 }
81 sub ::pshufw
82 { my($dst,$src,$magic)=@_;
83     &::emit("pshufw","\$$magic","%$src","%$dst");
84 }
85
86 sub ::DWP
87 { my($addr,$reg1,$reg2,$idx)=@_;
88   my $ret="";
89
90     $addr =~ s/^\s+//;
91     # prepend global references with optional underscore
92     $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
93
94     $reg1 = "%$reg1" if ($reg1);
95     $reg2 = "%$reg2" if ($reg2);
96
97     $ret .= $addr if (($addr ne "") && ($addr ne 0));
98
99     if ($reg2)
100     {   $idx!= 0 or $idx=1;
101         $ret .= "($reg1,$reg2,$idx)";
102     }
103     elsif ($reg1)
104     {   $ret .= "($reg1)";      }
105
106   $ret;
107 }
108 sub ::QWP       { &::DWP(@_);   }
109 sub ::BP        { &::DWP(@_);   }
110 sub ::BC        { @_;           }
111 sub ::DWC       { @_;           }
112
113 sub ::file
114 {   push(@out,".file\t\"$_[0].s\"\n");  }
115
116 sub ::function_begin_B
117 { my($func,$extra)=@_;
118   my $tmp;
119
120     &::external_label($func);
121     $func=$under.$func;
122
123     push(@out,".text\n.globl\t$func\n");
124     if ($::coff)
125     {   push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); }
126     elsif ($::aout and !$::pic)
127     { }
128     else
129     {   push(@out,".type        $func,\@function\n"); }
130     push(@out,".align\t$align\n");
131     push(@out,"$func:\n");
132     $::stack=4;
133 }
134
135 sub ::function_end_B
136 { my($func)=@_;
137
138     $func=$under.$func;
139     push(@out,"${dot}L_${func}_end:\n");
140     if ($::elf)
141     {   push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); }
142     $::stack=0;
143     %label=();
144 }
145
146 sub ::comment
147         {
148         if (!defined($com_start) or $::elf)
149                 {       # Regarding $::elf above...
150                         # GNU and SVR4 as'es use different comment delimiters,
151                 push(@out,"\n");        # so we just skip ELF comments...
152                 return;
153                 }
154         foreach (@_)
155                 {
156                 if (/^\s*$/)
157                         { push(@out,"\n"); }
158                 else
159                         { push(@out,"\t$com_start $_ $com_end\n"); }
160                 }
161         }
162
163 sub islabel     # see is argument is a known label
164 { my $i;
165     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
166   undef;
167 }
168
169 sub ::external_label { push(@labels,@_); }
170
171 sub ::public_label
172 {   $label{$_[0]}="${under}${_[0]}"     if (!defined($label{$_[0]}));
173     push(@out,".globl\t$label{$_[0]}\n");
174 }
175
176 sub ::label
177 {   if (!defined($label{$_[0]}))
178     {   $label{$_[0]}="${dot}${label}${_[0]}"; $label++;   }
179   $label{$_[0]};
180 }
181
182 sub ::set_label
183 { my $label=&::label($_[0]);
184     &::align($_[1]) if ($_[1]>1);
185     push(@out,"$label:\n");
186 }
187
188 sub ::file_end
189 {   # try to detect if SSE2 or MMX extensions were used on ELF platform...
190     if ($::elf && grep {/\b%[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out) {
191
192         push (@out,"\n.section\t.bss\n");
193         push (@out,".comm\t${under}OPENSSL_ia32cap_P,4,4\n");
194
195         return; # below is not needed in OpenSSL context
196
197         push (@out,".section\t.init\n");
198         &::picmeup("edx","OPENSSL_ia32cap_P");
199         # $1<<10 sets a reserved bit to signal that variable
200         # was initialized already...
201         my $code=<<___;
202         cmpl    \$0,(%edx)
203         jne     3f
204         movl    \$1<<10,(%edx)
205         pushf
206         popl    %eax
207         movl    %eax,%ecx
208         xorl    \$1<<21,%eax
209         pushl   %eax
210         popf
211         pushf
212         popl    %eax
213         xorl    %ecx,%eax
214         btl     \$21,%eax
215         jnc     3f
216         pushl   %ebp
217         pushl   %edi
218         pushl   %ebx
219         movl    %edx,%edi
220         xor     %eax,%eax
221         .byte   0x0f,0xa2
222         xorl    %eax,%eax
223         cmpl    $1970169159,%ebx
224         setne   %al
225         movl    %eax,%ebp
226         cmpl    $1231384169,%edx
227         setne   %al
228         orl     %eax,%ebp
229         cmpl    $1818588270,%ecx
230         setne   %al
231         orl     %eax,%ebp
232         movl    $1,%eax
233         .byte   0x0f,0xa2
234         cmpl    $0,%ebp
235         jne     1f
236         andb    $15,%ah
237         cmpb    $15,%ah
238         jne     1f
239         orl     $1048576,%edx
240 1:      btl     $28,%edx
241         jnc     2f
242         shrl    $16,%ebx
243         cmpb    $1,%bl
244         ja      2f
245         andl    $4026531839,%edx
246 2:      orl     \$1<<10,%edx
247         movl    %edx,0(%edi)
248         popl    %ebx
249         popl    %edi
250         popl    %ebp
251         jmp     3f
252         .align  $align
253         3:
254 ___
255         push (@out,$code);
256     }
257 }
258
259 sub ::data_byte {   push(@out,".byte\t".join(',',@_)."\n");   }
260 sub ::data_word {   push(@out,".long\t".join(',',@_)."\n");   }
261
262 sub ::align
263 { my $val=$_[0],$p2,$i;
264     if ($::aout)
265     {   for ($p2=0;$val!=0;$val>>=1) { $p2++; }
266         $val=$p2-1;
267         $val.=",0x90";
268     }
269     push(@out,".align\t$val\n");
270 }
271
272 sub ::picmeup
273 { my($dst,$sym,$base,$reflabel)=@_;
274
275     if ($::pic && ($::elf || $::aout))
276     {   if (!defined($base))
277         {   &::call(&::label("PIC_me_up"));
278             &::set_label("PIC_me_up");
279             &::blindpop($dst);
280             &::add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-".
281                             &::label("PIC_me_up") . "]");
282         }
283         else
284         {   &::lea($dst,&::DWP("${under}_GLOBAL_OFFSET_TABLE_+[.-$reflabel]",
285                             $base));
286         }
287         &::mov($dst,&::DWP($under.$sym."\@GOT",$dst));
288     }
289     else
290     {   &::lea($dst,&::DWP($sym));      }
291 }
292
293 sub ::initseg
294 { my($f)=@_;
295   my($tmp,$ctor);
296
297     if ($::elf)
298     {   $tmp=<<___;
299 .section        .init
300         call    $under$f
301         jmp     .Linitalign
302 .align  $align
303 .Linitalign:
304 ___
305     }
306     elsif ($::coff)
307     {   $tmp=<<___;     # applies to both Cygwin and Mingw
308 .section        .ctors
309 .long   $under$f
310 ___
311     }
312     elsif ($::aout)
313     {   $ctor="${under}_GLOBAL_\$I\$$f";
314         $tmp=".text\n";
315         $tmp.=".type    $ctor,\@function\n" if ($::pic);
316         $tmp.=<<___;    # OpenBSD way...
317 .globl  $ctor
318 .align  2
319 $ctor:
320         jmp     $under$f
321 ___
322     }
323     push(@out,$tmp) if ($tmp);
324 }
325
326 1;