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