x86masm.pl revision 238384
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",@_); } 36238384Sjkim 37238384Sjkimsub get_mem 38238384Sjkim{ my($size,$addr,$reg1,$reg2,$idx)=@_; 39238384Sjkim my($post,$ret); 40238384Sjkim 41238384Sjkim $ret .= "$size PTR " if ($size ne ""); 42238384Sjkim 43238384Sjkim $addr =~ s/^\s+//; 44238384Sjkim # prepend global references with optional underscore 45238384Sjkim $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; 46238384Sjkim # put address arithmetic expression in parenthesis 47238384Sjkim $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); 48238384Sjkim 49238384Sjkim if (($addr ne "") && ($addr ne 0)) 50238384Sjkim { if ($addr !~ /^-/) { $ret .= "$addr"; } 51238384Sjkim else { $post=$addr; } 52238384Sjkim } 53238384Sjkim $ret .= "["; 54238384Sjkim 55238384Sjkim if ($reg2 ne "") 56238384Sjkim { $idx!=0 or $idx=1; 57238384Sjkim $ret .= "$reg2*$idx"; 58238384Sjkim $ret .= "+$reg1" if ($reg1 ne ""); 59238384Sjkim } 60238384Sjkim else 61238384Sjkim { $ret .= "$reg1"; } 62238384Sjkim 63238384Sjkim $ret .= "$post]"; 64238384Sjkim $ret =~ s/\+\]/]/; # in case $addr was the only argument 65238384Sjkim $ret =~ s/\[\s*\]//; 66238384Sjkim 67238384Sjkim $ret; 68238384Sjkim} 69238384Sjkimsub ::BP { &get_mem("BYTE",@_); } 70238384Sjkimsub ::WP { &get_mem("WORD",@_); } 71238384Sjkimsub ::DWP { &get_mem("DWORD",@_); } 72238384Sjkimsub ::QWP { &get_mem("QWORD",@_); } 73238384Sjkimsub ::BC { "@_"; } 74238384Sjkimsub ::DWC { "@_"; } 75238384Sjkim 76238384Sjkimsub ::file 77238384Sjkim{ my $tmp=<<___; 78238384SjkimTITLE $_[0].asm 79238384SjkimIF \@Version LT 800 80238384SjkimECHO MASM version 8.00 or later is strongly recommended. 81238384SjkimENDIF 82238384Sjkim.486 83238384Sjkim.MODEL FLAT 84238384SjkimOPTION DOTNAME 85238384SjkimIF \@Version LT 800 86238384Sjkim.text\$ SEGMENT PAGE 'CODE' 87238384SjkimELSE 88238384Sjkim.text\$ SEGMENT ALIGN(64) 'CODE' 89238384SjkimENDIF 90238384Sjkim___ 91238384Sjkim push(@out,$tmp); 92238384Sjkim $segment = ".text\$"; 93238384Sjkim} 94238384Sjkim 95238384Sjkimsub ::function_begin_B 96238384Sjkim{ my $func=shift; 97238384Sjkim my $global=($func !~ /^_/); 98238384Sjkim my $begin="${::lbdecor}_${func}_begin"; 99238384Sjkim 100238384Sjkim &::LABEL($func,$global?"$begin":"$nmdecor$func"); 101238384Sjkim $func="ALIGN\t16\n".$nmdecor.$func."\tPROC"; 102238384Sjkim 103238384Sjkim if ($global) { $func.=" PUBLIC\n${begin}::\n"; } 104238384Sjkim else { $func.=" PRIVATE\n"; } 105238384Sjkim push(@out,$func); 106238384Sjkim $::stack=4; 107238384Sjkim} 108238384Sjkimsub ::function_end_B 109238384Sjkim{ my $func=shift; 110238384Sjkim 111238384Sjkim push(@out,"$nmdecor$func ENDP\n"); 112238384Sjkim $::stack=0; 113238384Sjkim &::wipe_labels(); 114238384Sjkim} 115238384Sjkim 116238384Sjkimsub ::file_end 117238384Sjkim{ my $xmmheader=<<___; 118238384Sjkim.686 119238384Sjkim.XMM 120238384SjkimIF \@Version LT 800 121238384SjkimXMMWORD STRUCT 16 122238384SjkimDQ 2 dup (?) 123238384SjkimXMMWORD ENDS 124238384SjkimENDIF 125238384Sjkim___ 126238384Sjkim if (grep {/\b[x]?mm[0-7]\b/i} @out) { 127238384Sjkim grep {s/\.[3-7]86/$xmmheader/} @out; 128238384Sjkim } 129238384Sjkim 130238384Sjkim push(@out,"$segment ENDS\n"); 131238384Sjkim 132238384Sjkim if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) 133238384Sjkim { my $comm=<<___; 134238384Sjkim.bss SEGMENT 'BSS' 135238384SjkimCOMM ${nmdecor}OPENSSL_ia32cap_P:QWORD 136238384Sjkim.bss ENDS 137238384Sjkim___ 138238384Sjkim # comment out OPENSSL_ia32cap_P declarations 139238384Sjkim grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; 140238384Sjkim push (@out,$comm); 141238384Sjkim } 142238384Sjkim push (@out,$initseg) if ($initseg); 143238384Sjkim push (@out,"END\n"); 144238384Sjkim} 145238384Sjkim 146238384Sjkimsub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } 147238384Sjkim 148238384Sjkim*::set_label_B = sub 149238384Sjkim{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; 150238384Sjkim 151238384Sjkimsub ::external_label 152238384Sjkim{ foreach(@_) 153238384Sjkim { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } 154238384Sjkim} 155238384Sjkim 156238384Sjkimsub ::public_label 157238384Sjkim{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 158238384Sjkim 159238384Sjkimsub ::data_byte 160238384Sjkim{ push(@out,("DB\t").join(',',@_)."\n"); } 161238384Sjkim 162238384Sjkimsub ::data_short 163238384Sjkim{ push(@out,("DW\t").join(',',@_)."\n"); } 164238384Sjkim 165238384Sjkimsub ::data_word 166238384Sjkim{ push(@out,("DD\t").join(',',@_)."\n"); } 167238384Sjkim 168238384Sjkimsub ::align 169238384Sjkim{ push(@out,"ALIGN\t$_[0]\n"); } 170238384Sjkim 171238384Sjkimsub ::picmeup 172238384Sjkim{ my($dst,$sym)=@_; 173238384Sjkim &::lea($dst,&::DWP($sym)); 174238384Sjkim} 175238384Sjkim 176238384Sjkimsub ::initseg 177238384Sjkim{ my $f=$nmdecor.shift; 178238384Sjkim 179238384Sjkim $initseg.=<<___; 180238384Sjkim.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' 181238384SjkimEXTERN $f:NEAR 182238384SjkimDD $f 183238384Sjkim.CRT\$XCU ENDS 184238384Sjkim___ 185238384Sjkim} 186238384Sjkim 187238384Sjkimsub ::dataseg 188238384Sjkim{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } 189238384Sjkim 190238384Sjkimsub ::safeseh 191238384Sjkim{ my $nm=shift; 192238384Sjkim push(@out,"IF \@Version GE 710\n"); 193238384Sjkim push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n"); 194238384Sjkim push(@out,"ENDIF\n"); 195238384Sjkim} 196238384Sjkim 197238384Sjkim1; 198