1#!/usr/bin/env perl 2 3package x86masm; 4 5*out=\@::out; 6 7$::lbdecor="\$L"; # local label decoration 8$nmdecor="_"; # external name decoration 9 10$initseg=""; 11$segment=""; 12 13sub ::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# 33sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } 34sub ::call_ptr { &::emit("call",@_); } 35sub ::jmp_ptr { &::emit("jmp",@_); } 36sub ::lock { &::data_byte(0xf0); } 37 38sub 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} 70sub ::BP { &get_mem("BYTE",@_); } 71sub ::WP { &get_mem("WORD",@_); } 72sub ::DWP { &get_mem("DWORD",@_); } 73sub ::QWP { &get_mem("QWORD",@_); } 74sub ::BC { "@_"; } 75sub ::DWC { "@_"; } 76 77sub ::file 78{ my $tmp=<<___; 79TITLE $_[0].asm 80IF \@Version LT 800 81ECHO MASM version 8.00 or later is strongly recommended. 82ENDIF 83.486 84.MODEL FLAT 85OPTION DOTNAME 86IF \@Version LT 800 87.text\$ SEGMENT PAGE 'CODE' 88ELSE 89.text\$ SEGMENT ALIGN(64) 'CODE' 90ENDIF 91___ 92 push(@out,$tmp); 93 $segment = ".text\$"; 94} 95 96sub ::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} 109sub ::function_end_B 110{ my $func=shift; 111 112 push(@out,"$nmdecor$func ENDP\n"); 113 $::stack=0; 114 &::wipe_labels(); 115} 116 117sub ::file_end 118{ my $xmmheader=<<___; 119.686 120.XMM 121IF \@Version LT 800 122XMMWORD STRUCT 16 123DQ 2 dup (?) 124XMMWORD ENDS 125ENDIF 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' 136COMM ${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 147sub ::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 152sub ::external_label 153{ foreach(@_) 154 { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } 155} 156 157sub ::public_label 158{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 159 160sub ::data_byte 161{ push(@out,("DB\t").join(',',@_)."\n"); } 162 163sub ::data_short 164{ push(@out,("DW\t").join(',',@_)."\n"); } 165 166sub ::data_word 167{ push(@out,("DD\t").join(',',@_)."\n"); } 168 169sub ::align 170{ push(@out,"ALIGN\t$_[0]\n"); } 171 172sub ::picmeup 173{ my($dst,$sym)=@_; 174 &::lea($dst,&::DWP($sym)); 175} 176 177sub ::initseg 178{ my $f=$nmdecor.shift; 179 180 $initseg.=<<___; 181.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' 182EXTERN $f:NEAR 183DD $f 184.CRT\$XCU ENDS 185___ 186} 187 188sub ::dataseg 189{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } 190 191sub ::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 1981; 199