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