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