x86nasm.pl 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177
  1. #!/usr/bin/env perl
  2. package x86nasm;
  3. *out=\@::out;
  4. $::lbdecor="L\$"; # local label decoration
  5. $nmdecor=$::netware?"":"_"; # external name decoration
  6. $drdecor=$::mwerks?".":""; # directive decoration
  7. $initseg="";
  8. sub ::generic
  9. { my $opcode=shift;
  10. my $tmp;
  11. if (!$::mwerks)
  12. { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps
  13. { $_[0] = "NEAR $_[0]"; }
  14. elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea
  15. { $_[1] =~ s/^[^\[]*\[/\[/o; }
  16. elsif ($opcode eq "clflush" && $#_==0)
  17. { $_[0] =~ s/^[^\[]*\[/\[/o; }
  18. }
  19. &::emit($opcode,@_);
  20. 1;
  21. }
  22. #
  23. # opcodes not covered by ::generic above, mostly inconsistent namings...
  24. #
  25. sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
  26. sub ::call_ptr { &::emit("call",@_); }
  27. sub ::jmp_ptr { &::emit("jmp",@_); }
  28. sub get_mem
  29. { my($size,$addr,$reg1,$reg2,$idx)=@_;
  30. my($post,$ret);
  31. if ($size ne "")
  32. { $ret .= "$size";
  33. $ret .= " PTR" if ($::mwerks);
  34. $ret .= " ";
  35. }
  36. $ret .= "[";
  37. $addr =~ s/^\s+//;
  38. # prepend global references with optional underscore
  39. $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
  40. # put address arithmetic expression in parenthesis
  41. $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
  42. if (($addr ne "") && ($addr ne 0))
  43. { if ($addr !~ /^-/) { $ret .= "$addr+"; }
  44. else { $post=$addr; }
  45. }
  46. if ($reg2 ne "")
  47. { $idx!=0 or $idx=1;
  48. $ret .= "$reg2*$idx";
  49. $ret .= "+$reg1" if ($reg1 ne "");
  50. }
  51. else
  52. { $ret .= "$reg1"; }
  53. $ret .= "$post]";
  54. $ret =~ s/\+\]/]/; # in case $addr was the only argument
  55. $ret;
  56. }
  57. sub ::BP { &get_mem("BYTE",@_); }
  58. sub ::DWP { &get_mem("DWORD",@_); }
  59. sub ::WP { &get_mem("WORD",@_); }
  60. sub ::QWP { &get_mem("",@_); }
  61. sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; }
  62. sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; }
  63. sub ::file
  64. { if ($::mwerks) { push(@out,".section\t.text,64\n"); }
  65. else
  66. { my $tmp=<<___;
  67. %ifidn __OUTPUT_FORMAT__,obj
  68. section code use32 class=code align=64
  69. %elifidn __OUTPUT_FORMAT__,win32
  70. \$\@feat.00 equ 1
  71. section .text code align=64
  72. %else
  73. section .text code
  74. %endif
  75. ___
  76. push(@out,$tmp);
  77. }
  78. }
  79. sub ::function_begin_B
  80. { my $func=shift;
  81. my $global=($func !~ /^_/);
  82. my $begin="${::lbdecor}_${func}_begin";
  83. $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops
  84. &::LABEL($func,$global?"$begin":"$nmdecor$func");
  85. $func=$nmdecor.$func;
  86. push(@out,"${drdecor}global $func\n") if ($global);
  87. push(@out,"${drdecor}align 16\n");
  88. push(@out,"$func:\n");
  89. push(@out,"$begin:\n") if ($global);
  90. $::stack=4;
  91. }
  92. sub ::function_end_B
  93. { $::stack=0;
  94. &::wipe_labels();
  95. }
  96. sub ::file_end
  97. { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
  98. { my $comm=<<___;
  99. ${drdecor}segment .bss
  100. ${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 8
  101. ___
  102. # comment out OPENSSL_ia32cap_P declarations
  103. grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
  104. push (@out,$comm)
  105. }
  106. push (@out,$initseg) if ($initseg);
  107. }
  108. sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
  109. sub ::external_label
  110. { foreach(@_)
  111. { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); }
  112. }
  113. sub ::public_label
  114. { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
  115. sub ::data_byte
  116. { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); }
  117. sub ::data_short
  118. { push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n"); }
  119. sub ::data_word
  120. { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); }
  121. sub ::align
  122. { push(@out,"${drdecor}align\t$_[0]\n"); }
  123. sub ::picmeup
  124. { my($dst,$sym)=@_;
  125. &::lea($dst,&::DWP($sym));
  126. }
  127. sub ::initseg
  128. { my $f=$nmdecor.shift;
  129. if ($::win32)
  130. { $initseg=<<___;
  131. segment .CRT\$XCU data align=4
  132. extern $f
  133. dd $f
  134. ___
  135. }
  136. }
  137. sub ::dataseg
  138. { if ($mwerks) { push(@out,".section\t.data,4\n"); }
  139. else { push(@out,"section\t.data align=4\n"); }
  140. }
  141. sub ::safeseh
  142. { my $nm=shift;
  143. push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n");
  144. push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n");
  145. push(@out,"%endif\n");
  146. }
  147. 1;