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().

diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl
index 32eacd2bc2fcea627d65822dc5f882de775f5717..cf2aee40ecb1584c01bf10e28bf09389509137cd 100644 (file)
--- a/crypto/perlasm/x86asm.pl
+++ b/crypto/perlasm/x86asm.pl
@@ -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";

diff --git a/crypto/perlasm/x86ms.pl b/crypto/perlasm/x86ms.pl
index f6e225c644d85b32ec8be430f887fdd0d3ecc1d1..1de1277920c0a3f50386a7a42003447e8b5fa66e 100644 (file)
--- a/crypto/perlasm/x86ms.pl
+++ b/crypto/perlasm/x86ms.pl
@@ -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;

diff --git a/crypto/perlasm/x86nasm.pl b/crypto/perlasm/x86nasm.pl
index 4cb09ddea6541cbf450938bcf756d98850025217..b02de6452a49c820fb249fecfcd6ff6741544dde 100644 (file)
--- a/crypto/perlasm/x86nasm.pl
+++ b/crypto/perlasm/x86nasm.pl
@@ -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;

diff --git a/crypto/perlasm/x86unix.pl b/crypto/perlasm/x86unix.pl
index 5f65ab4a1b54e1da8f4dbf957a753d69e30ac2ac..0fea7c827debe01ad91c099df53cc5289c72ed48 100644 (file)
--- a/crypto/perlasm/x86unix.pl
+++ b/crypto/perlasm/x86unix.pl
@@ -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;