1238384Sjkim#!/usr/bin/env perl 2238384Sjkim 3238384Sjkimpackage x86masm; 4238384Sjkim 5238384Sjkim*out=\@::out; 6238384Sjkim 7238384Sjkim$::lbdecor="\$L"; # local label decoration 8238384Sjkim$nmdecor="_"; # external name decoration 9238384Sjkim 10238384Sjkim$initseg=""; 11238384Sjkim$segment=""; 12238384Sjkim 13238384Sjkimsub ::generic 14238384Sjkim{ my ($opcode,@arg)=@_; 15238384Sjkim 16238384Sjkim # fix hexadecimal constants 17238384Sjkim for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; } 18238384Sjkim 19238384Sjkim if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no [] 20238384Sjkim { $opcode="mov"; } 21238384Sjkim elsif ($opcode !~ /movq/) 22238384Sjkim { # fix xmm references 23238384Sjkim $arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[1]=~/\bxmm[0-7]\b/i); 24238384Sjkim $arg[1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i); 25238384Sjkim } 26238384Sjkim 27238384Sjkim &::emit($opcode,@arg); 28238384Sjkim 1; 29238384Sjkim} 30238384Sjkim# 31238384Sjkim# opcodes not covered by ::generic above, mostly inconsistent namings... 32238384Sjkim# 33238384Sjkimsub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } 34238384Sjkimsub ::call_ptr { &::emit("call",@_); } 35238384Sjkimsub ::jmp_ptr { &::emit("jmp",@_); } 36246772Sjkimsub ::lock { &::data_byte(0xf0); } 37238384Sjkim 38238384Sjkimsub get_mem 39238384Sjkim{ my($size,$addr,$reg1,$reg2,$idx)=@_; 40238384Sjkim my($post,$ret); 41238384Sjkim 42238384Sjkim $ret .= "$size PTR " if ($size ne ""); 43238384Sjkim 44238384Sjkim $addr =~ s/^\s+//; 45238384Sjkim # prepend global references with optional underscore 46238384Sjkim $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; 47238384Sjkim # put address arithmetic expression in parenthesis 48238384Sjkim $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); 49238384Sjkim 50238384Sjkim if (($addr ne "") && ($addr ne 0)) 51238384Sjkim { if ($addr !~ /^-/) { $ret .= "$addr"; } 52238384Sjkim else { $post=$addr; } 53238384Sjkim } 54238384Sjkim $ret .= "["; 55238384Sjkim 56238384Sjkim if ($reg2 ne "") 57238384Sjkim { $idx!=0 or $idx=1; 58238384Sjkim $ret .= "$reg2*$idx"; 59238384Sjkim $ret .= "+$reg1" if ($reg1 ne ""); 60238384Sjkim } 61238384Sjkim else 62238384Sjkim { $ret .= "$reg1"; } 63238384Sjkim 64238384Sjkim $ret .= "$post]"; 65238384Sjkim $ret =~ s/\+\]/]/; # in case $addr was the only argument 66238384Sjkim $ret =~ s/\[\s*\]//; 67238384Sjkim 68238384Sjkim $ret; 69238384Sjkim} 70238384Sjkimsub ::BP { &get_mem("BYTE",@_); } 71238384Sjkimsub ::WP { &get_mem("WORD",@_); } 72238384Sjkimsub ::DWP { &get_mem("DWORD",@_); } 73238384Sjkimsub ::QWP { &get_mem("QWORD",@_); } 74238384Sjkimsub ::BC { "@_"; } 75238384Sjkimsub ::DWC { "@_"; } 76238384Sjkim 77238384Sjkimsub ::file 78238384Sjkim{ my $tmp=<<___; 79238384SjkimTITLE $_[0].asm 80238384SjkimIF \@Version LT 800 81238384SjkimECHO MASM version 8.00 or later is strongly recommended. 82238384SjkimENDIF 83238384Sjkim.486 84238384Sjkim.MODEL FLAT 85238384SjkimOPTION DOTNAME 86238384SjkimIF \@Version LT 800 87238384Sjkim.text\$ SEGMENT PAGE 'CODE' 88238384SjkimELSE 89238384Sjkim.text\$ SEGMENT ALIGN(64) 'CODE' 90238384SjkimENDIF 91238384Sjkim___ 92238384Sjkim push(@out,$tmp); 93238384Sjkim $segment = ".text\$"; 94238384Sjkim} 95238384Sjkim 96238384Sjkimsub ::function_begin_B 97238384Sjkim{ my $func=shift; 98238384Sjkim my $global=($func !~ /^_/); 99238384Sjkim my $begin="${::lbdecor}_${func}_begin"; 100238384Sjkim 101238384Sjkim &::LABEL($func,$global?"$begin":"$nmdecor$func"); 102238384Sjkim $func="ALIGN\t16\n".$nmdecor.$func."\tPROC"; 103238384Sjkim 104238384Sjkim if ($global) { $func.=" PUBLIC\n${begin}::\n"; } 105238384Sjkim else { $func.=" PRIVATE\n"; } 106238384Sjkim push(@out,$func); 107238384Sjkim $::stack=4; 108238384Sjkim} 109238384Sjkimsub ::function_end_B 110238384Sjkim{ my $func=shift; 111238384Sjkim 112238384Sjkim push(@out,"$nmdecor$func ENDP\n"); 113238384Sjkim $::stack=0; 114238384Sjkim &::wipe_labels(); 115238384Sjkim} 116238384Sjkim 117238384Sjkimsub ::file_end 118238384Sjkim{ my $xmmheader=<<___; 119238384Sjkim.686 120238384Sjkim.XMM 121238384SjkimIF \@Version LT 800 122238384SjkimXMMWORD STRUCT 16 123238384SjkimDQ 2 dup (?) 124238384SjkimXMMWORD ENDS 125238384SjkimENDIF 126238384Sjkim___ 127238384Sjkim if (grep {/\b[x]?mm[0-7]\b/i} @out) { 128238384Sjkim grep {s/\.[3-7]86/$xmmheader/} @out; 129238384Sjkim } 130238384Sjkim 131238384Sjkim push(@out,"$segment ENDS\n"); 132238384Sjkim 133238384Sjkim if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) 134238384Sjkim { my $comm=<<___; 135238384Sjkim.bss SEGMENT 'BSS' 136238384SjkimCOMM ${nmdecor}OPENSSL_ia32cap_P:QWORD 137238384Sjkim.bss ENDS 138238384Sjkim___ 139238384Sjkim # comment out OPENSSL_ia32cap_P declarations 140238384Sjkim grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; 141238384Sjkim push (@out,$comm); 142238384Sjkim } 143238384Sjkim push (@out,$initseg) if ($initseg); 144238384Sjkim push (@out,"END\n"); 145238384Sjkim} 146238384Sjkim 147238384Sjkimsub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } 148238384Sjkim 149238384Sjkim*::set_label_B = sub 150238384Sjkim{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; 151238384Sjkim 152238384Sjkimsub ::external_label 153238384Sjkim{ foreach(@_) 154238384Sjkim { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } 155238384Sjkim} 156238384Sjkim 157238384Sjkimsub ::public_label 158238384Sjkim{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 159238384Sjkim 160238384Sjkimsub ::data_byte 161238384Sjkim{ push(@out,("DB\t").join(',',@_)."\n"); } 162238384Sjkim 163238384Sjkimsub ::data_short 164238384Sjkim{ push(@out,("DW\t").join(',',@_)."\n"); } 165238384Sjkim 166238384Sjkimsub ::data_word 167238384Sjkim{ push(@out,("DD\t").join(',',@_)."\n"); } 168238384Sjkim 169238384Sjkimsub ::align 170238384Sjkim{ push(@out,"ALIGN\t$_[0]\n"); } 171238384Sjkim 172238384Sjkimsub ::picmeup 173238384Sjkim{ my($dst,$sym)=@_; 174238384Sjkim &::lea($dst,&::DWP($sym)); 175238384Sjkim} 176238384Sjkim 177238384Sjkimsub ::initseg 178238384Sjkim{ my $f=$nmdecor.shift; 179238384Sjkim 180238384Sjkim $initseg.=<<___; 181238384Sjkim.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' 182238384SjkimEXTERN $f:NEAR 183238384SjkimDD $f 184238384Sjkim.CRT\$XCU ENDS 185238384Sjkim___ 186238384Sjkim} 187238384Sjkim 188238384Sjkimsub ::dataseg 189238384Sjkim{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } 190238384Sjkim 191238384Sjkimsub ::safeseh 192238384Sjkim{ my $nm=shift; 193238384Sjkim push(@out,"IF \@Version GE 710\n"); 194238384Sjkim push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n"); 195238384Sjkim push(@out,"ENDIF\n"); 196238384Sjkim} 197238384Sjkim 198238384Sjkim1; 199