crypto/perlasm/x86nasm_nw.pl

   1 #!/usr/local/bin/perl
   2
   3 # x86 nasm 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 NASM assembler (nasmw)");
  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 "BYTE @_";
  72         }
  73
  74 sub main'DWC
  75         {
  76         return "DWORD @_";
  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)="[";
  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 # This is a bit of a kludge: declare all branches as NEAR.
 158 sub main'je     { &out1("je NEAR",@_); }
 159 sub main'jle    { &out1("jle NEAR",@_); }
 160 sub main'jz     { &out1("jz NEAR",@_); }
 161 sub main'jge    { &out1("jge NEAR",@_); }
 162 sub main'jl     { &out1("jl NEAR",@_); }
 163 sub main'ja     { &out1("ja NEAR",@_); }
 164 sub main'jae    { &out1("jae NEAR",@_); }
 165 sub main'jb     { &out1("jb NEAR",@_); }
 166 sub main'jbe    { &out1("jbe NEAR",@_); }
 167 sub main'jc     { &out1("jc NEAR",@_); }
 168 sub main'jnc    { &out1("jnc NEAR",@_); }
 169 sub main'jnz    { &out1("jnz NEAR",@_); }
 170 sub main'jne    { &out1("jne NEAR",@_); }
 171 sub main'jno    { &out1("jno NEAR",@_); }
 172
 173 sub main'push   { &out1("push",@_); $stack+=4; }
 174 sub main'pop    { &out1("pop",@_); $stack-=4; }
 175 sub main'bswap  { &out1("bswap",@_); &using486(); }
 176 sub main'not    { &out1("not",@_); }
 177 sub main'call   { &out1("call",$_[0]); }
 178 sub main'ret    { &out0("ret"); }
 179 sub main'nop    { &out0("nop"); }
 180
 181 sub out2
 182         {
 183         my($name,$p1,$p2)=@_;
 184         my($l,$t);
 185
 186         push(@out,"\t$name\t");
 187         $t=&conv($p1).",";
 188         $l=length($t);
 189         push(@out,$t);
 190         $l=4-($l+9)/8;
 191         push(@out,"\t" x $l);
 192         push(@out,&conv($p2));
 193         push(@out,"\n");
 194         }
 195
 196 sub out0
 197         {
 198         my($name)=@_;
 199
 200         push(@out,"\t$name\n");
 201         }
 202
 203 sub out1
 204         {
 205         my($name,$p1)=@_;
 206         my($l,$t);
 207         push(@out,"\t$name\t".&conv($p1)."\n");
 208         }
 209
 210 sub conv
 211         {
 212         my($p)=@_;
 213         $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
 214         return $p;
 215         }
 216
 217 sub using486
 218         {
 219         return if $using486;
 220         $using486++;
 221         grep(s/\.386/\.486/,@out);
 222         }
 223
 224 sub main'file
 225         {
 226         push(@out, "segment .text\n");
 227         }
 228
 229 sub main'function_begin
 230         {
 231         my($func,$extra)=@_;
 232
 233         push(@labels,$func);
 234         my($tmp)=<<"EOF";
 235 global  $func
 236 $func:
 237         push    ebp
 238         push    ebx
 239         push    esi
 240         push    edi
 241 EOF
 242         push(@out,$tmp);
 243         $stack=20;
 244         }
 245
 246 sub main'function_begin_B
 247         {
 248         my($func,$extra)=@_;
 249         my($tmp)=<<"EOF";
 250 global  $func
 251 $func:
 252 EOF
 253         push(@out,$tmp);
 254         $stack=4;
 255         }
 256
 257 sub main'function_end
 258         {
 259         my($func)=@_;
 260
 261         my($tmp)=<<"EOF";
 262         pop     edi
 263         pop     esi
 264         pop     ebx
 265         pop     ebp
 266         ret
 267 EOF
 268         push(@out,$tmp);
 269         $stack=0;
 270         %label=();
 271         }
 272
 273 sub main'function_end_B
 274         {
 275         $stack=0;
 276         %label=();
 277         }
 278
 279 sub main'function_end_A
 280         {
 281         my($func)=@_;
 282
 283         my($tmp)=<<"EOF";
 284         pop     edi
 285         pop     esi
 286         pop     ebx
 287         pop     ebp
 288         ret
 289 EOF
 290         push(@out,$tmp);
 291         }
 292
 293 sub main'file_end
 294         {
 295         }
 296
 297 sub main'wparam
 298         {
 299         my($num)=@_;
 300
 301         return(&main'DWP($stack+$num*4,"esp","",0));
 302         }
 303
 304 sub main'swtmp
 305         {
 306         return(&main'DWP($_[0]*4,"esp","",0));
 307         }
 308
 309 # Should use swtmp, which is above esp.  Linix can trash the stack above esp
 310 #sub main'wtmp
 311 #       {
 312 #       my($num)=@_;
 313 #
 314 #       return(&main'DWP(-(($num+1)*4),"esp","",0));
 315 #       }
 316
 317 sub main'comment
 318         {
 319         foreach (@_)
 320                 {
 321                 push(@out,"\t; $_\n");
 322                 }
 323         }
 324
 325 sub main'label
 326         {
 327         if (!defined($label{$_[0]}))
 328                 {
 329                 $label{$_[0]}="\$${label}${_[0]}";
 330                 $label++;
 331                 }
 332         return($label{$_[0]});
 333         }
 334
 335 sub main'set_label
 336         {
 337         if (!defined($label{$_[0]}))
 338                 {
 339                 $label{$_[0]}="${label}${_[0]}";
 340                 $label++;
 341                 }
 342         push(@out,"$label{$_[0]}:\n");
 343         }
 344
 345 sub main'data_word
 346         {
 347         push(@out,"\tDD\t$_[0]\n");
 348         }
 349
 350 sub out1p
 351         {
 352         my($name,$p1)=@_;
 353         my($l,$t);
 354
 355         push(@out,"\t$name\t ".&conv($p1)."\n");
 356         }
 357
 358 sub main'picmeup
 359         {
 360         local($dst,$sym)=@_;
 361         &main'lea($dst,&main'DWP($sym));
 362         }
 363
 364 sub main'blindpop { &out1("pop",@_); }