1238405Sjkim#!/usr/bin/env perl
255714Skris
355714Skrispackage x86nasm;
455714Skris
5238405Sjkim*out=\@::out;
655714Skris
7238405Sjkim$::lbdecor="L\$";		# local label decoration
8238405Sjkim$nmdecor=$::netware?"":"_";	# external name decoration
9238405Sjkim$drdecor=$::mwerks?".":"";	# directive decoration
1055714Skris
11238405Sjkim$initseg="";
1255714Skris
13238405Sjkimsub ::generic
14238405Sjkim{ my $opcode=shift;
15238405Sjkim  my $tmp;
1655714Skris
17238405Sjkim    if (!$::mwerks)
18238405Sjkim    {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
19238405Sjkim	{   $_[0] = "NEAR $_[0]";   	}
20238405Sjkim	elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
21238405Sjkim	{   $_[1] =~ s/^[^\[]*\[/\[/o;	}
22238405Sjkim	elsif ($opcode eq "clflush" && $#_==0)
23238405Sjkim	{   $_[0] =~ s/^[^\[]*\[/\[/o;	}
24238405Sjkim    }
25238405Sjkim    &::emit($opcode,@_);
26238405Sjkim  1;
2755714Skris}
28238405Sjkim#
29238405Sjkim# opcodes not covered by ::generic above, mostly inconsistent namings...
30238405Sjkim#
31238405Sjkimsub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
32238405Sjkimsub ::call_ptr	{ &::emit("call",@_);	}
33238405Sjkimsub ::jmp_ptr	{ &::emit("jmp",@_);	}
3455714Skris
3555714Skrissub get_mem
36238405Sjkim{ my($size,$addr,$reg1,$reg2,$idx)=@_;
37238405Sjkim  my($post,$ret);
3855714Skris
39238405Sjkim    if ($size ne "")
40238405Sjkim    {	$ret .= "$size";
41238405Sjkim	$ret .= " PTR" if ($::mwerks);
42238405Sjkim	$ret .= " ";
43238405Sjkim    }
44238405Sjkim    $ret .= "[";
45109998Smarkm
46238405Sjkim    $addr =~ s/^\s+//;
47238405Sjkim    # prepend global references with optional underscore
48238405Sjkim    $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
49238405Sjkim    # put address arithmetic expression in parenthesis
50238405Sjkim    $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
5155714Skris
52238405Sjkim    if (($addr ne "") && ($addr ne 0))
53238405Sjkim    {	if ($addr !~ /^-/)	{ $ret .= "$addr+"; }
54238405Sjkim	else			{ $post=$addr;      }
55238405Sjkim    }
5655714Skris
57238405Sjkim    if ($reg2 ne "")
58238405Sjkim    {	$idx!=0 or $idx=1;
59238405Sjkim	$ret .= "$reg2*$idx";
60238405Sjkim	$ret .= "+$reg1" if ($reg1 ne "");
61238405Sjkim    }
62238405Sjkim    else
63238405Sjkim    {	$ret .= "$reg1";   }
6455714Skris
65238405Sjkim    $ret .= "$post]";
66238405Sjkim    $ret =~ s/\+\]/]/; # in case $addr was the only argument
6755714Skris
68238405Sjkim  $ret;
69238405Sjkim}
70238405Sjkimsub ::BP	{ &get_mem("BYTE",@_);  }
71238405Sjkimsub ::DWP	{ &get_mem("DWORD",@_); }
72238405Sjkimsub ::WP	{ &get_mem("WORD",@_);	}
73238405Sjkimsub ::QWP	{ &get_mem("",@_);      }
74238405Sjkimsub ::BC	{ (($::mwerks)?"":"BYTE ")."@_";  }
75238405Sjkimsub ::DWC	{ (($::mwerks)?"":"DWORD ")."@_"; }
76160814Ssimon
77238405Sjkimsub ::file
78238405Sjkim{   if ($::mwerks)	{ push(@out,".section\t.text,64\n"); }
79238405Sjkim    else
80238405Sjkim    { my $tmp=<<___;
81238405Sjkim%ifidn __OUTPUT_FORMAT__,obj
82238405Sjkimsection	code	use32 class=code align=64
83238405Sjkim%elifidn __OUTPUT_FORMAT__,win32
84238405Sjkim\$\@feat.00 equ 1
85238405Sjkimsection	.text	code align=64
86160814Ssimon%else
87238405Sjkimsection	.text	code
88160814Ssimon%endif
89160814Ssimon___
9055714Skris	push(@out,$tmp);
91238405Sjkim    }
92238405Sjkim}
9355714Skris
94238405Sjkimsub ::function_begin_B
95238405Sjkim{ my $func=shift;
96238405Sjkim  my $global=($func !~ /^_/);
97238405Sjkim  my $begin="${::lbdecor}_${func}_begin";
9855714Skris
99238405Sjkim    $begin =~ s/^\@/./ if ($::mwerks);	# the torture never stops
10055714Skris
101238405Sjkim    &::LABEL($func,$global?"$begin":"$nmdecor$func");
102238405Sjkim    $func=$nmdecor.$func;
10355714Skris
104238405Sjkim    push(@out,"${drdecor}global	$func\n")	if ($global);
105238405Sjkim    push(@out,"${drdecor}align	16\n");
106238405Sjkim    push(@out,"$func:\n");
107238405Sjkim    push(@out,"$begin:\n")			if ($global);
108238405Sjkim    $::stack=4;
109238405Sjkim}
11055714Skris
111238405Sjkimsub ::function_end_B
112238405Sjkim{   $::stack=0;
113238405Sjkim    &::wipe_labels();
114238405Sjkim}
11555714Skris
116238405Sjkimsub ::file_end
117238405Sjkim{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
118238405Sjkim    {	my $comm=<<___;
119238405Sjkim${drdecor}segment	.bss
120238405Sjkim${drdecor}common	${nmdecor}OPENSSL_ia32cap_P 8
121238405Sjkim___
122238405Sjkim	# comment out OPENSSL_ia32cap_P declarations
123238405Sjkim	grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
124238405Sjkim	push (@out,$comm)
125238405Sjkim    }
126238405Sjkim    push (@out,$initseg) if ($initseg);
127238405Sjkim}
12855714Skris
129238405Sjkimsub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
13055714Skris
131238405Sjkimsub ::external_label
132238405Sjkim{   foreach(@_)
133238405Sjkim    {	push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n");   }
134238405Sjkim}
13555714Skris
136238405Sjkimsub ::public_label
137238405Sjkim{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
13855714Skris
139238405Sjkimsub ::data_byte
140238405Sjkim{   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");	}
141238405Sjkimsub ::data_short
142238405Sjkim{   push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n");	}
143238405Sjkimsub ::data_word
144238405Sjkim{   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");	}
14555714Skris
146238405Sjkimsub ::align
147238405Sjkim{   push(@out,"${drdecor}align\t$_[0]\n");	}
14855714Skris
149238405Sjkimsub ::picmeup
150238405Sjkim{ my($dst,$sym)=@_;
151238405Sjkim    &::lea($dst,&::DWP($sym));
152238405Sjkim}
15355714Skris
154238405Sjkimsub ::initseg
155238405Sjkim{ my $f=$nmdecor.shift;
156238405Sjkim    if ($::win32)
157238405Sjkim    {	$initseg=<<___;
158238405Sjkimsegment	.CRT\$XCU data align=4
159238405Sjkimextern	$f
160238405Sjkimdd	$f
161238405Sjkim___
162238405Sjkim    }
163238405Sjkim}
164160814Ssimon
165238405Sjkimsub ::dataseg
166238405Sjkim{   if ($mwerks)	{ push(@out,".section\t.data,4\n");   }
167238405Sjkim    else		{ push(@out,"section\t.data align=4\n"); }
168238405Sjkim}
16955714Skris
170238405Sjkimsub ::safeseh
171238405Sjkim{ my $nm=shift;
172238405Sjkim    push(@out,"%if	__NASM_VERSION_ID__ >= 0x02030000\n");
173238405Sjkim    push(@out,"safeseh	".&::LABEL($nm,$nmdecor.$nm)."\n");
174238405Sjkim    push(@out,"%endif\n");
175238405Sjkim}
17655714Skris
177160814Ssimon1;
178