x86masm.pl 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206
  1. #! /usr/bin/env perl
  2. # Copyright 2007-2016 The OpenSSL Project Authors. All Rights Reserved.
  3. #
  4. # Licensed under the OpenSSL license (the "License"). You may not use
  5. # this file except in compliance with the License. You can obtain a copy
  6. # in the file LICENSE in the source distribution or at
  7. # https://www.openssl.org/source/license.html
  8. package x86masm;
  9. *out=\@::out;
  10. $::lbdecor="\$L"; # local label decoration
  11. $nmdecor="_"; # external name decoration
  12. $initseg="";
  13. $segment="";
  14. sub ::generic
  15. { my ($opcode,@arg)=@_;
  16. # fix hexadecimal constants
  17. for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; }
  18. if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no []
  19. { $opcode="mov"; }
  20. elsif ($opcode !~ /mov[dq]$/)
  21. { # fix xmm references
  22. $arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[-1]=~/\bxmm[0-7]\b/i);
  23. $arg[-1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i);
  24. }
  25. &::emit($opcode,@arg);
  26. 1;
  27. }
  28. #
  29. # opcodes not covered by ::generic above, mostly inconsistent namings...
  30. #
  31. sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
  32. sub ::call_ptr { &::emit("call",@_); }
  33. sub ::jmp_ptr { &::emit("jmp",@_); }
  34. sub ::lock { &::data_byte(0xf0); }
  35. sub get_mem
  36. { my($size,$addr,$reg1,$reg2,$idx)=@_;
  37. my($post,$ret);
  38. if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
  39. $ret .= "$size PTR " if ($size ne "");
  40. $addr =~ s/^\s+//;
  41. # prepend global references with optional underscore
  42. $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige;
  43. # put address arithmetic expression in parenthesis
  44. $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
  45. if (($addr ne "") && ($addr ne 0))
  46. { if ($addr !~ /^-/) { $ret .= "$addr"; }
  47. else { $post=$addr; }
  48. }
  49. $ret .= "[";
  50. if ($reg2 ne "")
  51. { $idx!=0 or $idx=1;
  52. $ret .= "$reg2*$idx";
  53. $ret .= "+$reg1" if ($reg1 ne "");
  54. }
  55. else
  56. { $ret .= "$reg1"; }
  57. $ret .= "$post]";
  58. $ret =~ s/\+\]/]/; # in case $addr was the only argument
  59. $ret =~ s/\[\s*\]//;
  60. $ret;
  61. }
  62. sub ::BP { &get_mem("BYTE",@_); }
  63. sub ::WP { &get_mem("WORD",@_); }
  64. sub ::DWP { &get_mem("DWORD",@_); }
  65. sub ::QWP { &get_mem("QWORD",@_); }
  66. sub ::BC { "@_"; }
  67. sub ::DWC { "@_"; }
  68. sub ::file
  69. { my $tmp=<<___;
  70. IF \@Version LT 800
  71. ECHO MASM version 8.00 or later is strongly recommended.
  72. ENDIF
  73. .686
  74. .MODEL FLAT
  75. OPTION DOTNAME
  76. IF \@Version LT 800
  77. .text\$ SEGMENT PAGE 'CODE'
  78. ELSE
  79. .text\$ SEGMENT ALIGN(64) 'CODE'
  80. ENDIF
  81. ___
  82. push(@out,$tmp);
  83. $segment = ".text\$";
  84. }
  85. sub ::function_begin_B
  86. { my $func=shift;
  87. my $global=($func !~ /^_/);
  88. my $begin="${::lbdecor}_${func}_begin";
  89. &::LABEL($func,$global?"$begin":"$nmdecor$func");
  90. $func="ALIGN\t16\n".$nmdecor.$func."\tPROC";
  91. if ($global) { $func.=" PUBLIC\n${begin}::\n"; }
  92. else { $func.=" PRIVATE\n"; }
  93. push(@out,$func);
  94. $::stack=4;
  95. }
  96. sub ::function_end_B
  97. { my $func=shift;
  98. push(@out,"$nmdecor$func ENDP\n");
  99. $::stack=0;
  100. &::wipe_labels();
  101. }
  102. sub ::file_end
  103. { my $xmmheader=<<___;
  104. .686
  105. .XMM
  106. IF \@Version LT 800
  107. XMMWORD STRUCT 16
  108. DQ 2 dup (?)
  109. XMMWORD ENDS
  110. ENDIF
  111. ___
  112. if (grep {/\b[x]?mm[0-7]\b/i} @out) {
  113. grep {s/\.[3-7]86/$xmmheader/} @out;
  114. }
  115. push(@out,"$segment ENDS\n");
  116. if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
  117. { my $comm=<<___;
  118. .bss SEGMENT 'BSS'
  119. COMM ${nmdecor}OPENSSL_ia32cap_P:DWORD:4
  120. .bss ENDS
  121. ___
  122. # comment out OPENSSL_ia32cap_P declarations
  123. grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
  124. push (@out,$comm);
  125. }
  126. push (@out,$initseg) if ($initseg);
  127. push (@out,"END\n");
  128. }
  129. sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
  130. *::set_label_B = sub
  131. { my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); };
  132. sub ::external_label
  133. { foreach(@_)
  134. { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); }
  135. }
  136. sub ::public_label
  137. { push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
  138. sub ::data_byte
  139. { push(@out,("DB\t").join(',',splice(@_,0,16))."\n") while(@_); }
  140. sub ::data_short
  141. { push(@out,("DW\t").join(',',splice(@_,0,8))."\n") while(@_); }
  142. sub ::data_word
  143. { push(@out,("DD\t").join(',',splice(@_,0,4))."\n") while(@_); }
  144. sub ::align
  145. { push(@out,"ALIGN\t$_[0]\n"); }
  146. sub ::picmeup
  147. { my($dst,$sym)=@_;
  148. &::lea($dst,&::DWP($sym));
  149. }
  150. sub ::initseg
  151. { my $f=$nmdecor.shift;
  152. $initseg.=<<___;
  153. .CRT\$XCU SEGMENT DWORD PUBLIC 'DATA'
  154. EXTERN $f:NEAR
  155. DD $f
  156. .CRT\$XCU ENDS
  157. ___
  158. }
  159. sub ::dataseg
  160. { push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; }
  161. sub ::safeseh
  162. { my $nm=shift;
  163. push(@out,"IF \@Version GE 710\n");
  164. push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n");
  165. push(@out,"ENDIF\n");
  166. }
  167. 1;