x86 perlasm overhaul.

4 files changed, 301 insertions, 265 deletions

diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl
index 8ae2b7d927..66ba308b99 100644
--- a/crypto/perlasm/x86asm.pl
+++ b/crypto/perlasm/x86asm.pl
@@ -7,6 +7,9 @@
 # &function_end("foo");
 # &asm_finish
 
+$out=();
+$i386=0;
+
 # 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
@@ -23,9 +26,6 @@ sub ::AUTOLOAD
     &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
 }
 
-$out=();
-$i386=0;
-
 sub ::emit
 { my $opcode=shift;
 
@@ -65,7 +65,61 @@ sub ::rotl	{ &rol(@_);	}
 sub ::rotr	{ &ror(@_);	}
 sub ::exch	{ &xchg(@_);	}
 sub ::halt	{ &hlt;		}
+sub ::movz	{ &movzx(@_);	}
+sub ::pushf	{ &::pushfd;	}
+sub ::popf	{ &::popfd;	}
+
+# 3 argument 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
+    {	&::generic("movq",@_);			}
+}
+sub ::pshufw	{ &::emit("pshufw",@_); }
+sub ::shld	{ &::emit("shld",@_);   }
+sub ::shrd	{ &::emit("shrd",@_);   }
+
+# label management
+$lbdecor="L";		# local label decoration, set by package
+$label="000";
+
+sub ::islabel		# see is argument is a known label
+{ my $i;
+    foreach $i (values %label) { return $i if ($i eq $_[0]); }
+  $label{$_[0]};	# can be undef
+}
+
+sub ::label		# instantiate a function-scope label
+{   if (!defined($label{$_[0]}))
+    {	$label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
+  $label{$_[0]};
+}
+
+sub ::LABEL		# instantiate a file-scope label
+{   $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
+  $label{$_[0]};
+}
+
+sub ::static_label	{ &::LABEL($_[0],$lbdecor.$_[0]); }
+
+sub ::set_label_B	{ push(@out,"@_:\n"); }
+sub ::set_label
+{ my $label=&::label($_[0]);
+    &::align($_[1]) if ($_[1]>1);
+    &::set_label_B($label);
+  $label;
+}
 
+sub ::wipe_labels	# wipes function-scope labels
+{   foreach $i (keys %label)
+    {	delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/);	}
+}
+
+# subroutine management
 sub ::function_begin
 {   &function_begin_B(@_);
     $stack=4;
@@ -81,8 +135,9 @@ sub ::function_end
     &pop("ebx");
     &pop("ebp");
     &ret();
-    $stack=0;
     &function_end_B(@_);
+    $stack=0;
+    &wipe_labels();
 }
 
 sub ::function_end_A
@@ -94,7 +149,15 @@ sub ::function_end_A
     $stack+=16;	# readjust esp as if we didn't pop anything
 }
 
