crypto/openssl/crypto/perlasm/x86nasm.pl

   1 #!/usr/local/bin/perl
   2
   3 package x86nasm;
   4
   5 $label="L000";
   6 $under=($main'netware)?'':'_';
   7
   8 %lb=(   'eax',  'al',
   9         'ebx',  'bl',
  10         'ecx',  'cl',
  11         'edx',  'dl',
  12         'ax',   'al',
  13         'bx',   'bl',
  14         'cx',   'cl',
  15         'dx',   'dl',
  16         );
  17
  18 %hb=(   'eax',  'ah',
  19         'ebx',  'bh',
  20         'ecx',  'ch',
  21         'edx',  'dh',
  22         'ax',   'ah',
  23         'bx',   'bh',
  24         'cx',   'ch',
  25         'dx',   'dh',
  26         );
  27
  28 sub main'asm_init_output { @out=(); }
  29 sub main'asm_get_output { return(@out); }
  30 sub main'get_labels { return(@labels); }
  31
  32 sub main'external_label
  33 {
  34         push(@labels,@_);
  35         foreach (@_) {
  36                 push(@out,".") if ($main'mwerks);
  37                 push(@out, "extern\t${under}$_\n");
  38         }
  39 }
  40
  41 sub main'LB
  42         {
  43         (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
  44         return($lb{$_[0]});
  45         }
  46
  47 sub main'HB
  48         {
  49         (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
  50         return($hb{$_[0]});
  51         }
  52
  53 sub main'BP
  54         {
  55         &get_mem("BYTE",@_);
  56         }
  57
  58 sub main'DWP
  59         {
  60         &get_mem("DWORD",@_);
  61         }
  62
  63 sub main'QWP
  64         {
  65         &get_mem("",@_);
  66         }
  67
  68 sub main'BC
  69         {
  70         return (($main'mwerks)?"":"BYTE ")."@_";
  71         }
  72
  73 sub main'DWC
  74         {
  75         return (($main'mwerks)?"":"DWORD ")."@_";
  76         }
  77
  78 sub main'stack_push
  79         {
  80         my($num)=@_;
  81         $stack+=$num*4;
  82         &main'sub("esp",$num*4);
  83         }
  84
  85 sub main'stack_pop
  86         {
  87         my($num)=@_;
  88         $stack-=$num*4;
  89         &main'add("esp",$num*4);
  90         }
  91
  92 sub get_mem
  93         {
  94         my($size,$addr,$reg1,$reg2,$idx)=@_;
  95         my($t,$post);
  96         my($ret)=$size;
  97         if ($ret ne "")
  98                 {
  99                 $ret .= " PTR" if ($main'mwerks);
 100                 $ret .= " ";
 101                 }
 102         $ret .= "[";
 103         $addr =~ s/^\s+//;
 104         if ($addr =~ /^(.+)\+(.+)$/)
 105                 {
 106                 $reg2=&conv($1);
 107                 $addr="$under$2";
 108                 }
 109         elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
 110                 {
 111                 $addr="$under$addr";
 112                 }
 113
 114         if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
 115
 116         $reg1="$regs{$reg1}" if defined($regs{$reg1});
 117         $reg2="$regs{$reg2}" if defined($regs{$reg2});
 118         if (($addr ne "") && ($addr ne 0))
 119                 {
 120                 if ($addr !~ /^-/)
 121                         { $ret.="${addr}+"; }
 122                 else    { $post=$addr; }
 123                 }
 124         if ($reg2 ne "")
 125                 {
 126                 $t="";
 127                 $t="*$idx" if ($idx != 0);
 128                 $reg1="+".$reg1 if ("$reg1$post" ne "");
 129                 $ret.="$reg2$t$reg1$post]";
 130                 }
 131         else
 132                 {
 133                 $ret.="$reg1$post]"
 134                 }
 135         $ret =~ s/\+\]/]/; # in case $addr was the only argument
 136         return($ret);
 137         }
 138
 139 sub main'mov    { &out2("mov",@_); }
 140 sub main'movb   { &out2("mov",@_); }
 141 sub main'and    { &out2("and",@_); }
 142 sub main'or     { &out2("or",@_); }
 143 sub main'shl    { &out2("shl",@_); }
 144 sub main'shr    { &out2("shr",@_); }
 145 sub main'xor    { &out2("xor",@_); }
 146 sub main'xorb   { &out2("xor",@_); }
 147 sub main'add    { &out2("add",@_); }
 148 sub main'adc    { &out2("adc",@_); }
 149 sub main'sub    { &out2("sub",@_); }
 150 sub main'sbb    { &out2("sbb",@_); }
 151 sub main'rotl   { &out2("rol",@_); }
 152 sub main'rotr   { &out2("ror",@_); }
 153 sub main'exch   { &out2("xchg",@_); }
 154 sub main'cmp    { &out2("cmp",@_); }
 155 sub main'lea    { &out2("lea",@_); }
 156 sub main'mul    { &out1("mul",@_); }
 157 sub main'imul   { &out2("imul",@_); }
 158 sub main'div    { &out1("div",@_); }
 159 sub main'dec    { &out1("dec",@_); }
 160 sub main'inc    { &out1("inc",@_); }
 161 sub main'jmp    { &out1("jmp",@_); }
 162 sub main'jmp_ptr { &out1p("jmp",@_); }
 163
 164 # This is a bit of a kludge: declare all branches as NEAR.
 165 $near=($main'mwerks)?'':'NEAR';
 166 sub main'je     { &out1("je $near",@_); }
 167 sub main'jle    { &out1("jle $near",@_); }
 168 sub main'jz     { &out1("jz $near",@_); }
 169 sub main'jge    { &out1("jge $near",@_); }
 170 sub main'jl     { &out1("jl $near",@_); }
 171 sub main'ja     { &out1("ja $near",@_); }
 172 sub main'jae    { &out1("jae $near",@_); }
 173 sub main'jb     { &out1("jb $near",@_); }
 174 sub main'jbe    { &out1("jbe $near",@_); }
 175 sub main'jc     { &out1("jc $near",@_); }
 176 sub main'jnc    { &out1("jnc $near",@_); }
 177 sub main'jnz    { &out1("jnz $near",@_); }
 178 sub main'jne    { &out1("jne $near",@_); }
 179 sub main'jno    { &out1("jno $near",@_); }
 180
 181 sub main'push   { &out1("push",@_); $stack+=4; }
 182 sub main'pop    { &out1("pop",@_); $stack-=4; }
 183 sub main'pushf  { &out0("pushfd"); $stack+=4; }
 184 sub main'popf   { &out0("popfd"); $stack-=4; }
 185 sub main'bswap  { &out1("bswap",@_); &using486(); }
 186 sub main'not    { &out1("not",@_); }
 187 sub main'call   { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }
 188 sub main'call_ptr { &out1p("call",@_); }
 189 sub main'ret    { &out0("ret"); }
 190 sub main'nop    { &out0("nop"); }
 191 sub main'test   { &out2("test",@_); }
 192 sub main'bt     { &out2("bt",@_); }
 193 sub main'leave  { &out0("leave"); }
 194 sub main'cpuid  { &out0("cpuid"); }
 195 sub main'rdtsc  { &out0("rdtsc"); }
 196 sub main'halt   { &out0("hlt"); }
 197 sub main'movz   { &out2("movzx",@_); }
 198 sub main'neg    { &out1("neg",@_); }
 199 sub main'cld    { &out0("cld"); }
 200
 201 # SSE2
 202 sub main'emms   { &out0("emms"); }
 203 sub main'movd   { &out2("movd",@_); }
 204 sub main'movq   { &out2("movq",@_); }
 205 sub main'movdqu { &out2("movdqu",@_); }
 206 sub main'movdqa { &out2("movdqa",@_); }
 207 sub main'movdq2q{ &out2("movdq2q",@_); }
 208 sub main'movq2dq{ &out2("movq2dq",@_); }
 209 sub main'paddq  { &out2("paddq",@_); }
 210 sub main'pmuludq{ &out2("pmuludq",@_); }
 211 sub main'psrlq  { &out2("psrlq",@_); }
 212 sub main'psllq  { &out2("psllq",@_); }
 213 sub main'pxor   { &out2("pxor",@_); }
 214 sub main'por    { &out2("por",@_); }
 215 sub main'pand   { &out2("pand",@_); }
 216
 217 sub out2
 218         {
 219         my($name,$p1,$p2)=@_;
 220         my($l,$t);
 221
 222         push(@out,"\t$name\t");
 223         if (!$main'mwerks and $name eq "lea")
 224                 {
 225                 $p1 =~ s/^[^\[]*\[/\[/;
 226                 $p2 =~ s/^[^\[]*\[/\[/;
 227                 }
 228         $t=&conv($p1).",";
 229         $l=length($t);
 230         push(@out,$t);
 231         $l=4-($l+9)/8;
 232         push(@out,"\t" x $l);
 233         push(@out,&conv($p2));
 234         push(@out,"\n");
 235         }
 236
 237 sub out0
 238         {
 239         my($name)=@_;
 240
 241         push(@out,"\t$name\n");
 242         }
 243
 244 sub out1
 245         {
 246         my($name,$p1)=@_;
 247         my($l,$t);
 248         push(@out,"\t$name\t".&conv($p1)."\n");
 249         }
 250
 251 sub conv
 252         {
 253         my($p)=@_;
 254         $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
 255         return $p;
 256         }
 257
 258 sub using486
 259         {
 260         return if $using486;
 261         $using486++;
 262         grep(s/\.386/\.486/,@out);
 263         }
 264
 265 sub main'file
 266         {
 267         if ($main'mwerks)       { push(@out,".section\t.text\n"); }
 268         else    {
 269                 local $tmp=<<___;
 270 %ifdef __omf__
 271 section code    use32 class=code
 272 %else
 273 section .text
 274 %endif
 275 ___
 276                 push(@out,$tmp);
 277                 }
 278         }
 279
 280 sub main'function_begin
 281         {
 282         my($func,$extra)=@_;
 283
 284         push(@labels,$func);
 285         push(@out,".") if ($main'mwerks);
 286         my($tmp)=<<"EOF";
 287 global  $under$func
 288 $under$func:
 289         push    ebp
 290         push    ebx
 291         push    esi
 292         push    edi
 293 EOF
 294         push(@out,$tmp);
 295         $stack=20;
 296         }
 297
 298 sub main'function_begin_B
 299         {
 300         my($func,$extra)=@_;
 301         push(@out,".") if ($main'mwerks);
 302         my($tmp)=<<"EOF";
 303 global  $under$func
 304 $under$func:
 305 EOF
 306         push(@out,$tmp);
 307         $stack=4;
 308         }
 309
 310 sub main'function_end
 311         {
 312         my($func)=@_;
 313
 314         my($tmp)=<<"EOF";
 315         pop     edi
 316         pop     esi
 317         pop     ebx
 318         pop     ebp
 319         ret
 320 EOF
 321         push(@out,$tmp);
 322         $stack=0;
 323         %label=();
 324         }
 325
 326 sub main'function_end_B
 327         {
 328         $stack=0;
 329         %label=();
 330         }
 331
 332 sub main'function_end_A
 333         {
 334         my($func)=@_;
 335
 336         my($tmp)=<<"EOF";
 337         pop     edi
 338         pop     esi
 339         pop     ebx
 340         pop     ebp
 341         ret
 342 EOF
 343         push(@out,$tmp);
 344         }
 345
 346 sub main'file_end
 347         {
 348         }
 349
 350 sub main'wparam
 351         {
 352         my($num)=@_;
 353
 354         return(&main'DWP($stack+$num*4,"esp","",0));
 355         }
 356
 357 sub main'swtmp
 358         {
 359         return(&main'DWP($_[0]*4,"esp","",0));
 360         }
 361
 362 # Should use swtmp, which is above esp.  Linix can trash the stack above esp
 363 #sub main'wtmp
 364 #       {
 365 #       my($num)=@_;
 366 #
 367 #       return(&main'DWP(-(($num+1)*4),"esp","",0));
 368 #       }
 369
 370 sub main'comment
 371         {
 372         foreach (@_)
 373                 {
 374                 push(@out,"\t; $_\n");
 375                 }
 376         }
 377
 378 sub main'public_label
 379         {
 380         $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
 381         push(@out,".") if ($main'mwerks);
 382         push(@out,"global\t$label{$_[0]}\n");
 383         }
 384
 385 sub main'label
 386         {
 387         if (!defined($label{$_[0]}))
 388                 {
 389                 $label{$_[0]}="\@${label}${_[0]}";
 390                 $label++;
 391                 }
 392         return($label{$_[0]});
 393         }
 394
 395 sub main'set_label
 396         {
 397         if (!defined($label{$_[0]}))
 398                 {
 399                 $label{$_[0]}="\@${label}${_[0]}";
 400                 $label++;
 401                 }
 402         if ($_[1]!=0 && $_[1]>1)
 403                 {
 404                 main'align($_[1]);
 405                 }
 406         push(@out,"$label{$_[0]}:\n");
 407         }
 408
 409 sub main'data_byte
 410         {
 411         push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n");
 412         }
 413
 414 sub main'data_word
 415         {
 416         push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
 417         }
 418
 419 sub main'align
 420         {
 421         push(@out,".") if ($main'mwerks);
 422         push(@out,"align\t$_[0]\n");
 423         }
 424
 425 sub out1p
 426         {
 427         my($name,$p1)=@_;
 428         my($l,$t);
 429
 430         push(@out,"\t$name\t".&conv($p1)."\n");
 431         }
 432
 433 sub main'picmeup
 434         {
 435         local($dst,$sym)=@_;
 436         &main'lea($dst,&main'DWP($sym));
 437         }
 438
 439 sub main'blindpop { &out1("pop",@_); }
 440
 441 sub main'initseg
 442         {
 443         local($f)=@_;
 444         if ($main'win32)
 445                 {
 446                 local($tmp)=<<___;
 447 segment .CRT\$XCU data
 448 extern  $under$f
 449 DD      $under$f
 450 ___
 451                 push(@out,$tmp);
 452                 }
 453         }
 454
 455 1;