crypto/perlasm/x86mwasm_nw.pl

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