xref: /openssl/crypto/perlasm/x86nasm.pl (revision a5d9549d) 
1#! /usr/bin/env perl
2# Copyright 1999-2018 The OpenSSL Project Authors. All Rights Reserved.
3#
4# Licensed under the Apache License 2.0 (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
10package x86nasm;
11
12*out=\@::out;
13
14$::lbdecor="L\$";		# local label decoration
15$nmdecor="_";			# external name decoration
16$drdecor=$::mwerks?".":"";	# directive decoration
17
18$initseg="";
19
20sub ::generic
21{ my $opcode=shift;
22  my $tmp;
23
24    if (!$::mwerks)
25    {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
26	{   $_[0] = "NEAR $_[0]";   	}
27	elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
28	{   $_[1] =~ s/^[^\[]*\[/\[/o;	}
29	elsif ($opcode eq "clflush" && $#_==0)
30	{   $_[0] =~ s/^[^\[]*\[/\[/o;	}
31    }
32    &::emit($opcode,@_);
33  1;
34}
35#
36# opcodes not covered by ::generic above, mostly inconsistent namings...
37#
38sub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
39sub ::call_ptr	{ &::emit("call",@_);	}
40sub ::jmp_ptr	{ &::emit("jmp",@_);	}
41
42sub get_mem
43{ my($size,$addr,$reg1,$reg2,$idx)=@_;
44  my($post,$ret);
45
46    if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
47
48    if ($size ne "")
49    {	$ret .= "$size";
50	$ret .= " PTR" if ($::mwerks);
51	$ret .= " ";
52    }
53    $ret .= "[";
54
55    $addr =~ s/^\s+//;
56    # prepend global references with optional underscore
57    $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
58    # put address arithmetic expression in parenthesis
59    $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
60
61    if (($addr ne "") && ($addr ne 0))
62    {	if ($addr !~ /^-/)	{ $ret .= "$addr+"; }
63	else			{ $post=$addr;      }
64    }
65
66    if ($reg2 ne "")
67    {	$idx!=0 or $idx=1;
68	$ret .= "$reg2*$idx";
69	$ret .= "+$reg1" if ($reg1 ne "");
70    }
71    else
72    {	$ret .= "$reg1";   }
73
74    $ret .= "$post]";
75    $ret =~ s/\+\]/]/; # in case $addr was the only argument
76
77  $ret;
78}
79sub ::BP	{ &get_mem("BYTE",@_);  }
80sub ::DWP	{ &get_mem("DWORD",@_); }
81sub ::WP	{ &get_mem("WORD",@_);	}
82sub ::QWP	{ &get_mem("",@_);      }
83sub ::BC	{ (($::mwerks)?"":"BYTE ")."@_";  }
84sub ::DWC	{ (($::mwerks)?"":"DWORD ")."@_"; }
85
86sub ::file
87{   if ($::mwerks)	{ push(@out,".section\t.text,64\n"); }
88    else
89    { my $tmp=<<___;
90%ifidn __OUTPUT_FORMAT__,obj
91section	code	use32 class=code align=64
92%elifidn __OUTPUT_FORMAT__,win32
93\$\@feat.00 equ 1
94section	.text	code align=64
95%else
96section	.text	code
97%endif
98___
99	push(@out,$tmp);
100    }
101}
102
103sub ::function_begin_B
104{ my $func=shift;
105  my $global=($func !~ /^_/);
106  my $begin="${::lbdecor}_${func}_begin";
107
108    $begin =~ s/^\@/./ if ($::mwerks);	# the torture never stops
109
110    &::LABEL($func,$global?"$begin":"$nmdecor$func");
111    $func=$nmdecor.$func;
112
113    push(@out,"${drdecor}global	$func\n")	if ($global);
114    push(@out,"${drdecor}align	16\n");
115    push(@out,"$func:\n");
116    push(@out,"$begin:\n")			if ($global);
117    $::stack=4;
118}
119
120sub ::function_end_B
121{   $::stack=0;
122    &::wipe_labels();
123}
124
125sub ::file_end
126{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
127    {	my $comm=<<___;
128${drdecor}segment	.bss
129${drdecor}common	${nmdecor}OPENSSL_ia32cap_P 16
130___
131	# comment out OPENSSL_ia32cap_P declarations
132	grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
133	push (@out,$comm)
134    }
135    push (@out,$initseg) if ($initseg);
136}
137
138sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
139
140sub ::external_label
141{   foreach(@_)
142    {	push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n");   }
143}
144
145sub ::public_label
146{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
147
148sub ::data_byte
149{   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");	}
150sub ::data_short
151{   push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n");	}
152sub ::data_word
153{   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");	}
154
155sub ::align
156{   push(@out,"${drdecor}align\t$_[0]\n");	}
157
158sub ::picmeup
159{ my($dst,$sym)=@_;
160    &::lea($dst,&::DWP($sym));
161}
162
163sub ::initseg
164{ my $f=$nmdecor.shift;
165    if ($::win32)
166    {	$initseg=<<___;
167segment	.CRT\$XCU data align=4
168extern	$f
169dd	$f
170___
171    }
172}
173
174sub ::dataseg
175{   if ($mwerks)	{ push(@out,".section\t.data,4\n");   }
176    else		{ push(@out,"section\t.data align=4\n"); }
177}
178
179sub ::safeseh
180{ my $nm=shift;
181    push(@out,"%if	__NASM_VERSION_ID__ >= 0x02030000\n");
182    push(@out,"safeseh	".&::LABEL($nm,$nmdecor.$nm)."\n");
183    push(@out,"%endif\n");
184}
185
1861;
187