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\$\@feat.00 equ 1
87section	.text	code align=64
88%else
89section	.text	code
90%endif
91___
92	push(@out,$tmp);
93    }
94}
95
96sub ::function_begin_B
97{ my $func=shift;
98  my $global=($func !~ /^_/);
99  my $begin="${::lbdecor}_${func}_begin";
100
101    $begin =~ s/^\@/./ if ($::mwerks);	# the torture never stops
102
103    &::LABEL($func,$global?"$begin":"$nmdecor$func");
104    $func=$nmdecor.$func;
105
106    push(@out,"${drdecor}global	$func\n")	if ($global);
107    push(@out,"${drdecor}align	16\n");
108    push(@out,"$func:\n");
109    push(@out,"$begin:\n")			if ($global);
110    $::stack=4;
111}
112
113sub ::function_end_B
114{   $::stack=0;
115    &::wipe_labels();
116}
117
118sub ::file_end
119{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
120    {	my $comm=<<___;
121${drdecor}segment	.bss
122${drdecor}common	${nmdecor}OPENSSL_ia32cap_P 16
123___
124	# comment out OPENSSL_ia32cap_P declarations
125	grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
126	push (@out,$comm)
127    }
128    push (@out,$initseg) if ($initseg);
129}
130
131sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
132
133sub ::external_label
134{   foreach(@_)
135    {	push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n");   }
136}
137
138sub ::public_label
139{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
140
141sub ::data_byte
142{   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");	}
143sub ::data_short
144{   push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n");	}
145sub ::data_word
146{   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");	}
147
148sub ::align
149{   push(@out,"${drdecor}align\t$_[0]\n");	}
150
151sub ::picmeup
152{ my($dst,$sym)=@_;
153    &::lea($dst,&::DWP($sym));
154}
155
156sub ::initseg
157{ my $f=$nmdecor.shift;
158    if ($::win32)
159    {	$initseg=<<___;
160segment	.CRT\$XCU data align=4
161extern	$f
162dd	$f
163___
164    }
165}
166
167sub ::dataseg
168{   if ($mwerks)	{ push(@out,".section\t.data,4\n");   }
169    else		{ push(@out,"section\t.data align=4\n"); }
170}
171
172sub ::safeseh
173{ my $nm=shift;
174    push(@out,"%if	__NASM_VERSION_ID__ >= 0x02030000\n");
175    push(@out,"safeseh	".&::LABEL($nm,$nmdecor.$nm)."\n");
176    push(@out,"%endif\n");
177}
178
1791;
180