Remove x86ms.pl and reimplement x86*.pl.

4 files changed, 587 insertions, 1747 deletions

diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl
index 8438824a23..24f21e17ee 100644
--- a/crypto/perlasm/x86asm.pl
+++ b/crypto/perlasm/x86asm.pl
@@ -1,130 +1,141 @@
-#!/usr/local/bin/perl
+#!/usr/bin/env perl
 
 # require 'x86asm.pl';
-# &asm_init("cpp","des-586.pl");
-# XXX
-# XXX
-# main'asm_finish
-
-sub main'asm_finish
-	{
-	&file_end();
-	&asm_finish_cpp() if $cpp;
-	print &asm_get_output();
-	}
-
-sub main'asm_init
-	{
-	($type,$fn,$i386)=@_;
-	$filename=$fn;
-
-	$elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;
-	if (	($type eq "elf"))
-		{ $elf=1; require "x86unix.pl"; }
-	elsif (	($type eq "a.out"))
-		{ $aout=1; require "x86unix.pl"; }
-	elsif (	($type eq "coff" or $type eq "gaswin"))
-		{ $coff=1; require "x86unix.pl"; }
-	elsif (	($type eq "cpp"))
-		{ $cpp=1; require "x86unix.pl"; }
-	elsif (	($type eq "win32"))
-		{ $win32=1; require "x86ms.pl"; }
-	elsif (	($type eq "win32n"))
-		{ $win32=1; require "x86nasm.pl"; }
-	elsif (	($type eq "nw-nasm"))
-		{ $netware=1; require "x86nasm.pl"; }
-	elsif (	($type eq "nw-mwasm"))
-		{ $netware=1; $mwerks=1; require "x86nasm.pl"; }
-	else
-		{
-		print STDERR <<"EOF";
+# &asm_init(<flavor>,"des-586.pl"[,$i386only]);
+# &function_begin("foo");
+# ...
+# &function_end("foo");
+# &asm_finish
+
+# AUTOLOAD is this context has quite unpleasant side effect, namely
+# that typos in function calls effectively go to assembler output,
+# but on the pros side we don't have to implement one subroutine per
+# each opcode...
+sub ::AUTOLOAD
+{ my $opcode = $AUTOLOAD;
+
+    die "more than 2 arguments passed to $opcode" if ($#_>1);
+
+    $opcode =~ s/.*:://;
+    if    ($opcode =~ /^push/) { $stack+=4; }
+    elsif ($opcode =~ /^pop/)  { $stack-=4; }
+
+    &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
+}
+
+$out=();
+$i386=0;
+
+sub ::emit
+{ my $opcode=shift;
+
+    if ($#_==-1)    { push(@out,"\t$opcode\n");				}
+    else            { push(@out,"\t$opcode\t".join(',',@_)."\n");	}
+}
+
+sub ::LB
+{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
+  $1."l";
+}
+sub ::HB
+{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
+  $1."h";
+}
+sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num);	}
+sub ::stack_pop	{ my $num=$_[0]*4; $stack-=$num; &add("esp",$num);	}
+sub ::blindpop	{ &pop($_[0]); $stack+=4;				}
+sub ::wparam	{ &DWP($stack+4*$_[0],"esp");				}
+sub ::swtmp	{ &DWP(4*$_[0],"esp");					}
+
+sub ::bswap
+{   if ($i386)	# emulate bswap for i386
+    {	&comment("bswap @_");
+	&xchg(&HB(@_),&LB(@_));
+	&ror (@_,16);
+	&xchg(&HB(@_),&LB(@_));
+    }
+    else
+    {	&generic("bswap",@_);	}
+}
+# These are made-up opcodes introduced over the years essentially
+# by ignorance, just alias them to real ones...
+sub ::movb	{ &mov(@_);	}
+sub ::xorb	{ &xor(@_);	}
+sub ::rotl	{ &rol(@_);	}
+sub ::rotr	{ &ror(@_);	}
+sub ::exch	{ &xchg(@_);	}
+sub ::halt	{ &hlt;		}
+
+sub ::function_begin
+{   &function_begin_B(@_);
+    $stack=4;
+    &push("ebp");
+    &push("ebx");
+    &push("esi");
+    &push("edi");
+}
+
+sub ::function_end
+{   &pop("edi");
+    &pop("esi");
+    &pop("ebx");
+    &pop("ebp");
+    &ret();
+    $stack=0;
+    &function_end_B(@_);
+}
+
+sub ::function_end_A
+{   &pop("edi");
+    &pop("esi");
+    &pop("ebx");
+    &pop("ebp");
+    &ret();
+    $stack+=16;	# readjust esp as if we didn't pop anything
+}
+
+sub ::asm_finish
+{   &file_end();
+    print @out;
+}
+
+sub ::asm_init
+{ my ($type,$fn,$cpu)=@_;
+
+    $filename=$fn;
+    $i386=$cpu;
+
+    $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;
+    if    (($type eq "elf"))
+    {	$elf=1;			require "x86unix.pl";	}
+    elsif (($type eq "a\.out"))
+    {	$aout=1;		require "x86unix.pl";	}
+    elsif (($type eq "coff" or $type eq "gaswin"))
+    {	$coff=1;		require "x86unix.pl";	}
+    elsif (($type eq "win32n"))
+    {	$win32=1;		require "x86nasm.pl";	}
+    elsif (($type eq "nw-nasm"))
+    {	$netware=1;		require "x86nasm.pl";	}
+    elsif (($type eq "nw-mwasm"))
+    {	$netware=1; $mwerks=1;	require "x86nasm.pl";	}
+    else
+    {	print STDERR <<"EOF";
 Pick one target type from
 	elf	- Linux, FreeBSD, Solaris x86, etc.
-	a.out	- OpenBSD, DJGPP, etc.
+	a.out	- DJGPP, elder OpenBSD, etc.
 	coff	- GAS/COFF such as Win32 targets
-	win32	- Windows 95/Windows NT
 	win32n	- Windows 95/Windows NT NASM format
 	nw-nasm - NetWare NASM format
 	nw-mwasm- NetWare Metrowerks Assembler
 EOF
-		exit(1);
-		}
-
-	$pic=0;
-	for (@ARGV) {	$pic=1 if (/\-[fK]PIC/i);	}
-
-	&asm_init_output();
-
-&comment("Don't even think of reading this code");
-&comment("It was automatically generated by $filename");
-&comment("Which is a perl program used to generate the x86 assember for");
-&comment("any of ELF, a.out, COFF, Win32, ...");
-&comment("eric <eay\@cryptsoft.com>");
-&comment("");
-
-	$filename =~ s/\.pl$//;
-	&file($filename);
-	}
-
-sub asm_finish_cpp
-	{
-	return unless $cpp;
-
-	local($tmp,$i);
-	foreach $i (&get_labels())
-		{
-		$tmp.="#define $i _$i\n";
-		}
-	print <<"EOF";
-/* Run the C pre-processor over this file with one of the following defined
- * ELF - elf object files,
- * OUT - a.out object files,
- * BSDI - BSDI style a.out object files
- * SOL - Solaris style elf
- */
-
-#define TYPE(a,b)       .type   a,b
-#define SIZE(a,b)       .size   a,b
-
-#if defined(OUT) || (defined(BSDI) && !defined(ELF))
-$tmp
-#endif
-
-#ifdef OUT
-#define OK	1
-#define ALIGN	4
-#if defined(__CYGWIN__) || defined(__DJGPP__) || defined(__MINGW32__)
-#undef SIZE
-#undef TYPE
-#define SIZE(a,b)
-#define TYPE(a,b)	.def a; .scl 2; .type 32; .endef
-#endif /* __CYGWIN || __DJGPP */
-#endif
-
-#if defined(BSDI) && !defined(ELF)
-#define OK              1
-#define ALIGN           4
-#undef SIZE
-#undef TYPE
-#define SIZE(a,b)
-#define TYPE(a,b)
-#endif
-
-#if defined(ELF) || defined(SOL)
-#define OK              1
-#define ALIGN           16
-#endif
-
-#ifndef OK
-You need to define one of
-ELF - elf systems - linux-elf, NetBSD and DG-UX
-OUT - a.out systems - linux-a.out and FreeBSD
-SOL - solaris systems, which are elf with strange comment lines
-BSDI - a.out with a very primative version of as.
-#endif
-
-/* Let the Assembler begin :-) */
-EOF
-	}
+	exit(1);
+    }
+
+    $pic=0;
+    for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
+
+    $filename =~ s/\.pl$//;
+    &file($filename);
+}
 
 1;
