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'div { &out1("div",@_); } 158sub main'dec { &out1("dec",@_); } 159sub main'inc { &out1("inc",@_); } 160sub main'jmp { &out1("jmp",@_); } 161sub main'jmp_ptr { &out1p("jmp",@_); } 162 163# This is a bit of a kludge: declare all branches as NEAR. 164$near=($main'mwerks)?'':'NEAR'; 165sub main'je { &out1("je $near",@_); } 166sub main'jle { &out1("jle $near",@_); } 167sub main'jz { &out1("jz $near",@_); } 168sub main'jge { &out1("jge $near",@_); } 169sub main'jl { &out1("jl $near",@_); } 170sub main'ja { &out1("ja $near",@_); } 171sub main'jae { &out1("jae $near",@_); } 172sub main'jb { &out1("jb $near",@_); } 173sub main'jbe { &out1("jbe $near",@_); } 174sub main'jc { &out1("jc $near",@_); } 175sub main'jnc { &out1("jnc $near",@_); } 176sub main'jnz { &out1("jnz $near",@_); } 177sub main'jne { &out1("jne $near",@_); } 178sub main'jno { &out1("jno $near",@_); } 179 180sub main'push { &out1("push",@_); $stack+=4; } 181sub main'pop { &out1("pop",@_); $stack-=4; } 182sub main'pushf { &out0("pushfd"); $stack+=4; } 183sub main'popf { &out0("popfd"); $stack-=4; } 184sub main'bswap { &out1("bswap",@_); &using486(); } 185sub main'not { &out1("not",@_); } 186sub main'call { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); } 187sub main'ret { &out0("ret"); } 188sub main'nop { &out0("nop"); } 189sub main'test { &out2("test",@_); } 190sub main'bt { &out2("bt",@_); } 191sub main'leave { &out0("leave"); } 192sub main'cpuid { &out0("cpuid"); } 193sub main'rdtsc { &out0("rdtsc"); } 194sub main'halt { &out0("hlt"); } 195sub main'movz { &out2("movzx",@_); } 196sub main'neg { &out1("neg",@_); } 197sub main'cld { &out0("cld"); } 198 199# SSE2 200sub main'emms { &out0("emms"); } 201sub main'movd { &out2("movd",@_); } 202sub main'movq { &out2("movq",@_); } 203sub main'movdqu { &out2("movdqu",@_); } 204sub main'movdqa { &out2("movdqa",@_); } 205sub main'movdq2q{ &out2("movdq2q",@_); } 206sub main'movq2dq{ &out2("movq2dq",@_); } 207sub main'paddq { &out2("paddq",@_); } 208sub main'pmuludq{ &out2("pmuludq",@_); } 209sub main'psrlq { &out2("psrlq",@_); } 210sub main'psllq { &out2("psllq",@_); } 211sub main'pxor { &out2("pxor",@_); } 212sub main'por { &out2("por",@_); } 213sub main'pand { &out2("pand",@_); } 214 215sub out2 216 { 217 my($name,$p1,$p2)=@_; 218 my($l,$t); 219 220 push(@out,"\t$name\t"); 221 if (!$main'mwerks and $name eq "lea") 222 { 223 $p1 =~ s/^[^\[]*\[/\[/; 224 $p2 =~ s/^[^\[]*\[/\[/; 225 } 226 $t=&conv($p1).","; 227 $l=length($t); 228 push(@out,$t); 229 $l=4-($l+9)/8; 230 push(@out,"\t" x $l); 231 push(@out,&conv($p2)); 232 push(@out,"\n"); 233 } 234 235sub out0 236 { 237 my($name)=@_; 238 239 push(@out,"\t$name\n"); 240 } 241 242sub out1 243 { 244 my($name,$p1)=@_; 245 my($l,$t); 246 push(@out,"\t$name\t".&conv($p1)."\n"); 247 } 248 249sub conv 250 { 251 my($p)=@_; 252 $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; 253 return $p; 254 } 255 256sub using486 257 { 258 return if $using486; 259 $using486++; 260 grep(s/\.386/\.486/,@out); 261 } 262 263sub main'file 264 { 265 if ($main'mwerks) { push(@out,".section\t.text\n"); } 266 else { 267 local $tmp=<<___; 268%ifdef __omf__ 269section code use32 class=code 270%else 271section .text 272%endif 273___ 274 push(@out,$tmp); 275 } 276 } 277 278sub main'function_begin 279 { 280 my($func,$extra)=@_; 281 282 push(@labels,$func); 283 my($tmp)=<<"EOF"; 284global $under$func 285$under$func: 286 push ebp 287 push ebx 288 push esi 289 push edi 290EOF 291 push(@out,$tmp); 292 $stack=20; 293 } 294 295sub main'function_begin_B 296 { 297 my($func,$extra)=@_; 298 my($tmp)=<<"EOF"; 299global $under$func 300$under$func: 301EOF 302 push(@out,$tmp); 303 $stack=4; 304 } 305 306sub main'function_end 307 { 308 my($func)=@_; 309 310 my($tmp)=<<"EOF"; 311 pop edi 312 pop esi 313 pop ebx 314 pop ebp 315 ret 316EOF 317 push(@out,$tmp); 318 $stack=0; 319 %label=(); 320 } 321 322sub main'function_end_B 323 { 324 $stack=0; 325 %label=(); 326 } 327 328sub main'function_end_A 329 { 330 my($func)=@_; 331 332 my($tmp)=<<"EOF"; 333 pop edi 334 pop esi 335 pop ebx 336 pop ebp 337 ret 338EOF 339 push(@out,$tmp); 340 } 341 342sub main'file_end 343 { 344 } 345 346sub main'wparam 347 { 348 my($num)=@_; 349 350 return(&main'DWP($stack+$num*4,"esp","",0)); 351 } 352 353sub main'swtmp 354 { 355 return(&main'DWP($_[0]*4,"esp","",0)); 356 } 357 358# Should use swtmp, which is above esp. Linix can trash the stack above esp 359#sub main'wtmp 360# { 361# my($num)=@_; 362# 363# return(&main'DWP(-(($num+1)*4),"esp","",0)); 364# } 365 366sub main'comment 367 { 368 foreach (@_) 369 { 370 push(@out,"\t; $_\n"); 371 } 372 } 373 374sub main'public_label 375 { 376 $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); 377 push(@out,"global\t$label{$_[0]}\n"); 378 } 379 380sub main'label 381 { 382 if (!defined($label{$_[0]})) 383 { 384 $label{$_[0]}="\@${label}${_[0]}"; 385 $label++; 386 } 387 return($label{$_[0]}); 388 } 389 390sub main'set_label 391 { 392 if (!defined($label{$_[0]})) 393 { 394 $label{$_[0]}="\@${label}${_[0]}"; 395 $label++; 396 } 397 if ($_[1]!=0 && $_[1]>1) 398 { 399 main'align($_[1]); 400 } 401 push(@out,"$label{$_[0]}:\n"); 402 } 403 404sub main'data_word 405 { 406 push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); 407 } 408 409sub main'align 410 { 411 push(@out,".") if ($main'mwerks); 412 push(@out,"align\t$_[0]\n"); 413 } 414 415sub out1p 416 { 417 my($name,$p1)=@_; 418 my($l,$t); 419 420 push(@out,"\t$name\t ".&conv($p1)."\n"); 421 } 422 423sub main'picmeup 424 { 425 local($dst,$sym)=@_; 426 &main'lea($dst,&main'DWP($sym)); 427 } 428 429sub main'blindpop { &out1("pop",@_); } 430 431sub main'initseg 432 { 433 local($f)=@_; 434 if ($main'win32) 435 { 436 local($tmp)=<<___; 437segment .CRT\$XIU data 438extern $under$f 439DD $under$f 440___ 441 push(@out,$tmp); 442 } 443 } 444 4451; 446