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;