-sub ::asciz {   foreach (@_) { &data_byte(unpack("C*",$_),0); }   }
+sub ::asciz
+{ my @str=unpack("C*",shift);
+    push @str,0;
+    while ($#str>15) {
+	&data_byte(@str[0..15]);
+	foreach (0..15) { shift @str; }
+    }
+    &data_byte(@str) if (@str);
+}
 
 sub ::asm_finish
 {   &file_end();
@@ -109,17 +172,19 @@ sub ::asm_init
 
     $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;
     if    (($type eq "elf"))
-    {	$elf=1;			require "x86unix.pl";	}
+    {	$elf=1;			require "x86gas.pl";	}
     elsif (($type eq "a\.out"))
-    {	$aout=1;		require "x86unix.pl";	}
+    {	$aout=1;		require "x86gas.pl";	}
     elsif (($type eq "coff" or $type eq "gaswin"))
-    {	$coff=1;		require "x86unix.pl";	}
+    {	$coff=1;		require "x86gas.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";	}
+    elsif (($type eq "win32"))
+    {	$win32=1;		require "x86masm.pl";	}
     else
     {	print STDERR <<"EOF";
 Pick one target type from
diff --git a/crypto/perlasm/x86unix.pl b/crypto/perlasm/x86gas.pl
index e2d7dba8e8..fa789a78b9 100644
--- a/crypto/perlasm/x86unix.pl
+++ b/crypto/perlasm/x86gas.pl
@@ -1,13 +1,13 @@
 #!/usr/bin/env perl
 
-package x86unix;	# GAS actually...
+package x86gas;
 
 *out=\@::out;
 
-$lbdecor=$::aout?"L":".L";		# local label decoration
+$::lbdecor=$::aout?"L":".L";		# local label decoration
 $nmdecor=($::aout or $::coff)?"_":"";	# external name decoration
 
-$label="000";
+$initseg="";
 
 $align=16;
 $align=log($align)/log(2) if ($::aout);
@@ -59,31 +59,30 @@ sub ::generic
 #
 # opcodes not covered by ::generic above, mostly inconsistent namings...
 #
-sub ::movz	{ &::movzb(@_);			}
-sub ::pushf	{ &::pushfl;			}
-sub ::popf	{ &::popfl;			}
+sub ::movzx	{ &::movzb(@_);			}
+sub ::pushfd	{ &::pushfl;			}
+sub ::popfd	{ &::popfl;			}
 sub ::cpuid	{ &::emit(".byte\t0x0f,0xa2");	}
 sub ::rdtsc	{ &::emit(".byte\t0x0f,0x31");	}
 
-sub ::call	{ &::emit("call",(&islabel($_[0]) or "$nmdecor$_[0]")); }
+sub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
 sub ::call_ptr	{ &::generic("call","*$_[0]");	}
 sub ::jmp_ptr	{ &::generic("jmp","*$_[0]");	}
 
 *::bswap = sub	{ &::emit("bswap","%$_[0]");	} if (!$::i386);
 
-# 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
-    {	&::generic("movq",@_);	}
-}
-sub ::pshufw
+*::pshufw = sub
 { my($dst,$src,$magic)=@_;
     &::emit("pshufw","\$$magic","%$src","%$dst");
-}
+};
+*::shld = sub
+{ my($dst,$src,$bits)=@_;
+    &::emit("shldl",$bit eq "cl"?"%cl":"\$$bits","%$src","%$dst");
+};
+*::shrd = sub
+{ my($dst,$src,$bits)=@_;
+    &::emit("shrdl",$bit eq "cl"?"%cl":"\$$bits","%$src","%$dst");
+};
 
 sub ::DWP
 { my($addr,$reg1,$reg2,$idx)=@_;
@@ -91,7 +90,7 @@ sub ::DWP
 
     $addr =~ s/^\s+//;
     # prepend global references with optional underscore
-    $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$nmdecor$1"/ige;
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige;
 
     $reg1 = "%$reg1" if ($reg1);
     $reg2 = "%$reg2" if ($reg2);
@@ -113,18 +112,16 @@ sub ::BC	{ @_;		}
 sub ::DWC	{ @_;		}
 
 sub ::file
-{   push(@out,".file\t\"$_[0].s\"\n");	}
+{   push(@out,".file\t\"$_[0].s\"\n.text\n");	}
 
 sub ::function_begin_B
-{ my($func,$extra)=@_;
+{ my $func=shift;
   my $global=($func !~ /^_/);
-  my $begin="${lbdecor}_${func}_begin";
+  my $begin="${::lbdecor}_${func}_begin";
 
-    &::external_label($func);
-    $label{$func} = $global?"$begin":"$nmdecor$func";
+    &::LABEL($func,$global?"$begin":"$nmdecor$func");
     $func=$nmdecor.$func;
 
-    push(@out,".text\n");
     push(@out,".globl\t$func\n")	if ($global);
     if ($::coff)
     {	push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); }
@@ -139,13 +136,10 @@ sub ::function_begin_B
 }
 
 sub ::function_end_B
-{ my($func)=@_;
-  my $i;
-
-    push(@out,".size\t$nmdecor$func,.-$label{$func}\n") if ($::elf);
-    foreach $i (keys %label)
-    {	delete $label{$i} if ($label{$i} =~ /^${lbdecor}[0-9]{3}/);	}
+{ my $func=shift;
+    push(@out,".size\t$nmdecor$func,.-".&::LABEL($func)."\n") if ($::elf);
     $::stack=0;
+    &::wipe_labels();
 }
 
 sub ::comment
@@ -165,100 +159,19 @@ sub ::comment
 		}
 	}
 
