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