From a8c65b400c35659c824447e41e326ed1d48fd134 Mon Sep 17 00:00:00 2001 From: Andy Polyakov Date: Sun, 29 Aug 2004 16:10:27 +0000 Subject: [PATCH] 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(). --- crypto/perlasm/x86asm.pl | 6 +-- crypto/perlasm/x86ms.pl | 21 +++++++-- crypto/perlasm/x86nasm.pl | 94 ++++++++++++++++++++++++++------------- crypto/perlasm/x86unix.pl | 32 ++++++++++--- 4 files changed, 109 insertions(+), 44 deletions(-) diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl index 32eacd2bc2..cf2aee40ec 100644 --- 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 f6e225c644..1de1277920 100644 --- 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 4cb09ddea6..b02de6452a 100644 --- 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 5f65ab4a1b..0fea7c827d 100644 --- 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; -- 2.25.1