generic-library/openssl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source 
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().
This commit is contained in:
Andy Polyakov
2004-08-29 16:10:27 +00:00
parent 526975906b
commit a8c65b400c
4 changed files with 109 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
crypto/perlasm/x86asm.pl
View File

@@ -18,7 +18,7 @@ sub main'asm_init
($type,$fn,$i386)=@_; ($type,$fn,$i386)=@_;
$filename=$fn; $filename=$fn;
$elf=$cpp=$coff=$aout=$win32=$netware=0; $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0;
if ( ($type eq "elf")) if ( ($type eq "elf"))
{ $elf=1; require "x86unix.pl"; } { $elf=1; require "x86unix.pl"; }
elsif ( ($type eq "a.out")) elsif ( ($type eq "a.out"))
@@ -32,9 +32,9 @@ sub main'asm_init
elsif ( ($type eq "win32n")) elsif ( ($type eq "win32n"))
{ $win32=1; require "x86nasm.pl"; } { $win32=1; require "x86nasm.pl"; }
elsif ( ($type eq "nw-nasm")) elsif ( ($type eq "nw-nasm"))
{ $netware=1; require "x86nasm_nw.pl"; } { $netware=1; require "x86nasm.pl"; }
elsif ( ($type eq "nw-mwasm")) elsif ( ($type eq "nw-mwasm"))
{ $netware=1; require "x86mwasm_nw.pl"; } { $netware=1; $mwerks=1; require "x86nasm.pl"; }
else else
{ {
print STDERR <<"EOF"; print STDERR <<"EOF";

21
crypto/perlasm/x86ms.pl
View File

@@ -170,8 +170,8 @@ sub main'nop { &out0("nop"); }
sub main'test { &out2("test",@_); } sub main'test { &out2("test",@_); }
sub main'bt { &out2("bt",@_); } sub main'bt { &out2("bt",@_); }
sub main'leave { &out0("leave"); } sub main'leave { &out0("leave"); }
sub main'cpuid { &out0("cpuid"); } sub main'cpuid { &out0("DW\t0A20Fh"); }
sub main'rdtsc { &out0("rdtsc"); } sub main'rdtsc { &out0("DW\t0310Fh"); }
# SSE2 # SSE2
sub main'emms { &out0("emms"); } sub main'emms { &out0("emms"); }
@@ -329,7 +329,7 @@ sub main'file_end
{ {
# try to detect if SSE2 or MMX extensions were used... # try to detect if SSE2 or MMX extensions were used...
if (grep {/xmm[0-7]\s*,/i} @out) { 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) { elsif (grep {/mm[0-7]\s*,/i} @out) {
grep {s/\.[3-7]86/\.686\n\t\.MMX/} @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'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;

94
crypto/perlasm/x86nasm.pl
View File

@@ -3,6 +3,7 @@
package x86nasm; package x86nasm;
$label="L000"; $label="L000";
$under=($main'netware)?'':'_';
%lb=( 'eax', 'al', %lb=( 'eax', 'al',
'ebx', 'bl', 'ebx', 'bl',
@@ -32,7 +33,8 @@ sub main'external_label
{ {
push(@labels,@_); push(@labels,@_);
foreach (@_) { 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 sub main'QWP
{ {
&get_mem("QWORD",@_); &get_mem("",@_);
} }
sub main'BC sub main'BC
{ {
return "BYTE @_"; return (($main'mwerks)?"":"BYTE ")."@_";
} }
sub main'DWC sub main'DWC
{ {
return "DWORD @_"; return (($main'mwerks)?"":"DWORD ")."@_";
} }
sub main'stack_push sub main'stack_push
@@ -91,16 +93,22 @@ sub get_mem
{ {
my($size,$addr,$reg1,$reg2,$idx)=@_; my($size,$addr,$reg1,$reg2,$idx)=@_;
my($t,$post); my($t,$post);
my($ret)="["; my($ret)=$size;
if ($ret ne "")
{
$ret .= " PTR" if ($main'mwerks);
$ret .= " ";
}
$ret .= "[";
$addr =~ s/^\s+//; $addr =~ s/^\s+//;
if ($addr =~ /^(.+)\+(.+)$/) if ($addr =~ /^(.+)\+(.+)$/)
{ {
$reg2=&conv($1); $reg2=&conv($1);
$addr="_$2"; $addr="$under$2";
} }
elsif ($addr =~ /^[_a-zA-Z]/) elsif ($addr =~ /^[_a-zA-Z]/)
{ {
$addr="_$addr"; $addr="$under$addr";
} }
if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
@@ -152,20 +160,21 @@ sub main'jmp { &out1("jmp",@_); }
sub main'jmp_ptr { &out1p("jmp",@_); } sub main'jmp_ptr { &out1p("jmp",@_); }
# This is a bit of a kludge: declare all branches as NEAR. # This is a bit of a kludge: declare all branches as NEAR.
sub main'je { &out1("je NEAR",@_); } $near=($main'mwerks)?'':'NEAR';
sub main'jle { &out1("jle NEAR",@_); } sub main'je { &out1("je $near",@_); }
sub main'jz { &out1("jz NEAR",@_); } sub main'jle { &out1("jle $near",@_); }
sub main'jge { &out1("jge NEAR",@_); } sub main'jz { &out1("jz $near",@_); }
sub main'jl { &out1("jl NEAR",@_); } sub main'jge { &out1("jge $near",@_); }
sub main'ja { &out1("ja NEAR",@_); } sub main'jl { &out1("jl $near",@_); }
sub main'jae { &out1("jae NEAR",@_); } sub main'ja { &out1("ja $near",@_); }
sub main'jb { &out1("jb NEAR",@_); } sub main'jae { &out1("jae $near",@_); }
sub main'jbe { &out1("jbe NEAR",@_); } sub main'jb { &out1("jb $near",@_); }
sub main'jc { &out1("jc NEAR",@_); } sub main'jbe { &out1("jbe $near",@_); }
sub main'jnc { &out1("jnc NEAR",@_); } sub main'jc { &out1("jc $near",@_); }
sub main'jnz { &out1("jnz NEAR",@_); } sub main'jnc { &out1("jnc $near",@_); }
sub main'jne { &out1("jne NEAR",@_); } sub main'jnz { &out1("jnz $near",@_); }
sub main'jno { &out1("jno NEAR",@_); } sub main'jne { &out1("jne $near",@_); }
sub main'jno { &out1("jno $near",@_); }
sub main'push { &out1("push",@_); $stack+=4; } sub main'push { &out1("push",@_); $stack+=4; }
sub main'pop { &out1("pop",@_); $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'popf { &out0("popf"); $stack-=4; }
sub main'bswap { &out1("bswap",@_); &using486(); } sub main'bswap { &out1("bswap",@_); &using486(); }
sub main'not { &out1("not",@_); } 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'ret { &out0("ret"); }
sub main'nop { &out0("nop"); } sub main'nop { &out0("nop"); }
sub main'test { &out2("test",@_); } sub main'test { &out2("test",@_); }
@@ -204,6 +213,11 @@ sub out2
my($l,$t); my($l,$t);
push(@out,"\t$name\t"); push(@out,"\t$name\t");
if (!$main'mwerks and $name eq "lea")
{
$p1 =~ s/^[^\[]*\[/\[/;
$p2 =~ s/^[^\[]*\[/\[/;
}
$t=&conv($p1).","; $t=&conv($p1).",";
$l=length($t); $l=length($t);
push(@out,$t); push(@out,$t);
@@ -243,7 +257,8 @@ sub using486
sub main'file sub main'file
{ {
push(@out, "segment .text use32\n"); push(@out,".") if ($main'mwerks);
push(@out,"section\t.text\n");
} }
sub main'function_begin sub main'function_begin
@@ -252,8 +267,8 @@ sub main'function_begin
push(@labels,$func); push(@labels,$func);
my($tmp)=<<"EOF"; my($tmp)=<<"EOF";
global _$func global $under$func
_$func: $under$func:
push ebp push ebp
push ebx push ebx
push esi push esi
@@ -267,8 +282,8 @@ sub main'function_begin_B
{ {
my($func,$extra)=@_; my($func,$extra)=@_;
my($tmp)=<<"EOF"; my($tmp)=<<"EOF";
global _$func global $under$func
_$func: $under$func:
EOF EOF
push(@out,$tmp); push(@out,$tmp);
$stack=4; $stack=4;
@@ -346,7 +361,7 @@ sub main'label
{ {
if (!defined($label{$_[0]})) if (!defined($label{$_[0]}))
{ {
$label{$_[0]}="\$${label}${_[0]}"; $label{$_[0]}="\@${label}${_[0]}";
$label++; $label++;
} }
return($label{$_[0]}); return($label{$_[0]});
@@ -356,7 +371,7 @@ sub main'set_label
{ {
if (!defined($label{$_[0]})) if (!defined($label{$_[0]}))
{ {
$label{$_[0]}="\$${label}${_[0]}"; $label{$_[0]}="\@${label}${_[0]}";
$label++; $label++;
} }
push(@out,"$label{$_[0]}:\n"); push(@out,"$label{$_[0]}:\n");
@@ -364,12 +379,13 @@ sub main'set_label
sub main'data_word sub main'data_word
{ {
push(@out,"\tDD\t".join(',',@_)."\n"); push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
} }
sub main'align sub main'align
{ {
push(@out,"\tALIGN\t$_[0]\n"); push(@out,".") if ($main'mwerks);
push(@out,"align\t$_[0]\n");
} }
sub out1p sub out1p
@@ -387,3 +403,19 @@ sub main'picmeup
} }
sub main'blindpop { &out1("pop",@_); } 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;

32
crypto/perlasm/x86unix.pl
View File

@@ -526,7 +526,7 @@ sub main'file_end
if ($main'elf && grep {/%[x]*mm[0-7]/i} @out) { if ($main'elf && grep {/%[x]*mm[0-7]/i} @out) {
local($tmp); 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"); push (@out,".section\t.init\n");
# One can argue that it's wasteful to craft every # 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 # $1<<10 sets a reserved bit to signal that variable
# was initialized already... # was initialized already...
&main'picmeup("edx","OPENSSL_ia32cap"); &main'picmeup("edx","OPENSSL_ia32cap_P");
$tmp=<<___; $tmp=<<___;
cmpl \$0,(%edx) cmpl \$0,(%edx)
jne 1f jne 1f
@@ -559,7 +559,6 @@ sub main'file_end
.word 0xa20f .word 0xa20f
orl \$1<<10,%edx orl \$1<<10,%edx
movl %edx,0(%edi) movl %edx,0(%edi)
movl %ecx,4(%edi)
popl %ebx popl %ebx
popl %edi popl %edi
.align 4 .align 4
@@ -701,13 +700,32 @@ sub main'blindpop { &out1("popl",@_); }
sub main'initseg sub main'initseg
{ {
local($f)=@_; local($f)=@_;
local($tmp);
if ($main'elf) if ($main'elf)
{ {
local($tmp)=<<___; $tmp=<<___;
.pushsection .init .section .init
call $under$f 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;