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().
This commit is contained in:
parent
526975906b
commit
a8c65b400c
@ -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";
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
Loading…
x
Reference in New Issue
Block a user