crypto/perlasm/x86ms.pl

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