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     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 "$under$_[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 "$under$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 $tmp;
 121
 122     &::external_label($func);
 123     $func=$under.$func;
 124
 125     push(@out,".text\n.globl\t$func\n");
 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     $::stack=4;
 135 }
 136
 137 sub ::function_end_B
 138 { my($func)=@_;
 139
 140     $func=$under.$func;
 141     push(@out,"${dot}L_${func}_end:\n");
 142     if ($::elf)
 143     {   push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); }
 144     $::stack=0;
 145     %label=();
 146 }
 147
 148 sub ::comment
 149         {
 150         if (!defined($com_start) or $::elf)
 151                 {       # Regarding $::elf above...
 152                         # GNU and SVR4 as'es use different comment delimiters,
 153                 push(@out,"\n");        # so we just skip ELF comments...
 154                 return;
 155                 }
 156         foreach (@_)
 157                 {
 158                 if (/^\s*$/)
 159                         { push(@out,"\n"); }
 160                 else
 161                         { push(@out,"\t$com_start $_ $com_end\n"); }
 162                 }
 163         }
 164
 165 sub islabel     # see is argument is a known label
 166 { my $i;
 167     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
 168   undef;
 169 }
 170
 171 sub ::external_label { push(@labels,@_); }
 172
 173 sub ::public_label
 174 {   $label{$_[0]}="${under}${_[0]}"     if (!defined($label{$_[0]}));
 175     push(@out,".globl\t$label{$_[0]}\n");
 176 }
 177
 178 sub ::label
 179 {   if (!defined($label{$_[0]}))
 180     {   $label{$_[0]}="${dot}${label}${_[0]}"; $label++;   }
 181   $label{$_[0]};
 182 }
 183
 184 sub ::set_label
 185 { my $label=&::label($_[0]);
 186     &::align($_[1]) if ($_[1]>1);
 187     push(@out,"$label:\n");
 188 }
 189
 190 sub ::file_end
 191 {   # try to detect if SSE2 or MMX extensions were used on ELF platform...
 192     if ($::elf && grep {/%[x]?mm[0-7]/i} @out){
 193         my $tmp;
 194
 195         push (@out,"\n.section\t.bss\n");
 196         push (@out,".comm\t${under}OPENSSL_ia32cap_P,4,4\n");
 197
 198         push (@out,".section\t.init\n");
 199         # One can argue that it's wasteful to craft every
 200         # SSE/MMX module with this snippet... Well, it's 72
 201         # bytes long and for the moment we have two modules.
 202         # Let's argue when we have 7 modules or so...
 203         #
 204         # $1<<10 sets a reserved bit to signal that variable
 205         # was initialized already...
 206         &::picmeup("edx","OPENSSL_ia32cap_P");
 207         $tmp=<<___;
 208         cmpl    \$0,(%edx)
 209         jne     1f
 210         movl    \$1<<10,(%edx)
 211         pushf
 212         popl    %eax
 213         movl    %eax,%ecx
 214         xorl    \$1<<21,%eax
 215         pushl   %eax
 216         popf
 217         pushf
 218         popl    %eax
 219         xorl    %ecx,%eax
 220         btl     \$21,%eax
 221         jnc     1f
 222         pushl   %edi
 223         pushl   %ebx
 224         movl    %edx,%edi
 225         movl    \$1,%eax
 226         .byte   0x0f,0xa2
 227         orl     \$1<<10,%edx
 228         movl    %edx,0(%edi)
 229         popl    %ebx
 230         popl    %edi
 231         jmp     1f
 232         .align  $align
 233         1:
 234 ___
 235         push (@out,$tmp);
 236     }
 237
 238     if ($const ne "")
 239     {   push(@out,".section .rodata\n");
 240         push(@out,$const);
 241         $const="";
 242     }
 243 }
 244
 245 sub ::data_byte {   push(@out,".byte\t".join(',',@_)."\n");   }
 246 sub ::data_word {   push(@out,".long\t".join(',',@_)."\n");   }
 247
 248 sub ::align
 249 { my $val=$_[0],$p2,$i;
 250     if ($::aout)
 251     {   for ($p2=0;$val!=0;$val>>=1) { $p2++; }
 252         $val=$p2-1;
 253         $val.=",0x90";
 254     }
 255     push(@out,".align\t$val\n");
 256 }
 257
 258 sub ::picmeup
 259 { my($dst,$sym,$base,$reflabel)=@_;
 260
 261     if ($::pic && ($::elf || $::aout))
 262     {   if (!defined($base))
 263         {   &::call(&::label("PIC_me_up"));
 264             &::set_label("PIC_me_up");
 265             &::blindpop($dst);
 266             &::add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-".
 267                             &::label("PIC_me_up") . "]");
 268         }
 269         else
 270         {   &::lea($dst,&::DWP("${under}_GLOBAL_OFFSET_TABLE_+[.-$reflabel]",
 271                             $base));
 272         }
 273         &::mov($dst,&::DWP($under.$sym."\@GOT",$dst));
 274     }
 275     else
 276     {   &::lea($dst,&::DWP($sym));      }
 277 }
 278
 279 sub ::initseg
 280 { my($f)=@_;
 281   my($tmp,$ctor);
 282
 283     if ($::elf)
 284     {   $tmp=<<___;
 285 .section        .init
 286         call    $under$f
 287         jmp     .Linitalign
 288 .align  $align
 289 .Linitalign:
 290 ___
 291     }
 292     elsif ($::coff)
 293     {   $tmp=<<___;     # applies to both Cygwin and Mingw
 294 .section        .ctors
 295 .long   $under$f
 296 ___
 297     }
 298     elsif ($::aout)
 299     {   $ctor="${under}_GLOBAL_\$I\$$f";
 300         $tmp=".text\n";
 301         $tmp.=".type    $ctor,\@function\n" if ($::pic);
 302         $tmp.=<<___;    # OpenBSD way...
 303 .globl  $ctor
 304 .align  2
 305 $ctor:
 306         jmp     $under$f
 307 ___
 308     }
 309     push(@out,$tmp) if ($tmp);
 310 }
 311
 312 1;