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;