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