crypto/perlasm/x86unix.pl

   1 #!/usr/bin/env perl
   2
   3 package x86unix;        # GAS actually...
   4
   5 *out=\@::out;
   6
   7 $label="L000";
   8 $const="";
   9 $constl=0;
  10
  11 $align=($::aout)?"4":"16";
  12 $under=($::aout or $::coff)?"_":"";
  13 $dot=($::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     else                                { &::emit($opcode.$suffix,@arg);}
  55
  56   1;
  57 }
  58 #
  59 # opcodes not covered by ::generic above, mostly inconsistent namings...
  60 #
  61 sub ::movz      { &::movzb(@_);                 }
  62 sub ::pushf     { &::pushfl;                    }
  63 sub ::popf      { &::popfl;                     }
  64 sub ::cpuid     { &::emit(".byte\t0x0f,0xa2");  }
  65 sub ::rdtsc     { &::emit(".byte\t0x0f,0x31");  }
  66
  67 sub ::call      { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); }
  68 sub ::call_ptr  { &::generic("call","*$_[0]");  }
  69 sub ::jmp_ptr   { &::generic("jmp","*$_[0]");   }
  70
  71 *::bswap = sub  { &::emit("bswap","%$_[0]");    } if (!$::i386);
  72
  73 # chosen SSE instructions
  74 sub ::movq
  75 { my($p1,$p2,$optimize)=@_;
  76     if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
  77     # movq between mmx registers can sink Intel CPUs
  78     {   &::pshufw($p1,$p2,0xe4);        }
  79     else
  80     {   &::generic("movq",@_);  }
  81 }
  82 sub ::pshufw
  83 { my($dst,$src,$magic)=@_;
  84     &::emit("pshufw","\$$magic","%$src","%$dst");
  85 }
  86
  87 sub ::DWP
  88 { my($addr,$reg1,$reg2,$idx)=@_;
  89   my $ret="";
  90
  91     $addr =~ s/^\s+//;
  92     # prepend global references with optional underscore
  93     $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
  94
  95     $reg1 = "%$reg1" if ($reg1);
  96     $reg2 = "%$reg2" if ($reg2);
  97
  98     $ret .= $addr if (($addr ne "") && ($addr ne 0));
  99
 100     if ($reg2)
 101     {   $idx!= 0 or $idx=1;
 102         $ret .= "($reg1,$reg2,$idx)";
 103     }
 104     elsif ($reg1)
 105     {   $ret .= "($reg1)";      }
 106
 107   $ret;
 108 }
 109 sub ::QWP       { &::DWP(@_);   }
 110 sub ::BP        { &::DWP(@_);   }
 111 sub ::BC        { @_;           }
 112 sub ::DWC       { @_;           }
 113
 114 sub ::file
 115 {   push(@out,".file\t\"$_[0].s\"\n");  }
 116
 117 sub ::function_begin_B
 118 { my($func,$extra)=@_;
 119   my $tmp;
 120
 121     &::external_label($func);
 122     $func=$under.$func;
 123
 124     push(@out,".text\n.globl\t$func\n");
 125     if ($::coff)
 126     {   push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); }
 127     elsif ($::aout and !$::pic)
 128     { }
 129     else
 130     {   push(@out,".type        $func,\@function\n"); }
 131     push(@out,".align\t$align\n");
 132     push(@out,"$func:\n");
 133     $::stack=4;
 134 }
 135
 136 sub ::function_end_B
 137 { my($func)=@_;
 138
 139     $func=$under.$func;
 140     push(@out,"${dot}L_${func}_end:\n");
 141     if ($::elf)
 142     {   push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); }
 143     $::stack=0;
 144     %label=();
 145 }
 146
 147 sub ::comment
 148         {
 149         if (!defined($com_start) or $::elf)
 150                 {       # Regarding $::elf above...
 151                         # GNU and SVR4 as'es use different comment delimiters,
 152                 push(@out,"\n");        # so we just skip ELF comments...
 153                 return;
 154                 }
 155         foreach (@_)
 156                 {
 157                 if (/^\s*$/)
 158                         { push(@out,"\n"); }
 159                 else
 160                         { push(@out,"\t$com_start $_ $com_end\n"); }
 161                 }
 162         }
 163
 164 sub islabel     # see is argument is a known label
 165 { my $i;
 166     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
 167   undef;
 168 }
 169
 170 sub ::external_label { push(@labels,@_); }
 171
 172 sub ::public_label
 173 {   $label{$_[0]}="${under}${_[0]}"     if (!defined($label{$_[0]}));
 174     push(@out,".globl\t$label{$_[0]}\n");
 175 }
 176
 177 sub ::label
 178 {   if (!defined($label{$_[0]}))
 179     {   $label{$_[0]}="${dot}${label}${_[0]}"; $label++;   }
 180   $label{$_[0]};
 181 }
 182
 183 sub ::set_label
 184 { my $label=&::label($_[0]);
 185     &::align($_[1]) if ($_[1]>1);
 186     push(@out,"$label:\n");
 187 }
 188
 189 sub ::file_end
 190 {   # try to detect if SSE2 or MMX extensions were used on ELF platform...
 191     if ($::elf && grep {/%[x]?mm[0-7]/i} @out){
 192         my $tmp;
 193
 194         push (@out,"\n.section\t.bss\n");
 195         push (@out,".comm\t${under}OPENSSL_ia32cap_P,4,4\n");
 196
 197         push (@out,".section\t.init\n");
 198         # One can argue that it's wasteful to craft every
 199         # SSE/MMX module with this snippet... Well, it's 72
 200         # bytes long and for the moment we have two modules.
 201         # Let's argue when we have 7 modules or so...
 202         #
 203         # $1<<10 sets a reserved bit to signal that variable
 204         # was initialized already...
 205         &::picmeup("edx","OPENSSL_ia32cap_P");
 206         $tmp=<<___;
 207         cmpl    \$0,(%edx)
 208         jne     1f
 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     1f
 221         pushl   %edi
 222         pushl   %ebx
 223         movl    %edx,%edi
 224         movl    \$1,%eax
 225         .byte   0x0f,0xa2
 226         orl     \$1<<10,%edx
 227         movl    %edx,0(%edi)
 228         popl    %ebx
 229         popl    %edi
 230         jmp     1f
 231         .align  $align
 232         1:
 233 ___
 234         push (@out,$tmp);
 235     }
 236
 237     if ($const ne "")
 238     {   push(@out,".section .rodata\n");
 239         push(@out,$const);
 240         $const="";
 241     }
 242 }
 243
 244 sub ::data_byte {   push(@out,".byte\t".join(',',@_)."\n");   }
 245 sub ::data_word {   push(@out,".long\t".join(',',@_)."\n");   }
 246
 247 sub ::align
 248 { my $val=$_[0],$p2,$i;
 249     if ($::aout)
 250     {   for ($p2=0;$val!=0;$val>>=1) { $p2++; }
 251         $val=$p2-1;
 252         $val.=",0x90";
 253     }
 254     push(@out,".align\t$val\n");
 255 }
 256
 257 sub ::picmeup
 258 { my($dst,$sym,$base,$reflabel)=@_;
 259
 260     if ($::pic && ($::elf || $::aout))
 261     {   if (!defined($base))
 262         {   &::call(&::label("PIC_me_up"));
 263             &::set_label("PIC_me_up");
 264             &::blindpop($dst);
 265             &::add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-".
 266                             &::label("PIC_me_up") . "]");
 267         }
 268         else
 269         {   &::lea($dst,&::DWP("${under}_GLOBAL_OFFSET_TABLE_+[.-$reflabel]",
 270                             $base));
 271         }
 272         &::mov($dst,&::DWP($under.$sym."\@GOT",$dst));
 273     }
 274     else
 275     {   &::lea($dst,&::DWP($sym));      }
 276 }
 277
 278 sub ::initseg
 279 { my($f)=@_;
 280   my($tmp,$ctor);
 281
 282     if ($::elf)
 283     {   $tmp=<<___;
 284 .section        .init
 285         call    $under$f
 286         jmp     .Linitalign
 287 .align  $align
 288 .Linitalign:
 289 ___
 290     }
 291     elsif ($::coff)
 292     {   $tmp=<<___;     # applies to both Cygwin and Mingw
 293 .section        .ctors
 294 .long   $under$f
 295 ___
 296     }
 297     elsif ($::aout)
 298     {   $ctor="${under}_GLOBAL_\$I\$$f";
 299         $tmp=".text\n";
 300         $tmp.=".type    $ctor,\@function\n" if ($::pic);
 301         $tmp.=<<___;    # OpenBSD way...
 302 .globl  $ctor
 303 .align  2
 304 $ctor:
 305         jmp     $under$f
 306 ___
 307     }
 308     push(@out,$tmp) if ($tmp);
 309 }
 310
 311 1;