Combat [bogus] relocations in some assember modules.
[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 $begin;
119
120     &::external_label($func);
121     $label{$func} = $begin = "${dot}L_${func}_begin";
122     $func=$under.$func;
123
124     push(@out,".text\n");
125     push(@out,".globl\t$func\n") if ($func !~ /^${under}_/);
126     if ($::coff)
127     {   push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); }
128     elsif ($::aout and !$::pic)
129     { }
130     else
131     {   push(@out,".type        $func,\@function\n"); }
132     push(@out,".align\t$align\n");
133     push(@out,"$func:\n");
134     push(@out,"$begin:\n");
135     $::stack=4;
136 }
137
138 sub ::function_end_B
139 { my($func)=@_;
140   my $i;
141
142     push(@out,"${dot}L_${func}_end:\n");
143     if ($::elf)
144     {   push(@out,".size\t$under$func,${dot}L_${func}_end-${dot}L_${func}_begin\n"); }
145     $::stack=0;
146     foreach $i (keys %label) { delete $label{$i} if ($label{$i} =~ /^${dot}L[0-9]{3}/); }
147 }
148
149 sub ::comment
150         {
151         if (!defined($com_start) or $::elf)
152                 {       # Regarding $::elf above...
153                         # GNU and SVR4 as'es use different comment delimiters,
154                 push(@out,"\n");        # so we just skip ELF comments...
155                 return;
156                 }
157         foreach (@_)
158                 {
159                 if (/^\s*$/)
160                         { push(@out,"\n"); }
161                 else
162                         { push(@out,"\t$com_start $_ $com_end\n"); }
163                 }
164         }
165
166 sub islabel     # see is argument is a known label
167 { my $i;
168     foreach $i (values %label) { return $i if ($i eq $_[0]); }
169   $label{$_[0]};        # can be undef
170 }
171
172 sub ::external_label { push(@labels,@_); }
173
174 sub ::public_label
175 {   $label{$_[0]}="${under}${_[0]}"     if (!defined($label{$_[0]}));
176     push(@out,".globl\t$label{$_[0]}\n");
177 }
178
179 sub ::label
180 {   if (!defined($label{$_[0]}))
181     {   $label{$_[0]}="${dot}${label}${_[0]}"; $label++;   }
182   $label{$_[0]};
183 }
184
185 sub ::set_label
186 { my $label=&::label($_[0]);
187     &::align($_[1]) if ($_[1]>1);
188     push(@out,"$label:\n");
189 }
190
191 sub ::file_end
192 {   # try to detect if SSE2 or MMX extensions were used on ELF platform...
193     if ($::elf && grep {/\b%[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out) {
194
195         push (@out,"\n.section\t.bss\n");
196         push (@out,".comm\t${under}OPENSSL_ia32cap_P,4,4\n");
197
198         return; # below is not needed in OpenSSL context
199
200         push (@out,".section\t.init\n");
201         &::picmeup("edx","OPENSSL_ia32cap_P");
202         # $1<<10 sets a reserved bit to signal that variable
203         # was initialized already...
204         my $code=<<___;
205         cmpl    \$0,(%edx)
206         jne     3f
207         movl    \$1<<10,(%edx)
208         pushf
209         popl    %eax
210         movl    %eax,%ecx
211         xorl    \$1<<21,%eax
212         pushl   %eax
213         popf
214         pushf
215         popl    %eax
216         xorl    %ecx,%eax
217         btl     \$21,%eax
218         jnc     3f
219         pushl   %ebp
220         pushl   %edi
221         pushl   %ebx
222         movl    %edx,%edi
223         xor     %eax,%eax
224         .byte   0x0f,0xa2
225         xorl    %eax,%eax
226         cmpl    $1970169159,%ebx
227         setne   %al
228         movl    %eax,%ebp
229         cmpl    $1231384169,%edx
230         setne   %al
231         orl     %eax,%ebp
232         cmpl    $1818588270,%ecx
233         setne   %al
234         orl     %eax,%ebp
235         movl    $1,%eax
236         .byte   0x0f,0xa2
237         cmpl    $0,%ebp
238         jne     1f
239         andb    $15,%ah
240         cmpb    $15,%ah
241         jne     1f
242         orl     $1048576,%edx
243 1:      btl     $28,%edx
244         jnc     2f
245         shrl    $16,%ebx
246         cmpb    $1,%bl
247         ja      2f
248         andl    $4026531839,%edx
249 2:      orl     \$1<<10,%edx
250         movl    %edx,0(%edi)
251         popl    %ebx
252         popl    %edi
253         popl    %ebp
254         jmp     3f
255         .align  $align
256         3:
257 ___
258         push (@out,$code);
259     }
260 }
261
262 sub ::data_byte {   push(@out,".byte\t".join(',',@_)."\n");   }
263 sub ::data_word {   push(@out,".long\t".join(',',@_)."\n");   }
264
265 sub ::align
266 { my $val=$_[0],$p2,$i;
267     if ($::aout)
268     {   for ($p2=0;$val!=0;$val>>=1) { $p2++; }
269         $val=$p2-1;
270         $val.=",0x90";
271     }
272     push(@out,".align\t$val\n");
273 }
274
275 sub ::picmeup
276 { my($dst,$sym,$base,$reflabel)=@_;
277
278     if ($::pic && ($::elf || $::aout))
279     {   if (!defined($base))
280         {   &::call(&::label("PIC_me_up"));
281             &::set_label("PIC_me_up");
282             &::blindpop($dst);
283             &::add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-".
284                             &::label("PIC_me_up") . "]");
285         }
286         else
287         {   &::lea($dst,&::DWP("${under}_GLOBAL_OFFSET_TABLE_+[.-$reflabel]",
288                             $base));
289         }
290         &::mov($dst,&::DWP($under.$sym."\@GOT",$dst));
291     }
292     else
293     {   &::lea($dst,&::DWP($sym));      }
294 }
295
296 sub ::initseg
297 { my($f)=@_;
298   my($tmp,$ctor);
299
300     if ($::elf)
301     {   $tmp=<<___;
302 .section        .init
303         call    $under$f
304         jmp     .Linitalign
305 .align  $align
306 .Linitalign:
307 ___
308     }
309     elsif ($::coff)
310     {   $tmp=<<___;     # applies to both Cygwin and Mingw
311 .section        .ctors
312 .long   $under$f
313 ___
314     }
315     elsif ($::aout)
316     {   $ctor="${under}_GLOBAL_\$I\$$f";
317         $tmp=".text\n";
318         $tmp.=".type    $ctor,\@function\n" if ($::pic);
319         $tmp.=<<___;    # OpenBSD way...
320 .globl  $ctor
321 .align  2
322 $ctor:
323         jmp     $under$f
324 ___
325     }
326     push(@out,$tmp) if ($tmp);
327 }
328
329 1;