crypto/perlasm/x86nasm.pl

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