Commit a8c65b40 authored by Andy Polyakov's avatar Andy Polyakov
Browse files

crypto/perlasm update primarily to unify Netware modules. Once it's verified 

x86*_nw.pl will be deleted. In addition this update implements initseg
on several additional [in addition to ELF] platforms. Functions registered
with initseg are supposed to be called prior main().
parent 52697590

crypto/perlasm/x86asm.pl

+3 −3
Original line number Diff line number Diff line
@@ -18,7 +18,7 @@ sub main'asm_init 
	($type,$fn,$i386)=@_;

	$filename=$fn;



	$elf=$cpp=$coff=$aout=$win32=$netware=0;

	$elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;

	if (	($type eq "elf"))

		{ $elf=1; require "x86unix.pl"; }

	elsif (	($type eq "a.out"))
@@ -32,9 +32,9 @@ sub main'asm_init 
	elsif (	($type eq "win32n"))

		{ $win32=1; require "x86nasm.pl"; }

	elsif (	($type eq "nw-nasm"))

		{ $netware=1; require "x86nasm_nw.pl"; }

		{ $netware=1; require "x86nasm.pl"; }

	elsif (	($type eq "nw-mwasm"))

		{ $netware=1; require "x86mwasm_nw.pl"; }

		{ $netware=1; $mwerks=1; require "x86nasm.pl"; }

	else

		{

		print STDERR <<"EOF";

crypto/perlasm/x86ms.pl

+18 −3
Original line number Diff line number Diff line
@@ -170,8 +170,8 @@ 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'cpuid  { &out0("DW\t0A20Fh"); }

sub main'rdtsc  { &out0("DW\t0310Fh"); }



# SSE2

sub main'emms	{ &out0("emms"); }
@@ -329,7 +329,7 @@ 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/\.786\n\t\.XMM/} @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;
@@ -417,3 +417,18 @@ sub main'picmeup 
	}



sub main'blindpop { &out1("pop",@_); }



sub main'initseg 

	{

	local($f)=@_;

	local($tmp)=<<___;

OPTION	DOTNAME

.CRT\$XIU	SEGMENT DWORD PUBLIC 'DATA'

EXTRN	_$f:NEAR

DD	_$f

.CRT\$XIU	ENDS

___

	push(@out,$tmp);

	}



1;

crypto/perlasm/x86nasm.pl

+63 −31
Original line number Diff line number Diff line
@@ -3,6 +3,7 @@ 
package x86nasm;



$label="L000";

