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; 199
