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