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;