-sub islabel	# see is argument is a known label
-{ my $i;
-    foreach $i (values %label) { return $i if ($i eq $_[0]); }
-  $label{$_[0]};	# can be undef
-}
-
-sub ::external_label { push(@labels,@_); }
+sub ::external_label
+{   push(@out,".extern\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
 
 sub ::public_label
-{   $label{$_[0]}="${nmdecor}${_[0]}"	if (!defined($label{$_[0]}));
-    push(@out,".globl\t$label{$_[0]}\n");
-}
-
-sub ::label
-{   if (!defined($label{$_[0]}))
-    {	$label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
-  $label{$_[0]};
-}
-
-sub ::set_label
-{ my $label=&::label($_[0]);
-    &::align($_[1]) if ($_[1]>1);
-    push(@out,"$label:\n");
-}
+{   push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
 
 sub ::file_end
-{   # try to detect if SSE2 or MMX extensions were used on ELF platform...
-    if ($::elf && grep {/\b%[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out) {
-
-	push (@out,"\n.section\t.bss\n");
-	push (@out,".comm\t${nmdecor}OPENSSL_ia32cap_P,4,4\n");
-
-	return;	# below is not needed in OpenSSL context
-
-	push (@out,".section\t.init\n");
-	&::picmeup("edx","OPENSSL_ia32cap_P");
-	# $1<<10 sets a reserved bit to signal that variable
-	# was initialized already...
-	my $code=<<___;
-	cmpl	\$0,(%edx)
-	jne	3f
-	movl	\$1<<10,(%edx)
-	pushf
-	popl	%eax
-	movl	%eax,%ecx
-	xorl	\$1<<21,%eax
-	pushl	%eax
-	popf
-	pushf
-	popl	%eax
-	xorl	%ecx,%eax
-	btl	\$21,%eax
-	jnc	3f
-	pushl	%ebp
-	pushl	%edi
-	pushl	%ebx
-	movl	%edx,%edi
-	xor	%eax,%eax
-	.byte	0x0f,0xa2
-	xorl	%eax,%eax
-	cmpl	$1970169159,%ebx
-	setne	%al
-	movl	%eax,%ebp
-	cmpl	$1231384169,%edx
-	setne	%al
-	orl	%eax,%ebp
-	cmpl	$1818588270,%ecx
-	setne	%al
-	orl	%eax,%ebp
-	movl	$1,%eax
-	.byte	0x0f,0xa2
-	cmpl	$0,%ebp
-	jne	1f
-	andb	$15,%ah
-	cmpb	$15,%ah
-	jne	1f
-	orl	$1048576,%edx
-1:	btl	$28,%edx
-	jnc	2f
-	shrl	$16,%ebx
-	cmpb	$1,%bl
-	ja	2f
-	andl	$4026531839,%edx
-2:	orl	\$1<<10,%edx
-	movl	%edx,0(%edi)
-	popl	%ebx
-	popl	%edi
-	popl	%ebp
-	jmp	3f
-	.align	$align
-	3:
-___
-	push (@out,$code);
+{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) {
+	my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,4";
+	if ($::elf)	{ push (@out,"$tmp,4\n"); }
+	else		{ push (@out,"$tmp\n"); }
     }
+    push(@out,$initseg) if ($initseg);
 }
 
 sub ::data_byte	{   push(@out,".byte\t".join(',',@_)."\n");   }
@@ -296,36 +209,34 @@ sub ::picmeup
 }
 
 sub ::initseg
-{ my($f)=@_;
-  my($tmp,$ctor);
+{ my $f=$nmdecor.shift;
 
     if ($::elf)
-    {	$tmp=<<___;
+    {	$initseg.=<<___;
 .section	.init
-	call	$nmdecor$f
+	call	$f
 	jmp	.Linitalign
 .align	$align
 .Linitalign:
 ___
     }
     elsif ($::coff)
-    {   $tmp=<<___;	# applies to both Cygwin and Mingw
+    {   $initseg.=<<___;	# applies to both Cygwin and Mingw
 .section	.ctors
-.long	$nmdecor$f
+.long	$f
 ___
     }
     elsif ($::aout)
-    {	$ctor="${nmdecor}_GLOBAL_\$I\$$f";
-	$tmp=".text\n";
-	$tmp.=".type	$ctor,\@function\n" if ($::pic);
-	$tmp.=<<___;	# OpenBSD way...
+    {	my $ctor="${nmdecor}_GLOBAL_\$I\$$f";
+	$initseg.=".text\n";
+	$initseg.=".type	$ctor,\@function\n" if ($::pic);
+	$initseg.=<<___;	# OpenBSD way...
 .globl	$ctor
 .align	2
 $ctor:
-	jmp	$nmdecor$f
+	jmp	$f
 ___
     }
-    push(@out,$tmp) if ($tmp);
 }
 
 1;
diff --git a/crypto/perlasm/x86masm.pl b/crypto/perlasm/x86masm.pl
new file mode 100644
index 0000000000..7a0f4aa5bb
--- /dev/null
+++ b/crypto/perlasm/x86masm.pl
@@ -0,0 +1,165 @@
+#!/usr/bin/env perl
+
+package x86masm;
+
+*out=\@::out;
+
+$::lbdecor="\$L";	# local label decoration
+$nmdecor="_";		# external name decoration
+
+$initseg="";
+
+sub ::generic
+{ my ($opcode,@arg)=@_;
+
+    # fix hexadecimal constants
+    $arg[0] =~ s/0x([0-9a-f]+)/0$1h/oi	if (defined($arg[0]));
+    $arg[1] =~ s/0x([0-9a-f]+)/0$1h/oi	if (defined($arg[1]));
+
+    &::emit($opcode,@arg);
+  1;
+}
+#
+# opcodes not covered by ::generic above, mostly inconsistent namings...
+#
+sub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); }
+sub ::call_ptr	{ &::emit("call",@_);	}
+sub ::jmp_ptr	{ &::emit("jmp",@_);	}
+
+sub get_mem
+{ my($size,$addr,$reg1,$reg2,$idx)=@_;
+  my($post,$ret);
+
+    $ret .= "$size PTR " if ($size ne "");
+
+    $addr =~ s/^\s+//;
+    # prepend global references with optional underscore
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$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;      }
+    }
+    $ret .= "[";
+
+    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 =~ s/\[\s*\]//;
+
+  $ret;
+}
+sub ::BP	{ &get_mem("BYTE",@_);  }
+sub ::DWP	{ &get_mem("DWORD",@_); }
+sub ::QWP	{ &get_mem("QWORD",@_); }
+sub ::BC	{ "@_";  }
+sub ::DWC	{ "@_"; }
+
+sub ::file
+{ my $tmp=<<___;
+TITLE	$_[0].asm
+.486
+.MODEL	FLAT
+OPTION	DOTNAME
+.TEXT\$	SEGMENT PAGE 'CODE'
+___
+    push(@out,$tmp);
+}
+
+sub ::function_begin_B
+{ my $func=shift;
+  my $global=($func !~ /^_/);
+  my $begin="${::lbdecor}_${func}_begin";
+
+    &::LABEL($func,$global?"$begin":"$nmdecor$func");
+    $func=$nmdecor.$func."\tPROC";
+
+    if ($global)    { $func.=" PUBLIC\n${begin}::\n"; }
+    else	    { $func.=" PRIVATE\n";            }
+    push(@out,$func);
+    $::stack=4;
+}
+sub ::function_end_B
+{ my $func=shift;
+
+    push(@out,"$nmdecor$func ENDP\n");
+    $::stack=0;
+    &::wipe_labels();
+}
+
+sub ::file_end
+{ my $xmmheader=<<___;
+.686
+.XMM
+IF \@Version LT 800
+XMMWORD STRUCT 16
+DQ	2 dup (?)
+XMMWORD	ENDS
+ENDIF
+___
+    if (grep {/\b[x]?mm[0-7]\b/i} @out) {
+	grep {s/\.[3-7]86/$xmmheader/} @out;
+    }
+
+    push(@out,".TEXT\$	ENDS\n");
+
+    if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
+    {	my $comm=<<___;
+_DATA	SEGMENT
+COMM	${nmdecor}OPENSSL_ia32cap_P:DWORD
+_DATA	ENDS
+___
+	# comment out OPENSSL_ia32cap_P declarations
+	grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
+	push (@out,$comm);
+    }
+    push (@out,$initseg) if ($initseg);
+    push (@out,"END\n");
+}
+
+sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
+
+*::set_label_B = sub
+{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); };
+
+sub ::external_label
+{   push(@out, "EXTERN\t".&::LABEL($_[0],$nmdecor.$_[0]).":NEAR\n");   }
+
+sub ::public_label
+{   push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
+
+sub ::data_byte
+{   push(@out,("DB\t").join(',',@_)."\n");	}
+
+sub ::data_word
+{   push(@out,("DD\t").join(',',@_)."\n");	}
+
+sub ::align
+{   push(@out,"ALIGN\t$_[0]\n");	}
+
+sub ::picmeup
+{ my($dst,$sym)=@_;
+    &::lea($dst,&::DWP($sym));
+}
+
+sub ::initseg
+{ my $f=$nmdecor.shift;
+
+    $initseg.=<<___;
+.CRT\$XCU	SEGMENT DWORD PUBLIC DATA
+EXTERN	$f:NEAR
+DD	$f
+.CRT\$XCU	ENDS
+___
+}
+
+1;
diff --git a/crypto/perlasm/x86nasm.pl b/crypto/perlasm/x86nasm.pl
index 604f58a2d9..1154f04c34 100644
--- a/crypto/perlasm/x86nasm.pl
+++ b/crypto/perlasm/x86nasm.pl
@@ -4,11 +4,10 @@ package x86nasm;
 
 *out=\@::out;
 
-$lbdecor="\@L";			# local label decoration
+$::lbdecor="\@L";		# local label decoration
 $nmdecor=$::netware?"":"_";	# external name decoration
 $drdecor=$::mwerks?".":"";	# directive decoration
 
-$label="000";
 $initseg="";
 
 sub ::generic
@@ -18,7 +17,7 @@ sub ::generic
     if (!$::mwerks)
     {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
 	{   $_[0] = "NEAR $_[0]";   	}
-	elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
+	elsif ($opcode eq "lea" && $#_==1)  # wipe storage qualifier from lea
 	{   $_[1] =~ s/^[^\[]*\[/\[/o;	}
     }
     &::emit($opcode,@_);
@@ -27,26 +26,10 @@ sub ::generic
 #
 # 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 "$nmdecor$_[0]")); }
+sub ::call	{ &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[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($post,$ret);
@@ -60,7 +43,7 @@ sub get_mem
 
     $addr =~ s/^\s+//;
     # prepend global references with optional underscore
-    $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$nmdecor$1"/ige;
+    $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
     # put address arithmetic expression in parenthesis
     $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
 
@@ -89,7 +72,7 @@ sub ::BC	{ (($::mwerks)?"":"BYTE ")."@_";  }
 sub ::DWC	{ (($::mwerks)?"":"DWORD ")."@_"; }
 
 sub ::file
-{   if ($::mwerks)	{ push(@out,".section\t.text\n"); }
+{   if ($::mwerks)	{ push(@out,".section\t.text,64\n"); }
     else
     { my $tmp=<<___;
 %ifdef __omf__
@@ -105,9 +88,11 @@ ___
 sub ::function_begin_B
 { my $func=shift;
   my $global=($func !~ /^_/);
-  my $begin="${lbdecor}_${func}_begin";
+  my $begin="${::lbdecor}_${func}_begin";
 
-    $label{$func}=$global?"$begin":"$nmdecor$func";
+    $begin =~ s/^\@/./ if ($::mwerks);	# the torture never stops
+
+    &::LABEL($func,$global?"$begin":"$nmdecor$func");
     $func=$nmdecor.$func;
 
     push(@out,"${drdecor}global	$func\n")	if ($global);
@@ -116,122 +101,32 @@ sub ::function_begin_B
     push(@out,"$begin:\n")			if ($global);
     $::stack=4;
 }
+
 sub ::function_end_B
-{ my $i;
-    foreach $i (keys %label)
-    {	delete $label{$i} if ($label{$i} =~ /^${lbdecor}[0-9]{3}/);	}
-    $::stack=0;
+{   $::stack=0;
+    &::wipe_labels();
 }
 
 sub ::file_end
-{   # try to detect if SSE2 or MMX extensions were used on Win32...
-    if ($::win32 && grep {/\b[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out)
-    {	# $1<<10 sets a reserved bit to signal that variable
-	# was initialized already...
-	my $code=<<___;
-align	16
-${lbdecor}OPENSSL_ia32cap_init:
-	lea	edx,[${nmdecor}OPENSSL_ia32cap_P]
-	cmp	DWORD [edx],0
-	jne	NEAR ${lbdecor}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 ${lbdecor}nocpuid
-	push	ebp
-	push	edi
-	push	ebx
-	mov	edi,edx
-	xor	eax,eax
-	cpuid
-	xor	eax,eax
-	cmp	ebx,'Genu'
-	setne	al
-	mov	ebp,eax
-	cmp	edx,'ineI'
-	setne	al
-	or	ebp,eax
-	cmp	eax,'ntel'
-	setne	al
-	or	ebp,eax
-	mov	eax,1
-	cpuid
-	cmp	ebp,0
-	jne	${lbdecor}notP4
-	and	ah,15
-	cmp	ah,15
-	jne	${lbdecor}notP4
-	or	edx,1<<20
-${lbdecor}notP4:
-	bt	edx,28
-	jnc	${lbdecor}done
-	shr	ebx,16
-	cmp	bl,1
-	ja	${lbdecor}done
-	and	edx,0xefffffff
-${lbdecor}done:
-	or	edx,1<<10
-	mov	DWORD [edi],edx
-	pop	ebx
-	pop	edi
-	pop	ebp
-${lbdecor}nocpuid:
-	ret
-segment	.CRT\$XCU data align=4
-dd	${lbdecor}OPENSSL_ia32cap_init
+{   if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
+    {	my $comm=<<___;
+${drdecor}segment	.bss
+${drdecor}common	${nmdecor}OPENSSL_ia32cap_P 4
 ___
-	my $data=<<___;
-segment	.bss
-common	${nmdecor}OPENSSL_ia32cap_P 4
-___
-
-	#<not needed in OpenSSL context>#push (@out,$code);
-
 	# comment out OPENSSL_ia32cap_P declarations
 	grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
-	push (@out,$data)
+	push (@out,$comm)
     }
     push (@out,$initseg) if ($initseg);		
 }
 
 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
 
-sub islabel	# see is argument is known label
-{ my $i;
-    foreach $i (values %label) { return $i if ($i eq $_[0]); }
-  $label{$_[0]};	# can be undef
-}
-
 sub ::external_label
-{   push(@labels,@_);
-    foreach (@_)
-    {	push(@out, "${drdecor}extern\t${nmdecor}$_\n");	}
-}
+{   push(@out,"${drdecor}extern\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");   }
 
 sub ::public_label
-{   $label{$_[0]}="${nmdecor}${_[0]}" if (!defined($label{$_[0]}));
-    push(@out,"${drdecor}global\t$label{$_[0]}\n");
-}
-
-sub ::label
-{   if (!defined($label{$_[0]}))
-    {	$label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
-  $label{$_[0]};
-}
-
-sub ::set_label
-{ my $label=&::label($_[0]);
-    &::align($_[1]) if ($_[1]>1);
-    push(@out,"$label{$_[0]}:\n");
-}
+{   push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n");  }
 
 sub ::data_byte
 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");	}
@@ -248,7 +143,7 @@ sub ::picmeup
 }
 
 sub ::initseg
-{ my($f)=$nmdecor.shift;
+{ my $f=$nmdecor.shift;
     if ($::win32)
     {	$initseg=<<___;
 segment	.CRT\$XCU data align=4