$under=($main'netware)?'':'_';



%lb=(	'eax',	'al',

	'ebx',	'bl',
@@ -32,7 +33,8 @@ sub main'external_label 
{

	push(@labels,@_);

	foreach (@_) {

		push(@out, "extern\t_$_\n");

		push(@out,".") if ($main'mwerks);

		push(@out, "extern\t${under}$_\n");

	}

}
@@ -60,17 +62,17 @@ sub main'DWP 


sub main'QWP

	{

	&get_mem("QWORD",@_);

	&get_mem("",@_);

	}



sub main'BC

	{

	return "BYTE @_";

	return (($main'mwerks)?"":"BYTE ")."@_";

	}



sub main'DWC

	{

	return "DWORD @_";

	return (($main'mwerks)?"":"DWORD ")."@_";

	}



sub main'stack_push
@@ -91,16 +93,22 @@ sub get_mem 
	{

	my($size,$addr,$reg1,$reg2,$idx)=@_;

	my($t,$post);

	my($ret)="[";

	my($ret)=$size;

	if ($ret ne "")

		{

		$ret .= " PTR" if ($main'mwerks);

		$ret .= " ";

		}

	$ret .= "[";

	$addr =~ s/^\s+//;

	if ($addr =~ /^(.+)\+(.+)$/)

		{

		$reg2=&conv($1);

		$addr="_$2";

		$addr="$under$2";

		}

	elsif ($addr =~ /^[_a-zA-Z]/)

		{

		$addr="_$addr";

		$addr="$under$addr";

		}



	if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
@@ -152,20 +160,21 @@ sub main'jmp { &out1("jmp",@_); } 
sub main'jmp_ptr { &out1p("jmp",@_); }



# This is a bit of a kludge: declare all branches as 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",@_); }

$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; }
@@ -173,7 +182,7 @@ sub main'pushf { &out0("pushf"); $stack+=4; } 
sub main'popf	{ &out0("popf"); $stack-=4; }

sub main'bswap	{ &out1("bswap",@_); &using486(); }

sub main'not	{ &out1("not",@_); }

sub main'call	{ &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); }

sub main'call	{ &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }

sub main'ret	{ &out0("ret"); }

sub main'nop	{ &out0("nop"); }

sub main'test	{ &out2("test",@_); }
@@ -204,6 +213,11 @@ sub out2 
	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);
@@ -243,7 +257,8 @@ sub using486 


sub main'file

	{

	push(@out, "segment .text use32\n");

	push(@out,".") if ($main'mwerks);

	push(@out,"section\t.text\n");

	}



sub main'function_begin
@@ -252,8 +267,8 @@ sub main'function_begin 


	push(@labels,$func);

	my($tmp)=<<"EOF";

global	_$func

_$func:

global	$under$func

$under$func:

	push	ebp

	push	ebx

	push	esi
@@ -267,8 +282,8 @@ sub main'function_begin_B 
	{

	my($func,$extra)=@_;

	my($tmp)=<<"EOF";

global	_$func

_$func:

global	$under$func

$under$func:

EOF

	push(@out,$tmp);

	$stack=4;
@@ -346,7 +361,7 @@ sub main'label 
	{

	if (!defined($label{$_[0]}))

		{

		$label{$_[0]}="\$${label}${_[0]}";

		$label{$_[0]}="\@${label}${_[0]}";

		$label++;

		}

	return($label{$_[0]});
@@ -356,7 +371,7 @@ sub main'set_label 
	{

	if (!defined($label{$_[0]}))

		{

		$label{$_[0]}="\$${label}${_[0]}";

		$label{$_[0]}="\@${label}${_[0]}";

		$label++;

		}

	push(@out,"$label{$_[0]}:\n");
@@ -364,12 +379,13 @@ sub main'set_label 


sub main'data_word

	{

	push(@out,"\tDD\t".join(',',@_)."\n");

	push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");

	}



sub main'align

	{

	push(@out,"\tALIGN\t$_[0]\n");

	push(@out,".") if ($main'mwerks);

	push(@out,"align\t$_[0]\n");

	}



sub out1p
@@ -387,3 +403,19 @@ sub main'picmeup 
	}



sub main'blindpop { &out1("pop",@_); }



sub main'initseg

	{

	local($f)=@_;

	if ($main'win32)

		{

		local($tmp)=<<___;

segment	.CRT\$XIU data

extern	$under$f

DD	$under$f

___

		push(@out,$tmp);

		}

	}



1;

crypto/perlasm/x86unix.pl

+25 −7
Original line number Diff line number Diff line
@@ -526,7 +526,7 @@ sub main'file_end 
	if ($main'elf && grep {/%[x]*mm[0-7]/i} @out) {

		local($tmp);



		push (@out,"\n.comm\t".$under."OPENSSL_ia32cap,8,4\n");

		push (@out,"\n.comm\t${under}OPENSSL_ia32cap_P,4,4\n");



		push (@out,".section\t.init\n");

		# One can argue that it's wasteful to craft every
@@ -536,7 +536,7 @@ sub main'file_end 
		#

		# $1<<10 sets a reserved bit to signal that variable

		# was initialized already...

		&main'picmeup("edx","OPENSSL_ia32cap");

		&main'picmeup("edx","OPENSSL_ia32cap_P");

		$tmp=<<___;

		cmpl	\$0,(%edx)

		jne	1f
@@ -559,7 +559,6 @@ sub main'file_end 
		.word	0xa20f

		orl	\$1<<10,%edx

		movl	%edx,0(%edi)

		movl	%ecx,4(%edi)

		popl	%ebx

		popl	%edi

	.align	4
@@ -701,13 +700,32 @@ sub main'blindpop { &out1("popl",@_); } 
sub main'initseg

	{

	local($f)=@_;

	local($tmp);

	if ($main'elf)

		{

		local($tmp)=<<___;

.pushsection	.init

		$tmp=<<___;

.section	.init

	call	$under$f

.popsection

___

		push(@out,$tmp);

		}

	elsif ($main'coff)

		{

		$tmp=<<___;	# applies to both Cygwin and Mingw

.section	.ctors

.long	$under$f

___

		}

	elsif ($main'aout)

		{

		$tmp=<<___;	# OpenBSD way...

.text

.globl	${under}_GLOBAL_\$I\$$f

.align	2

${under}_GLOBAL_\$I\$$f

	jmp	$under$f

___

		}

	push(@out,$tmp) if ($tmp);

	}



1;