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 sub main'external_label { push(@labels,@_); push(@out, "EXTERN\t$_[0]"); }
  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'stack_push
  55         {
  56         my($num)=@_;
  57         $stack+=$num*4;
  58         &main'sub("esp",$num*4);
  59         }
  60
  61 sub main'stack_pop
  62         {
  63         my($num)=@_;
  64         $stack-=$num*4;
  65         &main'add("esp",$num*4);
  66         }
  67
  68 sub get_mem
  69         {
  70         my($size,$addr,$reg1,$reg2,$idx)=@_;
  71         my($t,$post);
  72         my($ret)="[$size ";
  73         $addr =~ s/^\s+//;
  74         if ($addr =~ /^(.+)\+(.+)$/)
  75                 {
  76                 $reg2=&conv($1);
  77                 $addr="_$2";
  78                 }
  79         elsif ($addr =~ /^[_a-zA-Z]/)
  80                 {
  81                 $addr="_$addr";
  82                 }
  83
  84         $reg1="$regs{$reg1}" if defined($regs{$reg1});
  85         $reg2="$regs{$reg2}" if defined($regs{$reg2});
  86         if (($addr ne "") && ($addr ne 0))
  87                 {
  88                 if ($addr !~ /^-/)
  89                         { $ret.="${addr}+"; }
  90                 else    { $post=$addr; }
  91                 }
  92         if ($reg2 ne "")
  93                 {
  94                 $t="";
  95                 $t="*$idx" if ($idx != 0);
  96                 $reg1="+".$reg1 if ("$reg1$post" ne "");
  97                 $ret.="$reg2$t$reg1$post]";
  98                 }
  99         else
 100                 {
 101                 $ret.="$reg1$post]"
 102                 }
 103         return($ret);
 104         }
 105
 106 sub main'mov    { &out2("mov",@_); }
 107 sub main'movb   { &out2("mov",@_); }
 108 sub main'and    { &out2("and",@_); }
 109 sub main'or     { &out2("or",@_); }
 110 sub main'shl    { &out2("shl",@_); }
 111 sub main'shr    { &out2("shr",@_); }
 112 sub main'xor    { &out2("xor",@_); }
 113 sub main'xorb   { &out2("xor",@_); }
 114 sub main'add    { &out2("add",@_); }
 115 sub main'adc    { &out2("adc",@_); }
 116 sub main'sub    { &out2("sub",@_); }
 117 sub main'rotl   { &out2("rol",@_); }
 118 sub main'rotr   { &out2("ror",@_); }
 119 sub main'exch   { &out2("xchg",@_); }
 120 sub main'cmp    { &out2("cmp",@_); }
 121 sub main'lea    { &out2("lea",@_); }
 122 sub main'mul    { &out1("mul",@_); }
 123 sub main'div    { &out1("div",@_); }
 124 sub main'dec    { &out1("dec",@_); }
 125 sub main'inc    { &out1("inc",@_); }
 126 sub main'jmp    { &out1("jmp",@_); }
 127 sub main'jmp_ptr { &out1p("jmp",@_); }
 128
 129 # This is a bit of a kludge: declare all branches as NEAR.
 130 sub main'je     { &out1("je NEAR",@_); }
 131 sub main'jle    { &out1("jle NEAR",@_); }
 132 sub main'jz     { &out1("jz NEAR",@_); }
 133 sub main'jge    { &out1("jge NEAR",@_); }
 134 sub main'jl     { &out1("jl NEAR",@_); }
 135 sub main'jb     { &out1("jb NEAR",@_); }
 136 sub main'jc     { &out1("jc NEAR",@_); }
 137 sub main'jnc    { &out1("jnc NEAR",@_); }
 138 sub main'jnz    { &out1("jnz NEAR",@_); }
 139 sub main'jne    { &out1("jne NEAR",@_); }
 140 sub main'jno    { &out1("jno NEAR",@_); }
 141
 142 sub main'push   { &out1("push",@_); $stack+=4; }
 143 sub main'pop    { &out1("pop",@_); $stack-=4; }
 144 sub main'bswap  { &out1("bswap",@_); &using486(); }
 145 sub main'not    { &out1("not",@_); }
 146 sub main'call   { &out1("call",'_'.$_[0]); }
 147 sub main'ret    { &out0("ret"); }
 148 sub main'nop    { &out0("nop"); }
 149
 150 sub out2
 151         {
 152         my($name,$p1,$p2)=@_;
 153         my($l,$t);
 154
 155         push(@out,"\t$name\t");
 156         $t=&conv($p1).",";
 157         $l=length($t);
 158         push(@out,$t);
 159         $l=4-($l+9)/8;
 160         push(@out,"\t" x $l);
 161         push(@out,&conv($p2));
 162         push(@out,"\n");
 163         }
 164
 165 sub out0
 166         {
 167         my($name)=@_;
 168
 169         push(@out,"\t$name\n");
 170         }
 171
 172 sub out1
 173         {
 174         my($name,$p1)=@_;
 175         my($l,$t);
 176         push(@out,"\t$name\t".&conv($p1)."\n");
 177         }
 178
 179 sub conv
 180         {
 181         my($p)=@_;
 182         $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
 183         return $p;
 184         }
 185
 186 sub using486
 187         {
 188         return if $using486;
 189         $using486++;
 190         grep(s/\.386/\.486/,@out);
 191         }
 192
 193 sub main'file
 194         {
 195         push(@out, "segment .text");
 196         }
 197
 198 sub main'function_begin
 199         {
 200         my($func,$extra)=@_;
 201
 202         push(@labels,$func);
 203         my($tmp)=<<"EOF";
 204 GLOBAL  _$func
 205 _$func:
 206         push    ebp
 207         push    ebx
 208         push    esi
 209         push    edi
 210 EOF
 211         push(@out,$tmp);
 212         $stack=20;
 213         }
 214
 215 sub main'function_begin_B
 216         {
 217         my($func,$extra)=@_;
 218         my($tmp)=<<"EOF";
 219 GLOBAL  _$func
 220 _$func:
 221 EOF
 222         push(@out,$tmp);
 223         $stack=4;
 224         }
 225
 226 sub main'function_end
 227         {
 228         my($func)=@_;
 229
 230         my($tmp)=<<"EOF";
 231         pop     edi
 232         pop     esi
 233         pop     ebx
 234         pop     ebp
 235         ret
 236 EOF
 237         push(@out,$tmp);
 238         $stack=0;
 239         %label=();
 240         }
 241
 242 sub main'function_end_B
 243         {
 244         $stack=0;
 245         %label=();
 246         }
 247
 248 sub main'function_end_A
 249         {
 250         my($func)=@_;
 251
 252         my($tmp)=<<"EOF";
 253         pop     edi
 254         pop     esi
 255         pop     ebx
 256         pop     ebp
 257         ret
 258 EOF
 259         push(@out,$tmp);
 260         }
 261
 262 sub main'file_end
 263         {
 264         }
 265
 266 sub main'wparam
 267         {
 268         my($num)=@_;
 269
 270         return(&main'DWP($stack+$num*4,"esp","",0));
 271         }
 272
 273 sub main'swtmp
 274         {
 275         return(&main'DWP($_[0]*4,"esp","",0));
 276         }
 277
 278 # Should use swtmp, which is above esp.  Linix can trash the stack above esp
 279 #sub main'wtmp
 280 #       {
 281 #       my($num)=@_;
 282 #
 283 #       return(&main'DWP(-(($num+1)*4),"esp","",0));
 284 #       }
 285
 286 sub main'comment
 287         {
 288         foreach (@_)
 289                 {
 290                 push(@out,"\t; $_\n");
 291                 }
 292         }
 293
 294 sub main'label
 295         {
 296         if (!defined($label{$_[0]}))
 297                 {
 298                 $label{$_[0]}="\$${label}${_[0]}";
 299                 $label++;
 300                 }
 301         return($label{$_[0]});
 302         }
 303
 304 sub main'set_label
 305         {
 306         if (!defined($label{$_[0]}))
 307                 {
 308                 $label{$_[0]}="${label}${_[0]}";
 309                 $label++;
 310                 }
 311         push(@out,"$label{$_[0]}:\n");
 312         }
 313
 314 sub main'data_word
 315         {
 316         push(@out,"\tDD\t$_[0]\n");
 317         }
 318
 319 sub out1p
 320         {
 321         my($name,$p1)=@_;
 322         my($l,$t);
 323
 324         push(@out,"\t$name\t ".&conv($p1)."\n");
 325         }