diff --git a/crypto/perlasm/x86ms.pl b/crypto/perlasm/x86ms.pl
deleted file mode 100644
index 82538a9a9a..0000000000
--- a/crypto/perlasm/x86ms.pl
+++ /dev/null
@@ -1,464 +0,0 @@
-#!/usr/local/bin/perl
-
-package x86ms;
-
-$label="L000";
-
-%lb=(	'eax',	'al',
-	'ebx',	'bl',
-	'ecx',	'cl',
-	'edx',	'dl',
-	'ax',	'al',
-	'bx',	'bl',
-	'cx',	'cl',
-	'dx',	'dl',
-	);
-
-%hb=(	'eax',	'ah',
-	'ebx',	'bh',
-	'ecx',	'ch',
-	'edx',	'dh',
-	'ax',	'ah',
-	'bx',	'bh',
-	'cx',	'ch',
-	'dx',	'dh',
-	);
-
-sub main'asm_init_output { @out=(); }
-sub main'asm_get_output { return(@out); }
-sub main'get_labels { return(@labels); }
-sub main'external_label
-{
-	push(@labels,@_);
-	foreach (@_) {
-		push(@out, "EXTRN\t_$_:DWORD\n");
-	}
-}
-
-sub main'LB
-	{
-	(defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
-	return($lb{$_[0]});
-	}
-
-sub main'HB
-	{
-	(defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
-	return($hb{$_[0]});
-	}
-
-sub main'BP
-	{
-	&get_mem("BYTE",@_);
-	}
-
-sub main'DWP
-	{
-	&get_mem("DWORD",@_);
-	}
-
-sub main'QWP
-	{
-	&get_mem("QWORD",@_);
-	}
-
-sub main'BC
-	{
-	return @_;
-	}
-
-sub main'DWC
-	{
-	return @_;
-	}
-
-sub main'stack_push
-	{
-	local($num)=@_;
-	$stack+=$num*4;
-	&main'sub("esp",$num*4);
-	}
-
-sub main'stack_pop
-	{
-	local($num)=@_;
-	$stack-=$num*4;
-	&main'add("esp",$num*4);
-	}
-
-sub get_mem
-	{
-	local($size,$addr,$reg1,$reg2,$idx)=@_;
-	local($t,$post);
-	local($ret)="$size PTR ";
-
-	$addr =~ s/^\s+//;
-	if ($addr =~ /^(.+)\+(.+)$/)
-		{
-		$reg2=&conv($1);
-		$addr="_$2";
-		}
-	elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
-		{
-		$addr="_$addr";
-		}
-
-	if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
-
-	$reg1="$regs{$reg1}" if defined($regs{$reg1});
-	$reg2="$regs{$reg2}" if defined($regs{$reg2});
-	if (($addr ne "") && ($addr ne 0))
-		{
-		if ($addr !~ /^-/)
-			{ $ret.=$addr; }
-		else	{ $post=$addr; }
-		}
-	if ($reg2 ne "")
-		{
-		$t="";
-		$t="*$idx" if ($idx != 0);
-		$reg1="+".$reg1 if ("$reg1$post" ne "");
-		$ret.="[$reg2$t$reg1$post]";
-		}
-	else
-		{
-		$ret.="[$reg1$post]"
-		}
-	$ret =~ s/\[\]//;	# in case $addr was the only argument
-	return($ret);
-	}
-
-sub main'mov	{ &out2("mov",@_); }
-sub main'movb	{ &out2("mov",@_); }
-sub main'and	{ &out2("and",@_); }
-sub main'or	{ &out2("or",@_); }
-sub main'shl	{ &out2("shl",@_); }
-sub main'shr	{ &out2("shr",@_); }
-sub main'xor	{ &out2("xor",@_); }
-sub main'xorb	{ &out2("xor",@_); }
-sub main'add	{ &out2("add",@_); }
-sub main'adc	{ &out2("adc",@_); }
-sub main'sub	{ &out2("sub",@_); }
-sub main'sbb	{ &out2("sbb",@_); }
-sub main'rotl	{ &out2("rol",@_); }
-sub main'rotr	{ &out2("ror",@_); }
-sub main'exch	{ &out2("xchg",@_); }
-sub main'cmp	{ &out2("cmp",@_); }
-sub main'lea	{ &out2("lea",@_); }
-sub main'mul	{ &out1("mul",@_); }
-sub main'div	{ &out1("div",@_); }
-sub main'dec	{ &out1("dec",@_); }
-sub main'inc	{ &out1("inc",@_); }
-sub main'jmp	{ &out1("jmp",@_); }
-sub main'jmp_ptr { &out1p("jmp",@_); }
-sub main'je	{ &out1("je",@_); }
-sub main'jle	{ &out1("jle",@_); }
-sub main'jz	{ &out1("jz",@_); }
-sub main'jge	{ &out1("jge",@_); }
-sub main'jl	{ &out1("jl",@_); }
-sub main'ja	{ &out1("ja",@_); }
-sub main'jae	{ &out1("jae",@_); }
-sub main'jb	{ &out1("jb",@_); }
-sub main'jbe	{ &out1("jbe",@_); }
-sub main'jc	{ &out1("jc",@_); }
-sub main'jnc	{ &out1("jnc",@_); }
-sub main'jnz	{ &out1("jnz",@_); }
-sub main'jne	{ &out1("jne",@_); }
-sub main'jno	{ &out1("jno",@_); }
-sub main'push	{ &out1("push",@_); $stack+=4; }
-sub main'pop	{ &out1("pop",@_); $stack-=4; }
-sub main'pushf	{ &out0("pushfd"); $stack+=4; }
-sub main'popf	{ &out0("popfd"); $stack-=4; }
-sub main'bswap	{ &out1("bswap",@_); &using486(); }
-sub main'not	{ &out1("not",@_); }
-sub main'call	{ &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); }
-sub main'call_ptr { &out1p("call",@_); }
-sub main'ret	{ &out0("ret"); }
-sub main'nop	{ &out0("nop"); }
-sub main'test	{ &out2("test",@_); }
-sub main'bt	{ &out2("bt",@_); }
-sub main'leave	{ &out0("leave"); }
-sub main'cpuid  { &out0("DW\t0A20Fh"); }
-sub main'rdtsc  { &out0("DW\t0310Fh"); }
-sub main'halt	{ &out0("hlt"); }
-sub main'movz	{ &out2("movzx",@_); }
-sub main'neg	{ &out1("neg",@_); }
-sub main'cld	{ &out0("cld"); }
-
-# SSE2
-sub main'emms	{ &out0("emms"); }
-sub main'movd	{ &out2("movd",@_); }
-sub main'movq	{ &out2("movq",@_); }
-sub main'movdqu	{ &out2("movdqu",@_); }
-sub main'movdqa	{ &out2("movdqa",@_); }
-sub main'movdq2q{ &out2("movdq2q",@_); }
-sub main'movq2dq{ &out2("movq2dq",@_); }
-sub main'paddq	{ &out2("paddq",@_); }
-sub main'pmuludq{ &out2("pmuludq",@_); }
-sub main'psrlq	{ &out2("psrlq",@_); }
-sub main'psllq	{ &out2("psllq",@_); }
-sub main'pxor	{ &out2("pxor",@_); }
-sub main'por	{ &out2("por",@_); }
-sub main'pand	{ &out2("pand",@_); }
-
-sub out2
-	{
-	local($name,$p1,$p2)=@_;
-	local($l,$t);
-
-	push(@out,"\t$name\t");
-	$t=&conv($p1).",";
-	$l=length($t);
-	push(@out,$t);
-	$l=4-($l+9)/8;
-	push(@out,"\t" x $l);
-	push(@out,&conv($p2));
-	push(@out,"\n");
-	}
-
-sub out0
-	{
-	local($name)=@_;
-
-	push(@out,"\t$name\n");
-	}
-
-sub out1
-	{
-	local($name,$p1)=@_;
-	local($l,$t);
-
-	push(@out,"\t$name\t".&conv($p1)."\n");
-	}
-
-sub conv
-	{
-	local($p)=@_;
-
-	$p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
-	return $p;
-	}
-
-sub using486
-	{
-	return if $using486;
-	$using486++;
-	grep(s/\.386/\.486/,@out);
-	}
-
-sub main'file
-	{
-	local($file)=@_;
-
-	local($tmp)=<<"EOF";
-	TITLE	$file.asm
-        .386
-.model	FLAT
-_TEXT\$	SEGMENT PAGE 'CODE'
-
-EOF
-	push(@out,$tmp);
-	}
-
-sub main'function_begin
-	{
-	local($func,$extra)=@_;
-
-	push(@labels,$func);
-
-	local($tmp)=<<"EOF";
-PUBLIC	_$func
-$extra
-_$func PROC NEAR
-	push	ebp
-	push	ebx
-	push	esi
-	push	edi
-EOF
-	push(@out,$tmp);
-	$stack=20;
-	}
-
-sub main'function_begin_B
-	{
-	local($func,$extra)=@_;
-
-	local($tmp)=<<"EOF";
-PUBLIC	_$func
-$extra
-_$func PROC NEAR
-EOF
-	push(@out,$tmp);
-	$stack=4;
-	}
-
-sub main'function_end
-	{
-	local($func)=@_;
-
-	local($tmp)=<<"EOF";
-	pop	edi
-	pop	esi
-	pop	ebx
-	pop	ebp
-	ret
-_$func ENDP
-EOF
-	push(@out,$tmp);
-	$stack=0;
-	%label=();
-	}
-
-sub main'function_end_B
-	{
-	local($func)=@_;
-
-	local($tmp)=<<"EOF";
-_$func ENDP
-EOF
-	push(@out,$tmp);
-	$stack=0;
-	%label=();
-	}
-
-sub main'function_end_A
-	{
-	local($func)=@_;
-
-	local($tmp)=<<"EOF";
-	pop	edi
-	pop	esi
-	pop	ebx
-	pop	ebp
-	ret
-EOF
-	push(@out,$tmp);
-	}
-
-sub main'file_end
-	{
-	# try to detect if SSE2 or MMX extensions were used...
-	if (grep {/xmm[0-7]\s*,/i} @out) {
-		grep {s/\.[3-7]86/\.686\n\t\.XMM/} @out;
-		}
-	elsif (grep {/mm[0-7]\s*,/i} @out) {
-		grep {s/\.[3-7]86/\.686\n\t\.MMX/} @out;
-		}
-	push(@out,"_TEXT\$	ENDS\n");
-	push(@out,"END\n");
-	}
-
-sub main'wparam
-	{
-	local($num)=@_;
-
-	return(&main'DWP($stack+$num*4,"esp","",0));
-	}
-
-sub main'swtmp
-	{
-	return(&main'DWP($_[0]*4,"esp","",0));
-	}
-
-# Should use swtmp, which is above esp.  Linix can trash the stack above esp
-#sub main'wtmp
-#	{
-#	local($num)=@_;
-#
-#	return(&main'DWP(-(($num+1)*4),"esp","",0));
-#	}
-
-sub main'comment
-	{
-	foreach (@_)
-		{
-		push(@out,"\t; $_\n");
-		}
-	}
-
-sub main'public_label
-	{
-	$label{$_[0]}="_$_[0]"	if (!defined($label{$_[0]}));
-	push(@out,"PUBLIC\t$label{$_[0]}\n");
-	}
-
-sub main'label
-	{
-	if (!defined($label{$_[0]}))
-		{
-		$label{$_[0]}="\$${label}${_[0]}";
-		$label++;
-		}
-	return($label{$_[0]});
-	}
-
-sub main'set_label
-	{
-	if (!defined($label{$_[0]}))
-		{
-		$label{$_[0]}="\$${label}${_[0]}";
-		$label++;
-		}
-	if ($_[1]!=0 && $_[1]>1)
-		{
-		main'align($_[1]);
-		}
-	if((defined $_[2]) && ($_[2] == 1))
-		{
-		push(@out,"$label{$_[0]}::\n");
-		}
-	elsif ($label{$_[0]} !~ /^\$/)
-		{
-		push(@out,"$label{$_[0]}\tLABEL PTR\n");
-		}
-	else
-		{
-		push(@out,"$label{$_[0]}:\n");
-		}
-	}
-
-sub main'data_byte
-	{
-	push(@out,"\tDB\t".join(',',@_)."\n");
-	}
-
-sub main'data_word
-	{
-	push(@out,"\tDD\t".join(',',@_)."\n");
-	}
-
-sub main'align
-	{
-	push(@out,"\tALIGN\t$_[0]\n");
-	}
-
-sub out1p
-	{
-	local($name,$p1)=@_;
-	local($l,$t);
-
-	push(@out,"\t$name\t".&conv($p1)."\n");
-	}
-
-sub main'picmeup
-	{
-	local($dst,$sym)=@_;
-	&main'lea($dst,&main'DWP($sym));
-	}
-
-sub main'blindpop { &out1("pop",@_); }
-
-sub main'initseg 
-	{
-	local($f)=@_;
-	local($tmp)=<<___;
-OPTION	DOTNAME
-.CRT\$XCU	SEGMENT DWORD PUBLIC 'DATA'
-EXTRN	_$f:NEAR
-DD	_$f
-.CRT\$XCU	ENDS
-___
-	push(@out,$tmp);
-	}
-
-1;
diff --git a/crypto/perlasm/x86nasm.pl b/crypto/perlasm/x86nasm.pl
index b6dfcbdf02..be439f44e9 100644
--- a/crypto/perlasm/x86nasm.pl
+++ b/crypto/perlasm/x86nasm.pl
@@ -1,451 +1,226 @@
-#!/usr/local/bin/perl
+#!/usr/bin/env perl
 
 package x86nasm;
 
-$label="L000";
-$under=($main'netware)?'':'_';
+*out=\@::out;
 
-%lb=(	'eax',	'al',
-	'ebx',	'bl',
-	'ecx',	'cl',
-	'edx',	'dl',
-	'ax',	'al',
-	'bx',	'bl',
-	'cx',	'cl',
-	'dx',	'dl',
-	);
+$lprfx="\@L";
+$label="000";
+$under=($::netware)?'':'_';
 
-%hb=(	'eax',	'ah',
-	'ebx',	'bh',
-	'ecx',	'ch',
-	'edx',	'dh',
-	'ax',	'ah',
-	'bx',	'bh',
-	'cx',	'ch',
-	'dx',	'dh',
-	);
+sub ::generic
+{ my $opcode=shift;
+  my $tmp;
 
-sub main'asm_init_output { @out=(); }
-sub main'asm_get_output { return(@out); }
-sub main'get_labels { return(@labels); }
-
-sub main'external_label
-{
-	push(@labels,@_);
-	foreach (@_) {
-		push(@out,".") if ($main'mwerks);
-		push(@out, "extern\t${under}$_\n");
-	}
+    if (!$::mwerks)
+    {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
+	{   $_[0] = "NEAR $_[0]";   	}
+	elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
+	{   $_[1] =~ s/^[^\[]*\[/\[/o;	}
+    }
+    &::emit($opcode,@_);
+  1;
 }
-
-sub main'LB
-	{
-	(defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
-	return($lb{$_[0]});
-	}
-
-sub main'HB
-	{
-	(defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
-	return($hb{$_[0]});
-	}
-
-sub main'BP
-	{
-	&get_mem("BYTE",@_);
-	}
-
-sub main'DWP
-	{
-	&get_mem("DWORD",@_);
-	}
-
-sub main'QWP
-	{
-	&get_mem("",@_);
-	}
-
-sub main'BC
-	{
-	return (($main'mwerks)?"":"BYTE ")."@_";
-	}
-
-sub main'DWC
-	{
-	return (($main'mwerks)?"":"DWORD ")."@_";
-	}
-
-sub main'stack_push
-	{
-	my($num)=@_;
-	$stack+=$num*4;
-	&main'sub("esp",$num*4);
-	}
-
-sub main'stack_pop
-	{
-	my($num)=@_;
-	$stack-=$num*4;
-	&main'add("esp",$num*4);
-	}
+#
+# opcodes not covered by ::generic above, mostly inconsistent namings...
+#
+sub ::movz	{ &::movzx(@_);		}
+sub ::pushf	{ &::pushfd;		}
+sub ::popf	{ &::popfd;		}
+
+sub ::call	{ &::emit("call",(&islabel($_[0]) or "$under$_[0]")); }
+sub ::call_ptr	{ &::emit("call",@_);	}
+sub ::jmp_ptr	{ &::emit("jmp",@_);	}
+
+# chosen SSE instructions
+sub ::movq
+{ my($p1,$p2,$optimize)=@_;
+
+    if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
+    # movq between mmx registers can sink Intel CPUs
+    {	&::pshufw($p1,$p2,0xe4);		}
+    else
+    {	&::emit("movq",@_);			}
+}
+sub ::pshufw { &::emit("pshufw",@_); }
 
 sub get_mem
-	{
-	my($size,$addr,$reg1,$reg2,$idx)=@_;
-	my($t,$post);
-	my($ret)=$size;
-	if ($ret ne "")
-		{
-		$ret .= " PTR" if ($main'mwerks);
-		$ret .= " ";
-		}
-	$ret .= "[";
-	$addr =~ s/^\s+//;
-	if ($addr =~ /^(.+)\+(.+)$/)
-		{
-		$reg2=&conv($1);
-		$addr="$under$2";
-		}
-	elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
-		{
-		$addr="$under$addr";
-		}
-
-	if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
-
-	$reg1="$regs{$reg1}" if defined($regs{$reg1});
-	$reg2="$regs{$reg2}" if defined($regs{$reg2});
-	if (($addr ne "") && ($addr ne 0))
-		{
-		if ($addr !~ /^-/)
-			{ $ret.="${addr}+"; }
-		else	{ $post=$addr; }
-		}
-	if ($reg2 ne "")
-		{
-		$t="";
-		$t="*$idx" if ($idx != 0);
-		$reg1="+".$reg1 if ("$reg1$post" ne "");
-		$ret.="$reg2$t$reg1$post]";
-		}
-	else
-		{
-		$ret.="$reg1$post]"
-		}
-	$ret =~ s/\+\]/]/; # in case $addr was the only argument
-	return($ret);
-	}
-
-sub main'mov	{ &out2("mov",@_); }
-sub main'movb	{ &out2("mov",@_); }
-sub main'and	{ &out2("and",@_); }
-sub main'or	{ &out2("or",@_); }
-sub main'shl	{ &out2("shl",@_); }
-sub main'shr	{ &out2("shr",@_); }
-sub main'xor	{ &out2("xor",@_); }
-sub main'xorb	{ &out2("xor",@_); }
-sub main'add	{ &out2("add",@_); }
-sub main'adc	{ &out2("adc",@_); }
-sub main'sub	{ &out2("sub",@_); }
-sub main'sbb	{ &out2("sbb",@_); }
-sub main'rotl	{ &out2("rol",@_); }
-sub main'rotr	{ &out2("ror",@_); }
-sub main'exch	{ &out2("xchg",@_); }
-sub main'cmp	{ &out2("cmp",@_); }
-sub main'lea	{ &out2("lea",@_); }
-sub main'mul	{ &out1("mul",@_); }
-sub main'div	{ &out1("div",@_); }
-sub main'dec	{ &out1("dec",@_); }
-sub main'inc	{ &out1("inc",@_); }
-sub main'jmp	{ &out1("jmp",@_); }
-sub main'jmp_ptr { &out1p("jmp",@_); }
-
-# This is a bit of a kludge: declare all branches as NEAR.
-$near=($main'mwerks)?'':'NEAR';
-sub main'je	{ &out1("je $near",@_); }
-sub main'jle	{ &out1("jle $near",@_); }
-sub main'jz	{ &out1("jz $near",@_); }
-sub main'jge	{ &out1("jge $near",@_); }
-sub main'jl	{ &out1("jl $near",@_); }
-sub main'ja	{ &out1("ja $near",@_); }
-sub main'jae	{ &out1("jae $near",@_); }
-sub main'jb	{ &out1("jb $near",@_); }
-sub main'jbe	{ &out1("jbe $near",@_); }
-sub main'jc	{ &out1("jc $near",@_); }
-sub main'jnc	{ &out1("jnc $near",@_); }
-sub main'jnz	{ &out1("jnz $near",@_); }
-sub main'jne	{ &out1("jne $near",@_); }
-sub main'jno	{ &out1("jno $near",@_); }
-
-sub main'push	{ &out1("push",@_); $stack+=4; }
-sub main'pop	{ &out1("pop",@_); $stack-=4; }
-sub main'pushf	{ &out0("pushfd"); $stack+=4; }
-sub main'popf	{ &out0("popfd"); $stack-=4; }
-sub main'bswap	{ &out1("bswap",@_); &using486(); }
-sub main'not	{ &out1("not",@_); }
-sub main'call	{ &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }
-sub main'call_ptr { &out1p("call",@_); }
-sub main'ret	{ &out0("ret"); }
-sub main'nop	{ &out0("nop"); }
-sub main'test	{ &out2("test",@_); }
-sub main'bt	{ &out2("bt",@_); }
-sub main'leave	{ &out0("leave"); }
-sub main'cpuid	{ &out0("cpuid"); }
-sub main'rdtsc	{ &out0("rdtsc"); }
-sub main'halt	{ &out0("hlt"); }
-sub main'movz	{ &out2("movzx",@_); }
-sub main'neg	{ &out1("neg",@_); }
-sub main'cld	{ &out0("cld"); }
-
-# SSE2
-sub main'emms	{ &out0("emms"); }
-sub main'movd	{ &out2("movd",@_); }
-sub main'movq	{ &out2("movq",@_); }
-sub main'movdqu	{ &out2("movdqu",@_); }
-sub main'movdqa	{ &out2("movdqa",@_); }
-sub main'movdq2q{ &out2("movdq2q",@_); }
-sub main'movq2dq{ &out2("movq2dq",@_); }
-sub main'paddq	{ &out2("paddq",@_); }
-sub main'pmuludq{ &out2("pmuludq",@_); }
-sub main'psrlq	{ &out2("psrlq",@_); }
-sub main'psllq	{ &out2("psllq",@_); }
-sub main'pxor	{ &out2("pxor",@_); }
-sub main'por	{ &out2("por",@_); }
-sub main'pand	{ &out2("pand",@_); }
-
-sub out2
-	{
-	my($name,$p1,$p2)=@_;
-	my($l,$t);
-
-	push(@out,"\t$name\t");
-	if (!$main'mwerks and $name eq "lea")
-		{
-		$p1 =~ s/^[^\[]*\[/\[/;
-		$p2 =~ s/^[^\[]*\[/\[/;
-		}
-	$t=&conv($p1).",";
-	$l=length($t);
-	push(@out,$t);
-	$l=4-($l+9)/8;
-	push(@out,"\t" x $l);
-	push(@out,&conv($p2));
-	push(@out,"\n");
-	}
-
-sub out0
-	{
-	my($name)=@_;
-
-	push(@out,"\t$name\n");
-	}
-
-sub out1
-	{
-	my($name,$p1)=@_;
-	my($l,$t);
-	push(@out,"\t$name\t".&conv($p1)."\n");
-	}
-
-sub conv
-	{
-	my($p)=@_;
-	$p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
-	return $p;
-	}
-
-sub using486
-	{
-	return if $using486;
-	$using486++;
-	grep(s/\.386/\.486/,@out);
-	}
-
-sub main'file
-	{
-	if ($main'mwerks)	{ push(@out,".section\t.text\n"); }
-	else	{
-		local $tmp=<<___;
+{ my($size,$addr,$reg1,$reg2,$idx)=@_;
+  my($post,$ret);
+
+    if ($size ne "")
+    {	$ret .= "$size";
+	$ret .= " PTR" if ($::mwerks);
+	$ret .= " ";
+    }
+    $ret .= "[";
+
+    $addr =~ s/^\s+//;
+    # prepend global references with optional underscore
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
+    # put address arithmetic expression in parenthesis
+    $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
+
+    if (($addr ne "") && ($addr ne 0))
+    {	if ($addr !~ /^-/)	{ $ret .= "$addr+"; }
+	else			{ $post=$addr;      }
+    }
+
+    if ($reg2 ne "")
+    {	$idx!=0 or $idx=1;
+	$ret .= "$reg2*$idx";
+	$ret .= "+$reg1" if ($reg1 ne "");
+    }
+    else
+    {	$ret .= "$reg1";   }
+
+    $ret .= "$post]";
+    $ret =~ s/\+\]/]/; # in case $addr was the only argument
+
+  $ret;
+}
+sub ::BP	{ &get_mem("BYTE",@_);  }
+sub ::DWP	{ &get_mem("DWORD",@_); }
+sub ::QWP	{ &get_mem("QWORD",@_); }
+sub ::BC	{ (($::mwerks)?"":"BYTE ")."@_";  }
+sub ::DWC	{ (($::mwerks)?"":"DWORD ")."@_"; }
+
+sub ::file
+{   if ($::mwerks)	{ push(@out,".section\t.text\n"); }
+    else
+    { my $tmp=<<___;
 %ifdef __omf__
-section	code	use32 class=code
+section	code	use32 class=code align=64
 %else
-section	.text
+section	.text	code align=64
 %endif
 ___
-		push(@out,$tmp);
-		}
-	}
-
-sub main'function_begin
-	{
-	my($func,$extra)=@_;
-
-	push(@labels,$func);
-	my($tmp)=<<"EOF";
-global	$under$func
-$under$func:
-	push	ebp
-	push	ebx
-	push	esi
-	push	edi
-EOF
 	push(@out,$tmp);
-	$stack=20;
-	}
-
-sub main'function_begin_B
-	{
-	my($func,$extra)=@_;
-	my($tmp)=<<"EOF";
-global	$under$func
-$under$func:
-EOF
-	push(@out,$tmp);
-	$stack=4;
-	}
+    }
+}
 
-sub main'function_end
-	{
-	my($func)=@_;
+sub ::function_begin_B
+{ my $func=$under.shift;
+  my $tmp=<<___;
+global	$func
+align	16
+$func:
+___
+    push(@out,$tmp);
+    $::stack=4;
+}
+sub ::function_end_B
+{ my $i;
+    foreach $i (%label) { undef $label{$i} if ($label{$i} =~ /^$prfx/);  }
+    $::stack=0;
+}
 
-	my($tmp)=<<"EOF";
-	pop	edi
-	pop	esi
+sub ::file_end
+{   # try to detect if SSE2 or MMX extensions were used on Win32...
+    if ($::win32 && grep {/\s+[x]*mm[0-7]/i} @out)
+    {	# One can argue that it's wasteful to craft every
+	# SSE/MMX module with this snippet... Well, it's 72
+	# bytes long and for the moment we have two modules.
+	# Let's argue when we have 7 modules or so...
+	#
+	# $1<<10 sets a reserved bit to signal that variable
+	# was initialized already...
+	my $tmp=<<___;
+align	16
+${lprfx}OPENSSL_ia32cap_init:
+	lea	edx,[${under}OPENSSL_ia32cap_P]
+	cmp	DWORD [edx],0
+	jne	NEAR ${lprfx}nocpuid
+	mov	DWORD [edx],1<<10
+	pushfd
+	pop	eax
+	mov	ecx,eax
+	xor	eax,1<<21
+	push	eax
+	popfd
+	pushfd
+	pop	eax
+	xor	eax,ecx
+	bt	eax,21
+	jnc	NEAR ${lprfx}nocpuid
+	push	edi
+	push	ebx
+	mov	edi,edx
+	mov	eax,1
+	cpuid
+	or	edx,1<<10
+	mov	DWORD [edi],edx
 	pop	ebx
-	pop	ebp
-	ret
-EOF
-	push(@out,$tmp);
-	$stack=0;
-	%label=();
-	}
-
-sub main'function_end_B
-	{
-	$stack=0;
-	%label=();
-	}
-
-sub main'function_end_A
-	{
-	my($func)=@_;
-
-	my($tmp)=<<"EOF";
 	pop	edi
-	pop	esi
-	pop	ebx
-	pop	ebp
+${lprfx}nocpuid:
 	ret
-EOF
-	push(@out,$tmp);
-	}
 
-sub main'file_end
-	{
-	}
-
-sub main'wparam
-	{
-	my($num)=@_;
-
-	return(&main'DWP($stack+$num*4,"esp","",0));
-	}
-
-sub main'swtmp
-	{
-	return(&main'DWP($_[0]*4,"esp","",0));
-	}
-
-# Should use swtmp, which is above esp.  Linix can trash the stack above esp
-#sub main'wtmp
-#	{
-#	my($num)=@_;
-#
-#	return(&main'DWP(-(($num+1)*4),"esp","",0));
-#	}
-
-sub main'comment
-	{
-	foreach (@_)
-		{
-		push(@out,"\t; $_\n");
-		}
-	}
+segment	.CRT\$XCU rdata align=4
+dd	${lprfx}OPENSSL_ia32cap_init
+segment	.bss
+common	${under}OPENSSL_ia32cap_P 4
+___
+	push (@out,$tmp);		
+    }
+}
 
-sub main'public_label
-	{
-	$label{$_[0]}="${under}${_[0]}"	if (!defined($label{$_[0]}));
-	push(@out,"global\t$label{$_[0]}\n");
-	}
+sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 
-sub main'label
-	{
-	if (!defined($label{$_[0]}))
-		{
-		$label{$_[0]}="\@${label}${_[0]}";
-		$label++;
-		}
-	return($label{$_[0]});
-	}
+sub islabel	# see is argument is known label
+{ my $i;
+    foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
+  undef;
+}
 
-sub main'set_label
-	{
-	if (!defined($label{$_[0]}))
-		{
-		$label{$_[0]}="\@${label}${_[0]}";
-		$label++;
-		}
-	if ($_[1]!=0 && $_[1]>1)
-		{
-		main'align($_[1]);
-		}
-	push(@out,"$label{$_[0]}:\n");
-	}
+sub ::external_label