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