From: Andy Polyakov Date: Mon, 23 Jul 2007 15:12:20 +0000 (+0000) Subject: Synchronize x86 perlasm with HEAD. X-Git-Tag: FIPS_098_TEST_3~38 X-Git-Url: https://git.librecmc.org/?a=commitdiff_plain;h=0fa79cbe1747e2814f6b2c9fe1be5190fe47b828;p=oweals%2Fopenssl.git Synchronize x86 perlasm with HEAD. --- diff --git a/crypto/perlasm/x86asm.pl b/crypto/perlasm/x86asm.pl index 5979122158..8ae2b7d927 100644 --- a/crypto/perlasm/x86asm.pl +++ b/crypto/perlasm/x86asm.pl @@ -1,130 +1,143 @@ -#!/usr/local/bin/perl +#!/usr/bin/env perl # require 'x86asm.pl'; -# &asm_init("cpp","des-586.pl"); -# XXX -# XXX -# main'asm_finish - -sub main'asm_finish - { - &file_end(); - &asm_finish_cpp() if $cpp; - print &asm_get_output(); - } - -sub main'asm_init - { - ($type,$fn,$i386)=@_; - $filename=$fn; - - $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0; - if ( ($type eq "elf")) - { $elf=1; require "x86unix.pl"; } - elsif ( ($type eq "a.out")) - { $aout=1; require "x86unix.pl"; } - elsif ( ($type eq "coff" or $type eq "gaswin")) - { $coff=1; require "x86unix.pl"; } - elsif ( ($type eq "cpp")) - { $cpp=1; require "x86unix.pl"; } - elsif ( ($type eq "win32")) - { $win32=1; require "x86ms.pl"; } - elsif ( ($type eq "win32n")) - { $win32=1; require "x86nasm.pl"; } - elsif ( ($type eq "nw-nasm")) - { $netware=1; require "x86nasm.pl"; } - elsif ( ($type eq "nw-mwasm")) - { $netware=1; $mwerks=1; require "x86nasm.pl"; } - else - { - print STDERR <<"EOF"; +# &asm_init(,"des-586.pl"[,$i386only]); +# &function_begin("foo"); +# ... +# &function_end("foo"); +# &asm_finish + +# AUTOLOAD is this context has quite unpleasant side effect, namely +# that typos in function calls effectively go to assembler output, +# but on the pros side we don't have to implement one subroutine per +# each opcode... +sub ::AUTOLOAD +{ my $opcode = $AUTOLOAD; + + die "more than 2 arguments passed to $opcode" if ($#_>1); + + $opcode =~ s/.*:://; + if ($opcode =~ /^push/) { $stack+=4; } + elsif ($opcode =~ /^pop/) { $stack-=4; } + + &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD"; +} + +$out=(); +$i386=0; + +sub ::emit +{ my $opcode=shift; + + if ($#_==-1) { push(@out,"\t$opcode\n"); } + else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } +} + +sub ::LB +{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; + $1."l"; +} +sub ::HB +{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; + $1."h"; +} +sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } +sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } +sub ::blindpop { &pop($_[0]); $stack+=4; } +sub ::wparam { &DWP($stack+4*$_[0],"esp"); } +sub ::swtmp { &DWP(4*$_[0],"esp"); } + +sub ::bswap +{ if ($i386) # emulate bswap for i386 + { &comment("bswap @_"); + &xchg(&HB(@_),&LB(@_)); + &ror (@_,16); + &xchg(&HB(@_),&LB(@_)); + } + else + { &generic("bswap",@_); } +} +# These are made-up opcodes introduced over the years essentially +# by ignorance, just alias them to real ones... +sub ::movb { &mov(@_); } +sub ::xorb { &xor(@_); } +sub ::rotl { &rol(@_); } +sub ::rotr { &ror(@_); } +sub ::exch { &xchg(@_); } +sub ::halt { &hlt; } + +sub ::function_begin +{ &function_begin_B(@_); + $stack=4; + &push("ebp"); + &push("ebx"); + &push("esi"); + &push("edi"); +} + +sub ::function_end +{ &pop("edi"); + &pop("esi"); + &pop("ebx"); + &pop("ebp"); + &ret(); + $stack=0; + &function_end_B(@_); +} + +sub ::function_end_A +{ &pop("edi"); + &pop("esi"); + &pop("ebx"); + &pop("ebp"); + &ret(); + $stack+=16; # readjust esp as if we didn't pop anything +} + +sub ::asciz { foreach (@_) { &data_byte(unpack("C*",$_),0); } } + +sub ::asm_finish +{ &file_end(); + print @out; +} + +sub ::asm_init +{ my ($type,$fn,$cpu)=@_; + + $filename=$fn; + $i386=$cpu; + + $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0; + if (($type eq "elf")) + { $elf=1; require "x86unix.pl"; } + elsif (($type eq "a\.out")) + { $aout=1; require "x86unix.pl"; } + elsif (($type eq "coff" or $type eq "gaswin")) + { $coff=1; require "x86unix.pl"; } + elsif (($type eq "win32n")) + { $win32=1; require "x86nasm.pl"; } + elsif (($type eq "nw-nasm")) + { $netware=1; require "x86nasm.pl"; } + elsif (($type eq "nw-mwasm")) + { $netware=1; $mwerks=1; require "x86nasm.pl"; } + else + { print STDERR <<"EOF"; Pick one target type from elf - Linux, FreeBSD, Solaris x86, etc. - a.out - OpenBSD, DJGPP, etc. + a.out - DJGPP, elder OpenBSD, etc. coff - GAS/COFF such as Win32 targets - win32 - Windows 95/Windows NT win32n - Windows 95/Windows NT NASM format nw-nasm - NetWare NASM format nw-mwasm- NetWare Metrowerks Assembler EOF - exit(1); - } - - $pic=0; - for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } - - &asm_init_output(); - -&comment("Don't even think of reading this code"); -&comment("It was automatically generated by $filename"); -&comment("Which is a perl program used to generate the x86 assember for"); -&comment("any of ELF, a.out, COFF, Win32, ..."); -&comment("eric "); -&comment(""); - - $filename =~ s/\.pl$//; - &file($filename); - } - -sub asm_finish_cpp - { - return unless $cpp; - - local($tmp,$i); - foreach $i (&get_labels()) - { - $tmp.="#define $i _$i\n"; - } - print <<"EOF"; -/* Run the C pre-processor over this file with one of the following defined - * ELF - elf object files, - * OUT - a.out object files, - * BSDI - BSDI style a.out object files - * SOL - Solaris style elf - */ - -#define TYPE(a,b) .type a,b -#define SIZE(a,b) .size a,b - -#if defined(OUT) || (defined(BSDI) && !defined(ELF)) -$tmp -#endif - -#ifdef OUT -#define OK 1 -#define ALIGN 4 -#if defined(__CYGWIN__) || defined(__DJGPP__) || (__MINGW32__) -#undef SIZE -#undef TYPE -#define SIZE(a,b) -#define TYPE(a,b) .def a; .scl 2; .type 32; .endef -#endif /* __CYGWIN || __DJGPP */ -#endif - -#if defined(BSDI) && !defined(ELF) -#define OK 1 -#define ALIGN 4 -#undef SIZE -#undef TYPE -#define SIZE(a,b) -#define TYPE(a,b) -#endif - -#if defined(ELF) || defined(SOL) -#define OK 1 -#define ALIGN 16 -#endif - -#ifndef OK -You need to define one of -ELF - elf systems - linux-elf, NetBSD and DG-UX -OUT - a.out systems - linux-a.out and FreeBSD -SOL - solaris systems, which are elf with strange comment lines -BSDI - a.out with a very primative version of as. -#endif - -/* Let the Assembler begin :-) */ -EOF - } + exit(1); + } + + $pic=0; + for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } + + $filename =~ s/\.pl$//; + &file($filename); +} 1; diff --git a/crypto/perlasm/x86ms.pl b/crypto/perlasm/x86ms.pl deleted file mode 100644 index 4badd1fc1c..0000000000 --- a/crypto/perlasm/x86ms.pl +++ /dev/null @@ -1,462 +0,0 @@ -#!/usr/local/bin/perl - -package x86ms; - -$label="L000"; - -%lb=( 'eax', 'al', - 'ebx', 'bl', - 'ecx', 'cl', - 'edx', 'dl', - 'ax', 'al', - 'bx', 'bl', - 'cx', 'cl', - 'dx', 'dl', - ); - -%hb=( 'eax', 'ah', - 'ebx', 'bh', - 'ecx', 'ch', - 'edx', 'dh', - 'ax', 'ah', - 'bx', 'bh', - 'cx', 'ch', - 'dx', 'dh', - ); - -sub main'asm_init_output { @out=(); } -sub main'asm_get_output { return(@out); } -sub main'get_labels { return(@labels); } -sub main'external_label -{ - push(@labels,@_); - foreach (@_) { - push(@out, "EXTRN\t_$_:DWORD\n"); - } -} - -sub main'LB - { - (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; - return($lb{$_[0]}); - } - -sub main'HB - { - (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; - return($hb{$_[0]}); - } - -sub main'BP - { - &get_mem("BYTE",@_); - } - -sub main'DWP - { - &get_mem("DWORD",@_); - } - -sub main'QWP - { - &get_mem("QWORD",@_); - } - -sub main'BC - { - return @_; - } - -sub main'DWC - { - return @_; - } - -sub main'stack_push - { - local($num)=@_; - $stack+=$num*4; - &main'sub("esp",$num*4); - } - -sub main'stack_pop - { - local($num)=@_; - $stack-=$num*4; - &main'add("esp",$num*4); - } - -sub get_mem - { - local($size,$addr,$reg1,$reg2,$idx)=@_; - local($t,$post); - local($ret)="$size PTR "; - - $addr =~ s/^\s+//; - if ($addr =~ /^(.+)\+(.+)$/) - { - $reg2=&conv($1); - $addr="_$2"; - } - elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) - { - $addr="_$addr"; - } - - if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } - - $reg1="$regs{$reg1}" if defined($regs{$reg1}); - $reg2="$regs{$reg2}" if defined($regs{$reg2}); - if (($addr ne "") && ($addr ne 0)) - { - if ($addr !~ /^-/) - { $ret.=$addr; } - else { $post=$addr; } - } - if ($reg2 ne "") - { - $t=""; - $t="*$idx" if ($idx != 0); - $reg1="+".$reg1 if ("$reg1$post" ne ""); - $ret.="[$reg2$t$reg1$post]"; - } - else - { - $ret.="[$reg1$post]" - } - $ret =~ s/\[\]//; # in case $addr was the only argument - return($ret); - } - -sub main'mov { &out2("mov",@_); } -sub main'movb { &out2("mov",@_); } -sub main'and { &out2("and",@_); } -sub main'or { &out2("or",@_); } -sub main'shl { &out2("shl",@_); } -sub main'shr { &out2("shr",@_); } -sub main'xor { &out2("xor",@_); } -sub main'xorb { &out2("xor",@_); } -sub main'add { &out2("add",@_); } -sub main'adc { &out2("adc",@_); } -sub main'sub { &out2("sub",@_); } -sub main'sbb { &out2("sbb",@_); } -sub main'rotl { &out2("rol",@_); } -sub main'rotr { &out2("ror",@_); } -sub main'exch { &out2("xchg",@_); } -sub main'cmp { &out2("cmp",@_); } -sub main'lea { &out2("lea",@_); } -sub main'mul { &out1("mul",@_); } -sub main'div { &out1("div",@_); } -sub main'dec { &out1("dec",@_); } -sub main'inc { &out1("inc",@_); } -sub main'jmp { &out1("jmp",@_); } -sub main'jmp_ptr { &out1p("jmp",@_); } -sub main'je { &out1("je",@_); } -sub main'jle { &out1("jle",@_); } -sub main'jz { &out1("jz",@_); } -sub main'jge { &out1("jge",@_); } -sub main'jl { &out1("jl",@_); } -sub main'ja { &out1("ja",@_); } -sub main'jae { &out1("jae",@_); } -sub main'jb { &out1("jb",@_); } -sub main'jbe { &out1("jbe",@_); } -sub main'jc { &out1("jc",@_); } -sub main'jnc { &out1("jnc",@_); } -sub main'jnz { &out1("jnz",@_); } -sub main'jne { &out1("jne",@_); } -sub main'jno { &out1("jno",@_); } -sub main'push { &out1("push",@_); $stack+=4; } -sub main'pop { &out1("pop",@_); $stack-=4; } -sub main'pushf { &out0("pushfd"); $stack+=4; } -sub main'popf { &out0("popfd"); $stack-=4; } -sub main'bswap { &out1("bswap",@_); &using486(); } -sub main'not { &out1("not",@_); } -sub main'call { &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); } -sub main'call_ptr { &out1p("call",@_); } -sub main'ret { &out0("ret"); } -sub main'nop { &out0("nop"); } -sub main'test { &out2("test",@_); } -sub main'bt { &out2("bt",@_); } -sub main'leave { &out0("leave"); } -sub main'cpuid { &out0("DW\t0A20Fh"); } -sub main'rdtsc { &out0("DW\t0310Fh"); } -sub main'halt { &out0("hlt"); } -sub main'movz { &out2("movzx",@_); } -sub main'neg { &out1("neg",@_); } -sub main'cld { &out0("cld"); } - -# SSE2 -sub main'emms { &out0("emms"); } -sub main'movd { &out2("movd",@_); } -sub main'movq { &out2("movq",@_); } -sub main'movdqu { &out2("movdqu",@_); } -sub main'movdqa { &out2("movdqa",@_); } -sub main'movdq2q{ &out2("movdq2q",@_); } -sub main'movq2dq{ &out2("movq2dq",@_); } -sub main'paddq { &out2("paddq",@_); } -sub main'pmuludq{ &out2("pmuludq",@_); } -sub main'psrlq { &out2("psrlq",@_); } -sub main'psllq { &out2("psllq",@_); } -sub main'pxor { &out2("pxor",@_); } -sub main'por { &out2("por",@_); } -sub main'pand { &out2("pand",@_); } - -sub out2 - { - local($name,$p1,$p2)=@_; - local($l,$t,$line); - - $line="\t$name\t"; - $t=&conv($p1).","; - $l=length($t); - $line.="$t"; - $l=4-($l+9)/8; - $line.="\t" x $l; - $line.=&conv($p2); - if ($line=~/\bxmm[0-7]\b/i) { $line=~s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i; } - push(@out,$line."\n"); - } - -sub out0 - { - local($name)=@_; - - push(@out,"\t$name\n"); - } - -sub out1 - { - local($name,$p1)=@_; - local($l,$t); - - push(@out,"\t$name\t".&conv($p1)."\n"); - } - -sub conv - { - local($p)=@_; - - $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; - return $p; - } - -sub using486 - { - return if $using486; - $using486++; - grep(s/\.386/\.486/,@out); - } - -sub main'file - { - local($file)=@_; - - local($tmp)=<<"EOF"; - TITLE $file.asm - .386 -.model FLAT -_TEXT\$ SEGMENT PAGE 'CODE' - -EOF - push(@out,$tmp); - } - -sub main'function_begin - { - local($func,$extra)=@_; - - push(@labels,$func); - - local($tmp)=<<"EOF"; -PUBLIC _$func -$extra -_$func PROC NEAR - push ebp - push ebx - push esi - push edi -EOF - push(@out,$tmp); - $stack=20; - } - -sub main'function_begin_B - { - local($func,$extra)=@_; - - local($tmp)=<<"EOF"; -PUBLIC _$func -$extra -_$func PROC NEAR -EOF - push(@out,$tmp); - $stack=4; - } - -sub main'function_end - { - local($func)=@_; - - local($tmp)=<<"EOF"; - pop edi - pop esi - pop ebx - pop ebp - ret -_$func ENDP -EOF - push(@out,$tmp); - $stack=0; - %label=(); - } - -sub main'function_end_B - { - local($func)=@_; - - local($tmp)=<<"EOF"; -_$func ENDP -EOF - push(@out,$tmp); - $stack=0; - %label=(); - } - -sub main'function_end_A - { - local($func)=@_; - - local($tmp)=<<"EOF"; - pop edi - pop esi - pop ebx - pop ebp - ret -EOF - push(@out,$tmp); - } - -sub main'file_end - { - # try to detect if SSE2 or MMX extensions were used... - if (grep {/\b[x]?mm[0-7]\b,/i} @out) { - grep {s/\.[3-7]86/\.686\n\t\.XMM/} @out; - } - push(@out,"_TEXT\$ ENDS\n"); - push(@out,"END\n"); - } - -sub main'wparam - { - local($num)=@_; - - return(&main'DWP($stack+$num*4,"esp","",0)); - } - -sub main'swtmp - { - return(&main'DWP($_[0]*4,"esp","",0)); - } - -# Should use swtmp, which is above esp. Linix can trash the stack above esp -#sub main'wtmp -# { -# local($num)=@_; -# -# return(&main'DWP(-(($num+1)*4),"esp","",0)); -# } - -sub main'comment - { - foreach (@_) - { - push(@out,"\t; $_\n"); - } - } - -sub main'public_label - { - $label{$_[0]}="_$_[0]" if (!defined($label{$_[0]})); - push(@out,"PUBLIC\t$label{$_[0]}\n"); - } - -sub main'label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="\$${label}${_[0]}"; - $label++; - } - return($label{$_[0]}); - } - -sub main'set_label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="\$${label}${_[0]}"; - $label++; - } - if ($_[1]!=0 && $_[1]>1) - { - main'align($_[1]); - } - if((defined $_[2]) && ($_[2] == 1)) - { - push(@out,"$label{$_[0]}::\n"); - } - elsif ($label{$_[0]} !~ /^\$/) - { - push(@out,"$label{$_[0]}\tLABEL PTR\n"); - } - else - { - push(@out,"$label{$_[0]}:\n"); - } - } - -sub main'data_byte - { - push(@out,"\tDB\t".join(',',@_)."\n"); - } - -sub main'data_word - { - push(@out,"\tDD\t".join(',',@_)."\n"); - } - -sub main'align - { - push(@out,"\tALIGN\t$_[0]\n"); - } - -sub out1p - { - local($name,$p1)=@_; - local($l,$t); - - push(@out,"\t$name\t".&conv($p1)."\n"); - } - -sub main'picmeup - { - local($dst,$sym)=@_; - &main'lea($dst,&main'DWP($sym)); - } - -sub main'blindpop { &out1("pop",@_); } - -sub main'initseg - { - local($f)=@_; - local($tmp)=<<___; -OPTION DOTNAME -.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' -EXTRN _$f:NEAR -DD _$f -.CRT\$XCU ENDS -___ - push(@out,$tmp); - } - -1; diff --git a/crypto/perlasm/x86nasm.pl b/crypto/perlasm/x86nasm.pl index b6dfcbdf02..c93b811e3b 100644 --- a/crypto/perlasm/x86nasm.pl +++ b/crypto/perlasm/x86nasm.pl @@ -1,451 +1,228 @@ -#!/usr/local/bin/perl +#!/usr/bin/env perl package x86nasm; -$label="L000"; -$under=($main'netware)?'':'_'; +*out=\@::out; -%lb=( 'eax', 'al', - 'ebx', 'bl', - 'ecx', 'cl', - 'edx', 'dl', - 'ax', 'al', - 'bx', 'bl', - 'cx', 'cl', - 'dx', 'dl', - ); +$lprfx="\@L"; +$label="000"; +$under=($::netware)?'':'_'; -%hb=( 'eax', 'ah', - 'ebx', 'bh', - 'ecx', 'ch', - 'edx', 'dh', - 'ax', 'ah', - 'bx', 'bh', - 'cx', 'ch', - 'dx', 'dh', - ); +sub ::generic +{ my $opcode=shift; + my $tmp; -sub main'asm_init_output { @out=(); } -sub main'asm_get_output { return(@out); } -sub main'get_labels { return(@labels); } - -sub main'external_label -{ - push(@labels,@_); - foreach (@_) { - push(@out,".") if ($main'mwerks); - push(@out, "extern\t${under}$_\n"); - } + if (!$::mwerks) + { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps + { $_[0] = "NEAR $_[0]"; } + elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea + { $_[1] =~ s/^[^\[]*\[/\[/o; } + } + &::emit($opcode,@_); + 1; } - -sub main'LB - { - (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; - return($lb{$_[0]}); - } - -sub main'HB - { - (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; - return($hb{$_[0]}); - } - -sub main'BP - { - &get_mem("BYTE",@_); - } - -sub main'DWP - { - &get_mem("DWORD",@_); - } - -sub main'QWP - { - &get_mem("",@_); - } - -sub main'BC - { - return (($main'mwerks)?"":"BYTE ")."@_"; - } - -sub main'DWC - { - return (($main'mwerks)?"":"DWORD ")."@_"; - } - -sub main'stack_push - { - my($num)=@_; - $stack+=$num*4; - &main'sub("esp",$num*4); - } - -sub main'stack_pop - { - my($num)=@_; - $stack-=$num*4; - &main'add("esp",$num*4); - } +# +# opcodes not covered by ::generic above, mostly inconsistent namings... +# +sub ::movz { &::movzx(@_); } +sub ::pushf { &::pushfd; } +sub ::popf { &::popfd; } + +sub ::call { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); } +sub ::call_ptr { &::emit("call",@_); } +sub ::jmp_ptr { &::emit("jmp",@_); } + +# chosen SSE instructions +sub ::movq +{ my($p1,$p2,$optimize)=@_; + + if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) + # movq between mmx registers can sink Intel CPUs + { &::pshufw($p1,$p2,0xe4); } + else + { &::emit("movq",@_); } +} +sub ::pshufw { &::emit("pshufw",@_); } sub get_mem - { - my($size,$addr,$reg1,$reg2,$idx)=@_; - my($t,$post); - my($ret)=$size; - if ($ret ne "") - { - $ret .= " PTR" if ($main'mwerks); - $ret .= " "; - } - $ret .= "["; - $addr =~ s/^\s+//; - if ($addr =~ /^(.+)\+(.+)$/) - { - $reg2=&conv($1); - $addr="$under$2"; - } - elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i) - { - $addr="$under$addr"; - } - - if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; } - - $reg1="$regs{$reg1}" if defined($regs{$reg1}); - $reg2="$regs{$reg2}" if defined($regs{$reg2}); - if (($addr ne "") && ($addr ne 0)) - { - if ($addr !~ /^-/) - { $ret.="${addr}+"; } - else { $post=$addr; } - } - if ($reg2 ne "") - { - $t=""; - $t="*$idx" if ($idx != 0); - $reg1="+".$reg1 if ("$reg1$post" ne ""); - $ret.="$reg2$t$reg1$post]"; - } - else - { - $ret.="$reg1$post]" - } - $ret =~ s/\+\]/]/; # in case $addr was the only argument - return($ret); - } - -sub main'mov { &out2("mov",@_); } -sub main'movb { &out2("mov",@_); } -sub main'and { &out2("and",@_); } -sub main'or { &out2("or",@_); } -sub main'shl { &out2("shl",@_); } -sub main'shr { &out2("shr",@_); } -sub main'xor { &out2("xor",@_); } -sub main'xorb { &out2("xor",@_); } -sub main'add { &out2("add",@_); } -sub main'adc { &out2("adc",@_); } -sub main'sub { &out2("sub",@_); } -sub main'sbb { &out2("sbb",@_); } -sub main'rotl { &out2("rol",@_); } -sub main'rotr { &out2("ror",@_); } -sub main'exch { &out2("xchg",@_); } -sub main'cmp { &out2("cmp",@_); } -sub main'lea { &out2("lea",@_); } -sub main'mul { &out1("mul",@_); } -sub main'div { &out1("div",@_); } -sub main'dec { &out1("dec",@_); } -sub main'inc { &out1("inc",@_); } -sub main'jmp { &out1("jmp",@_); } -sub main'jmp_ptr { &out1p("jmp",@_); } - -# This is a bit of a kludge: declare all branches as 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; } -sub main'pushf { &out0("pushfd"); $stack+=4; } -sub main'popf { &out0("popfd"); $stack-=4; } -sub main'bswap { &out1("bswap",@_); &using486(); } -sub main'not { &out1("not",@_); } -sub main'call { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); } -sub main'call_ptr { &out1p("call",@_); } -sub main'ret { &out0("ret"); } -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'halt { &out0("hlt"); } -sub main'movz { &out2("movzx",@_); } -sub main'neg { &out1("neg",@_); } -sub main'cld { &out0("cld"); } - -# SSE2 -sub main'emms { &out0("emms"); } -sub main'movd { &out2("movd",@_); } -sub main'movq { &out2("movq",@_); } -sub main'movdqu { &out2("movdqu",@_); } -sub main'movdqa { &out2("movdqa",@_); } -sub main'movdq2q{ &out2("movdq2q",@_); } -sub main'movq2dq{ &out2("movq2dq",@_); } -sub main'paddq { &out2("paddq",@_); } -sub main'pmuludq{ &out2("pmuludq",@_); } -sub main'psrlq { &out2("psrlq",@_); } -sub main'psllq { &out2("psllq",@_); } -sub main'pxor { &out2("pxor",@_); } -sub main'por { &out2("por",@_); } -sub main'pand { &out2("pand",@_); } - -sub out2 - { - my($name,$p1,$p2)=@_; - 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); - $l=4-($l+9)/8; - push(@out,"\t" x $l); - push(@out,&conv($p2)); - push(@out,"\n"); - } - -sub out0 - { - my($name)=@_; - - push(@out,"\t$name\n"); - } - -sub out1 - { - my($name,$p1)=@_; - my($l,$t); - push(@out,"\t$name\t".&conv($p1)."\n"); - } - -sub conv - { - my($p)=@_; - $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; - return $p; - } - -sub using486 - { - return if $using486; - $using486++; - grep(s/\.386/\.486/,@out); - } - -sub main'file - { - if ($main'mwerks) { push(@out,".section\t.text\n"); } - else { - local $tmp=<<___; +{ my($size,$addr,$reg1,$reg2,$idx)=@_; + my($post,$ret); + + if ($size ne "") + { $ret .= "$size"; + $ret .= " PTR" if ($::mwerks); + $ret .= " "; + } + $ret .= "["; + + $addr =~ s/^\s+//; + # prepend global references with optional underscore + $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige; + # put address arithmetic expression in parenthesis + $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); + + if (($addr ne "") && ($addr ne 0)) + { if ($addr !~ /^-/) { $ret .= "$addr+"; } + else { $post=$addr; } + } + + if ($reg2 ne "") + { $idx!=0 or $idx=1; + $ret .= "$reg2*$idx"; + $ret .= "+$reg1" if ($reg1 ne ""); + } + else + { $ret .= "$reg1"; } + + $ret .= "$post]"; + $ret =~ s/\+\]/]/; # in case $addr was the only argument + + $ret; +} +sub ::BP { &get_mem("BYTE",@_); } +sub ::DWP { &get_mem("DWORD",@_); } +sub ::QWP { &get_mem("",@_); } +sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } +sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } + +sub ::file +{ if ($::mwerks) { push(@out,".section\t.text\n"); } + else + { my $tmp=<<___; %ifdef __omf__ -section code use32 class=code +section code use32 class=code align=64 %else -section .text +section .text code align=64 %endif ___ - push(@out,$tmp); - } - } - -sub main'function_begin - { - my($func,$extra)=@_; - - push(@labels,$func); - my($tmp)=<<"EOF"; -global $under$func -$under$func: - push ebp - push ebx - push esi - push edi -EOF push(@out,$tmp); - $stack=20; - } - -sub main'function_begin_B - { - my($func,$extra)=@_; - my($tmp)=<<"EOF"; -global $under$func -$under$func: -EOF - push(@out,$tmp); - $stack=4; - } + } +} -sub main'function_end - { - my($func)=@_; +sub ::function_begin_B +{ my $func=$under.shift; + my $tmp=<<___; +global $func +align 16 +$func: +___ + push(@out,$tmp); + $::stack=4; +} +sub ::function_end_B +{ my $i; + foreach $i (%label) { undef $label{$i} if ($label{$i} =~ /^$prfx/); } + $::stack=0; +} - my($tmp)=<<"EOF"; - pop edi - pop esi +sub ::file_end +{ # try to detect if SSE2 or MMX extensions were used on Win32... + if ($::win32 && grep {/\s+[x]*mm[0-7]/i} @out) + { # One can argue that it's wasteful to craft every + # SSE/MMX module with this snippet... Well, it's 72 + # bytes long and for the moment we have two modules. + # Let's argue when we have 7 modules or so... + # + # $1<<10 sets a reserved bit to signal that variable + # was initialized already... + my $tmp=<<___; +align 16 +${lprfx}OPENSSL_ia32cap_init: + lea edx,[${under}OPENSSL_ia32cap_P] + cmp DWORD [edx],0 + jne NEAR ${lprfx}nocpuid + mov DWORD [edx],1<<10 + pushfd + pop eax + mov ecx,eax + xor eax,1<<21 + push eax + popfd + pushfd + pop eax + xor eax,ecx + bt eax,21 + jnc NEAR ${lprfx}nocpuid + push edi + push ebx + mov edi,edx + mov eax,1 + cpuid + or edx,1<<10 + mov DWORD [edi],edx pop ebx - pop ebp - ret -EOF - push(@out,$tmp); - $stack=0; - %label=(); - } - -sub main'function_end_B - { - $stack=0; - %label=(); - } - -sub main'function_end_A - { - my($func)=@_; - - my($tmp)=<<"EOF"; pop edi - pop esi - pop ebx - pop ebp +${lprfx}nocpuid: ret -EOF - push(@out,$tmp); - } -sub main'file_end - { - } - -sub main'wparam - { - my($num)=@_; - - return(&main'DWP($stack+$num*4,"esp","",0)); - } - -sub main'swtmp - { - return(&main'DWP($_[0]*4,"esp","",0)); - } - -# Should use swtmp, which is above esp. Linix can trash the stack above esp -#sub main'wtmp -# { -# my($num)=@_; -# -# return(&main'DWP(-(($num+1)*4),"esp","",0)); -# } - -sub main'comment - { - foreach (@_) - { - push(@out,"\t; $_\n"); - } - } +segment .CRT\$XCU data align=4 +dd ${lprfx}OPENSSL_ia32cap_init +segment .bss +common ${under}OPENSSL_ia32cap_P 4 +___ + # comment out OPENSSL_ia32cap_P declarations + grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out; + push (@out,$tmp); + } +} -sub main'public_label - { - $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); - push(@out,"global\t$label{$_[0]}\n"); - } +sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } -sub main'label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="\@${label}${_[0]}"; - $label++; - } - return($label{$_[0]}); - } +sub islabel # see is argument is known label +{ my $i; + foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); } + undef; +} -sub main'set_label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="\@${label}${_[0]}"; - $label++; - } - if ($_[1]!=0 && $_[1]>1) - { - main'align($_[1]); - } - push(@out,"$label{$_[0]}:\n"); - } +sub ::external_label +{ push(@labels,@_); + foreach (@_) + { push(@out,".") if ($::mwerks); + push(@out, "extern\t${under}$_\n"); + } +} -sub main'data_byte - { - push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n"); - } +sub ::public_label +{ $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); + push(@out,"global\t$label{$_[0]}\n"); +} -sub main'data_word - { - push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); - } +sub ::label +{ if (!defined($label{$_[0]})) + { $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++; } + $label{$_[0]}; +} -sub main'align - { - push(@out,".") if ($main'mwerks); - push(@out,"align\t$_[0]\n"); - } +sub ::set_label +{ my $label=&::label($_[0]); + &::align($_[1]) if ($_[1]>1); + push(@out,"$label{$_[0]}:\n"); +} -sub out1p - { - my($name,$p1)=@_; - my($l,$t); +sub ::data_byte +{ push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } - push(@out,"\t$name\t".&conv($p1)."\n"); - } +sub ::data_word +{ push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } -sub main'picmeup - { - local($dst,$sym)=@_; - &main'lea($dst,&main'DWP($sym)); - } +sub ::align +{ push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); } -sub main'blindpop { &out1("pop",@_); } +sub ::picmeup +{ my($dst,$sym)=@_; + &::lea($dst,&::DWP($sym)); +} -sub main'initseg - { - local($f)=@_; - if ($main'win32) - { - local($tmp)=<<___; -segment .CRT\$XCU data -extern $under$f -DD $under$f +sub ::initseg +{ my($f)=$under.shift; + if ($::win32) + { my($tmp)=<<___; +segment .CRT\$XCU rdata align=4 +extern $f +dd $f ___ - push(@out,$tmp); - } - } + push(@out,$tmp); + } +} 1; diff --git a/crypto/perlasm/x86unix.pl b/crypto/perlasm/x86unix.pl index e71050b6bc..2b9e96c8db 100644 --- a/crypto/perlasm/x86unix.pl +++ b/crypto/perlasm/x86unix.pl @@ -1,499 +1,154 @@ -#!/usr/local/bin/perl +#!/usr/bin/env perl package x86unix; # GAS actually... +*out=\@::out; + $label="L000"; $const=""; $constl=0; -$align=($main'aout)?"4":"16"; -$under=($main'aout or $main'coff)?"_":""; -$dot=($main'aout)?"":"."; -$com_start="#" if ($main'aout or $main'coff); - -sub main'asm_init_output { @out=(); } -sub main'asm_get_output { return(@out); } -sub main'get_labels { return(@labels); } -sub main'external_label { push(@labels,@_); } - -if ($main'cpp) - { - $align="ALIGN"; - $under=""; - $com_start='/*'; - $com_end='*/'; - } - -%lb=( 'eax', '%al', - 'ebx', '%bl', - 'ecx', '%cl', - 'edx', '%dl', - 'ax', '%al', - 'bx', '%bl', - 'cx', '%cl', - 'dx', '%dl', - ); - -%hb=( 'eax', '%ah', - 'ebx', '%bh', - 'ecx', '%ch', - 'edx', '%dh', - 'ax', '%ah', - 'bx', '%bh', - 'cx', '%ch', - 'dx', '%dh', - ); - -%regs=( 'eax', '%eax', - 'ebx', '%ebx', - 'ecx', '%ecx', - 'edx', '%edx', - 'esi', '%esi', - 'edi', '%edi', - 'ebp', '%ebp', - 'esp', '%esp', - - 'mm0', '%mm0', - 'mm1', '%mm1', - 'mm2', '%mm2', - 'mm3', '%mm3', - 'mm4', '%mm4', - 'mm5', '%mm5', - 'mm6', '%mm6', - 'mm7', '%mm7', - - 'xmm0', '%xmm0', - 'xmm1', '%xmm1', - 'xmm2', '%xmm2', - 'xmm3', '%xmm3', - 'xmm4', '%xmm4', - 'xmm5', '%xmm5', - 'xmm6', '%xmm6', - 'xmm7', '%xmm7', - ); - -%reg_val=( - 'eax', 0x00, - 'ebx', 0x03, - 'ecx', 0x01, - 'edx', 0x02, - 'esi', 0x06, - 'edi', 0x07, - 'ebp', 0x05, - 'esp', 0x04, - ); - -sub main'LB - { - (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n"; - return($lb{$_[0]}); - } - -sub main'HB - { - (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n"; - return($hb{$_[0]}); - } - -sub main'DWP - { - local($addr,$reg1,$reg2,$idx)=@_; - - $ret=""; - $addr =~ s/(^|[+ \t])([A-Za-z_]+[A-Za-z0-9_]+)($|[+ \t])/$1$under$2$3/; - $reg1="$regs{$reg1}" if defined($regs{$reg1}); - $reg2="$regs{$reg2}" if defined($regs{$reg2}); - $ret.=$addr if ($addr ne "") && ($addr ne 0); - if ($reg2 ne "") - { - if($idx ne "" && $idx != 0) - { $ret.="($reg1,$reg2,$idx)"; } - else - { $ret.="($reg1,$reg2)"; } - } - elsif ($reg1 ne "") - { $ret.="($reg1)" } - return($ret); - } - -sub main'QWP - { - return(&main'DWP(@_)); - } - -sub main'BP - { - return(&main'DWP(@_)); - } - -sub main'BC - { - return @_; - } - -sub main'DWC - { - return @_; - } - -#sub main'BP -# { -# local($addr,$reg1,$reg2,$idx)=@_; +$align=($::aout)?"4":"16"; +$under=($::aout or $::coff)?"_":""; +$dot=($::aout)?"":"."; +$com_start="#" if ($::aout or $::coff); + +sub opsize() +{ my $reg=shift; + if ($reg =~ m/^%e/o) { "l"; } + elsif ($reg =~ m/^%[a-d][hl]$/o) { "b"; } + elsif ($reg =~ m/^%[xm]/o) { undef; } + else { "w"; } +} + +# swap arguments; +# expand opcode with size suffix; +# prefix numeric constants with $; +sub ::generic +{ my($opcode,$dst,$src)=@_; + my($tmp,$suffix,@arg); + + if (defined($src)) + { $src =~ s/^(e?[a-dsixphl]{2})$/%$1/o; + $src =~ s/^(x?mm[0-7])$/%$1/o; + $src =~ s/^(\-?[0-9]+)$/\$$1/o; + $src =~ s/^(\-?0x[0-9a-f]+)$/\$$1/o; + push(@arg,$src); + } + if (defined($dst)) + { $dst =~ s/^(\*?)(e?[a-dsixphl]{2})$/$1%$2/o; + $dst =~ s/^(x?mm[0-7])$/%$1/o; + $dst =~ s/^(\-?[0-9]+)$/\$$1/o if(!defined($src)); + $dst =~ s/^(\-?0x[0-9a-f]+)$/\$$1/o if(!defined($src)); + push(@arg,$dst); + } + + if ($dst =~ m/^%/o) { $suffix=&opsize($dst); } + elsif ($src =~ m/^%/o) { $suffix=&opsize($src); } + else { $suffix="l"; } + undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o); + + if ($#_==0) { &::emit($opcode); } + elsif ($opcode =~ m/^j/o && $#_==1) { &::emit($opcode,@arg); } + elsif ($opcode eq "call" && $#_==1) { &::emit($opcode,@arg); } + elsif ($opcode =~ m/^set/&& $#_==1) { &::emit($opcode,@arg); } + else { &::emit($opcode.$suffix,@arg);} + + 1; +} # -# $ret=""; +# opcodes not covered by ::generic above, mostly inconsistent namings... # -# $addr =~ s/(^|[+ \t])([A-Za-z_]+)($|[+ \t])/$1$under$2$3/; -# $reg1="$regs{$reg1}" if defined($regs{$reg1}); -# $reg2="$regs{$reg2}" if defined($regs{$reg2}); -# $ret.=$addr if ($addr ne "") && ($addr ne 0); -# if ($reg2 ne "") -# { $ret.="($reg1,$reg2,$idx)"; } -# else -# { $ret.="($reg1)" } -# return($ret); -# } - -sub main'mov { &out2("movl",@_); } -sub main'movb { &out2("movb",@_); } -sub main'and { &out2("andl",@_); } -sub main'or { &out2("orl",@_); } -sub main'shl { &out2("sall",@_); } -sub main'shr { &out2("shrl",@_); } -sub main'xor { &out2("xorl",@_); } -sub main'xorb { &out2("xorb",@_); } -sub main'add { &out2($_[0]=~/%[a-d][lh]/?"addb":"addl",@_); } -sub main'adc { &out2("adcl",@_); } -sub main'sub { &out2("subl",@_); } -sub main'sbb { &out2("sbbl",@_); } -sub main'rotl { &out2("roll",@_); } -sub main'rotr { &out2("rorl",@_); } -sub main'exch { &out2($_[0]=~/%[a-d][lh]/?"xchgb":"xchgl",@_); } -sub main'cmp { &out2("cmpl",@_); } -sub main'lea { &out2("leal",@_); } -sub main'mul { &out1("mull",@_); } -sub main'div { &out1("divl",@_); } -sub main'jmp { &out1("jmp",@_); } -sub main'jmp_ptr { &out1p("jmp",@_); } -sub main'je { &out1("je",@_); } -sub main'jle { &out1("jle",@_); } -sub main'jne { &out1("jne",@_); } -sub main'jnz { &out1("jnz",@_); } -sub main'jz { &out1("jz",@_); } -sub main'jge { &out1("jge",@_); } -sub main'jl { &out1("jl",@_); } -sub main'ja { &out1("ja",@_); } -sub main'jae { &out1("jae",@_); } -sub main'jb { &out1("jb",@_); } -sub main'jbe { &out1("jbe",@_); } -sub main'jc { &out1("jc",@_); } -sub main'jnc { &out1("jnc",@_); } -sub main'jno { &out1("jno",@_); } -sub main'dec { &out1("decl",@_); } -sub main'inc { &out1($_[0]=~/%[a-d][hl]/?"incb":"incl",@_); } -sub main'push { &out1("pushl",@_); $stack+=4; } -sub main'pop { &out1("popl",@_); $stack-=4; } -sub main'pushf { &out0("pushfl"); $stack+=4; } -sub main'popf { &out0("popfl"); $stack-=4; } -sub main'not { &out1("notl",@_); } -sub main'call { my $pre=$under; - foreach $i (%label) - { if ($label{$i} eq $_[0]) { $pre=''; last; } } - &out1("call",$pre.$_[0]); - } -sub main'call_ptr { &out1p("call",@_); } -sub main'ret { &out0("ret"); } -sub main'nop { &out0("nop"); } -sub main'test { &out2("testl",@_); } -sub main'bt { &out2("btl",@_); } -sub main'leave { &out0("leave"); } -sub main'cpuid { &out0(".byte\t0x0f,0xa2"); } -sub main'rdtsc { &out0(".byte\t0x0f,0x31"); } -sub main'halt { &out0("hlt"); } -sub main'movz { &out2("movzbl",@_); } -sub main'neg { &out1("negl",@_); } -sub main'cld { &out0("cld"); } - -# SSE2 -sub main'emms { &out0("emms"); } -sub main'movd { &out2("movd",@_); } -sub main'movdqu { &out2("movdqu",@_); } -sub main'movdqa { &out2("movdqa",@_); } -sub main'movdq2q{ &out2("movdq2q",@_); } -sub main'movq2dq{ &out2("movq2dq",@_); } -sub main'paddq { &out2("paddq",@_); } -sub main'pmuludq{ &out2("pmuludq",@_); } -sub main'psrlq { &out2("psrlq",@_); } -sub main'psllq { &out2("psllq",@_); } -sub main'pxor { &out2("pxor",@_); } -sub main'por { &out2("por",@_); } -sub main'pand { &out2("pand",@_); } -sub main'movq { - local($p1,$p2,$optimize)=@_; - if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) - # movq between mmx registers can sink Intel CPUs - { push(@out,"\tpshufw\t\$0xe4,%$p2,%$p1\n"); } - else { &out2("movq",@_); } - } - -# The bswapl instruction is new for the 486. Emulate if i386. -sub main'bswap - { - if ($main'i386) - { - &main'comment("bswapl @_"); - &main'exch(main'HB(@_),main'LB(@_)); - &main'rotr(@_,16); - &main'exch(main'HB(@_),main'LB(@_)); - } - else - { - &out1("bswapl",@_); - } - } - -sub out2 - { - local($name,$p1,$p2)=@_; - local($l,$ll,$t); - local(%special)=( "roll",0xD1C0,"rorl",0xD1C8, - "rcll",0xD1D0,"rcrl",0xD1D8, - "shll",0xD1E0,"shrl",0xD1E8, - "sarl",0xD1F8); - - if ((defined($special{$name})) && defined($regs{$p1}) && ($p2 == 1)) - { - $op=$special{$name}|$reg_val{$p1}; - $tmp1=sprintf(".byte %d\n",($op>>8)&0xff); - $tmp2=sprintf(".byte %d\t",$op &0xff); - push(@out,$tmp1); - push(@out,$tmp2); - - $p2=&conv($p2); - $p1=&conv($p1); - &main'comment("$name $p2 $p1"); - return; - } - - push(@out,"\t$name\t"); - $t=&conv($p2).","; - $l=length($t); - push(@out,$t); - $ll=4-($l+9)/8; - $tmp1=sprintf("\t" x $ll); - push(@out,$tmp1); - push(@out,&conv($p1)."\n"); - } - -sub out1 - { - local($name,$p1)=@_; - local($l,$t); - local(%special)=("bswapl",0x0FC8); - - if ((defined($special{$name})) && defined($regs{$p1})) - { - $op=$special{$name}|$reg_val{$p1}; - $tmp1=sprintf(".byte %d\n",($op>>8)&0xff); - $tmp2=sprintf(".byte %d\t",$op &0xff); - push(@out,$tmp1); - push(@out,$tmp2); - - $p2=&conv($p2); - $p1=&conv($p1); - &main'comment("$name $p2 $p1"); - return; - } - - push(@out,"\t$name\t".&conv($p1)."\n"); - } - -sub out1p - { - local($name,$p1)=@_; - local($l,$t); - - push(@out,"\t$name\t*".&conv($p1)."\n"); - } - -sub out0 - { - push(@out,"\t$_[0]\n"); - } - -sub conv - { - local($p)=@_; - -# $p =~ s/0x([0-9A-Fa-f]+)/0$1h/; - - $p=$regs{$p} if (defined($regs{$p})); - - $p =~ s/^(-{0,1}[0-9A-Fa-f]+)$/\$$1/; - $p =~ s/^(0x[0-9A-Fa-f]+)$/\$$1/; - return $p; - } - -sub main'file - { - local($file)=@_; - - local($tmp)=<<"EOF"; - .file "$file.s" -EOF - push(@out,$tmp); - } - -sub main'function_begin - { - local($func)=@_; - - &main'external_label($func); - $func=$under.$func; - - local($tmp)=<<"EOF"; -.text -.globl $func -EOF - push(@out,$tmp); - if ($main'cpp) - { $tmp=push(@out,"TYPE($func,\@function)\n"); } - elsif ($main'coff) - { $tmp=push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } - elsif ($main'aout and !$main'pic) - { } - else { $tmp=push(@out,".type\t$func,\@function\n"); } - push(@out,".align\t$align\n"); - push(@out,"$func:\n"); - $tmp=<<"EOF"; - pushl %ebp - pushl %ebx - pushl %esi - pushl %edi - -EOF - push(@out,$tmp); - $stack=20; - } - -sub main'function_begin_B - { - local($func,$extra)=@_; - - &main'external_label($func); - $func=$under.$func; - - local($tmp)=<<"EOF"; -.text -.globl $func -EOF - push(@out,$tmp); - if ($main'cpp) - { push(@out,"TYPE($func,\@function)\n"); } - elsif ($main'coff) - { $tmp=push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } - elsif ($main'aout and !$main'pic) - { } - else { push(@out,".type $func,\@function\n"); } - push(@out,".align\t$align\n"); - push(@out,"$func:\n"); - $stack=4; - } - -sub main'function_end - { - local($func)=@_; - - $func=$under.$func; - - local($tmp)=<<"EOF"; - popl %edi - popl %esi - popl %ebx - popl %ebp - ret -${dot}L_${func}_end: -EOF - push(@out,$tmp); - - if ($main'cpp) - { push(@out,"SIZE($func,${dot}L_${func}_end-$func)\n"); } - elsif ($main'coff or $main'aout) - { } - else { push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); } - push(@out,".ident \"$func\"\n"); - $stack=0; - %label=(); - } - -sub main'function_end_A - { - local($func)=@_; - - local($tmp)=<<"EOF"; - popl %edi - popl %esi - popl %ebx - popl %ebp - ret -EOF - push(@out,$tmp); - } - -sub main'function_end_B - { - local($func)=@_; - - $func=$under.$func; - - push(@out,"${dot}L_${func}_end:\n"); - if ($main'cpp) - { push(@out,"SIZE($func,${dot}L_${func}_end-$func)\n"); } - elsif ($main'coff or $main'aout) - { } - else { push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); } - push(@out,".ident \"$func\"\n"); - $stack=0; - %label=(); - } - -sub main'wparam - { - local($num)=@_; - - return(&main'DWP($stack+$num*4,"esp","",0)); - } - -sub main'stack_push - { - local($num)=@_; - $stack+=$num*4; - &main'sub("esp",$num*4); - } - -sub main'stack_pop - { - local($num)=@_; - $stack-=$num*4; - &main'add("esp",$num*4); - } - -sub main'swtmp - { - return(&main'DWP($_[0]*4,"esp","",0)); - } - -# Should use swtmp, which is above esp. Linix can trash the stack above esp -#sub main'wtmp -# { -# local($num)=@_; -# -# return(&main'DWP(-($num+1)*4,"esp","",0)); -# } - -sub main'comment - { - if (!defined($com_start) or $main'elf) - { # Regarding $main'elf above... +sub ::movz { &::movzb(@_); } +sub ::pushf { &::pushfl; } +sub ::popf { &::popfl; } +sub ::cpuid { &::emit(".byte\t0x0f,0xa2"); } +sub ::rdtsc { &::emit(".byte\t0x0f,0x31"); } + +sub ::call { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); } +sub ::call_ptr { &::generic("call","*$_[0]"); } +sub ::jmp_ptr { &::generic("jmp","*$_[0]"); } + +*::bswap = sub { &::emit("bswap","%$_[0]"); } if (!$::i386); + +# chosen SSE instructions +sub ::movq +{ my($p1,$p2,$optimize)=@_; + if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) + # movq between mmx registers can sink Intel CPUs + { &::pshufw($p1,$p2,0xe4); } + else + { &::generic("movq",@_); } +} +sub ::pshufw +{ my($dst,$src,$magic)=@_; + &::emit("pshufw","\$$magic","%$src","%$dst"); +} + +sub ::DWP +{ my($addr,$reg1,$reg2,$idx)=@_; + my $ret=""; + + $addr =~ s/^\s+//; + # prepend global references with optional underscore + $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige; + + $reg1 = "%$reg1" if ($reg1); + $reg2 = "%$reg2" if ($reg2); + + $ret .= $addr if (($addr ne "") && ($addr ne 0)); + + if ($reg2) + { $idx!= 0 or $idx=1; + $ret .= "($reg1,$reg2,$idx)"; + } + elsif ($reg1) + { $ret .= "($reg1)"; } + + $ret; +} +sub ::QWP { &::DWP(@_); } +sub ::BP { &::DWP(@_); } +sub ::BC { @_; } +sub ::DWC { @_; } + +sub ::file +{ push(@out,".file\t\"$_[0].s\"\n"); } + +sub ::function_begin_B +{ my($func,$extra)=@_; + my $tmp; + + &::external_label($func); + $func=$under.$func; + + push(@out,".text\n.globl\t$func\n"); + if ($::coff) + { push(@out,".def\t$func;\t.scl\t2;\t.type\t32;\t.endef\n"); } + elsif ($::aout and !$::pic) + { } + else + { push(@out,".type $func,\@function\n"); } + push(@out,".align\t$align\n"); + push(@out,"$func:\n"); + $::stack=4; +} + +sub ::function_end_B +{ my($func)=@_; + + $func=$under.$func; + push(@out,"${dot}L_${func}_end:\n"); + if ($::elf) + { push(@out,".size\t$func,${dot}L_${func}_end-$func\n"); } + $::stack=0; + %label=(); +} + +sub ::comment + { + if (!defined($com_start) or $::elf) + { # Regarding $::elf above... # GNU and SVR4 as'es use different comment delimiters, push(@out,"\n"); # so we just skip ELF comments... return; @@ -507,255 +162,151 @@ sub main'comment } } -sub main'public_label - { - $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); - push(@out,".globl\t$label{$_[0]}\n"); - } - -sub main'label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="${dot}${label}${_[0]}"; - $label++; - } - return($label{$_[0]}); - } - -sub main'set_label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="${dot}${label}${_[0]}"; - $label++; - } - if ($_[1]!=0) - { - if ($_[1]>1) { main'align($_[1]); } - else { push(@out,".align $align\n"); } - } - push(@out,"$label{$_[0]}:\n"); - } - -sub main'file_end - { - # try to detect if SSE2 or MMX extensions were used on ELF platform... - if ($main'elf && grep {/%[x]*mm[0-7]/i} @out) { - local($tmp); - - push (@out,"\n.section\t.bss\n"); - push (@out,".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 - # SSE/MMX module with this snippet... Well, it's 72 - # bytes long and for the moment we have two modules. - # Let's argue when we have 7 modules or so... - # - # $1<<10 sets a reserved bit to signal that variable - # was initialized already... - &main'picmeup("edx","OPENSSL_ia32cap_P"); - $tmp=<<___; - cmpl \$0,(%edx) - jne 1f - movl \$1<<10,(%edx) - pushf - popl %eax - movl %eax,%ecx - xorl \$1<<21,%eax - pushl %eax - popf - pushf - popl %eax - xorl %ecx,%eax - btl \$21,%eax - jnc 1f - pushl %edi - pushl %ebx - movl %edx,%edi - movl \$1,%eax - .byte 0x0f,0xa2 - orl \$1<<10,%edx - movl %edx,0(%edi) - popl %ebx - popl %edi - jmp 1f +sub islabel # see is argument is a known label +{ my $i; + foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); } + undef; +} + +sub ::external_label { push(@labels,@_); } + +sub ::public_label +{ $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); + push(@out,".globl\t$label{$_[0]}\n"); +} + +sub ::label +{ if (!defined($label{$_[0]})) + { $label{$_[0]}="${dot}${label}${_[0]}"; $label++; } + $label{$_[0]}; +} + +sub ::set_label +{ my $label=&::label($_[0]); + &::align($_[1]) if ($_[1]>1); + push(@out,"$label:\n"); +} + +sub ::file_end +{ # try to detect if SSE2 or MMX extensions were used on ELF platform... + if ($::elf && grep {/%[x]?mm[0-7]/i} @out){ + my $tmp; + + push (@out,"\n.section\t.bss\n"); + push (@out,".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 + # SSE/MMX module with this snippet... Well, it's 72 + # bytes long and for the moment we have two modules. + # Let's argue when we have 7 modules or so... + # + # $1<<10 sets a reserved bit to signal that variable + # was initialized already... + &::picmeup("edx","OPENSSL_ia32cap_P"); + $tmp=<<___; + cmpl \$0,(%edx) + jne 1f + movl \$1<<10,(%edx) + pushf + popl %eax + movl %eax,%ecx + xorl \$1<<21,%eax + pushl %eax + popf + pushf + popl %eax + xorl %ecx,%eax + btl \$21,%eax + jnc 1f + pushl %edi + pushl %ebx + movl %edx,%edi + movl \$1,%eax + .byte 0x0f,0xa2 + orl \$1<<10,%edx + movl %edx,0(%edi) + popl %ebx + popl %edi + jmp 1f .align $align 1: ___ - push (@out,$tmp); + push (@out,$tmp); + } + + if ($const ne "") + { push(@out,".section .rodata\n"); + push(@out,$const); + $const=""; + } +} + +sub ::data_byte { push(@out,".byte\t".join(',',@_)."\n"); } +sub ::data_word { push(@out,".long\t".join(',',@_)."\n"); } + +sub ::align +{ my $val=$_[0],$p2,$i; + if ($::aout) + { for ($p2=0;$val!=0;$val>>=1) { $p2++; } + $val=$p2-1; + $val.=",0x90"; + } + push(@out,".align\t$val\n"); +} + +sub ::picmeup +{ my($dst,$sym,$base,$reflabel)=@_; + + if ($::pic && ($::elf || $::aout)) + { if (!defined($base)) + { &::call(&::label("PIC_me_up")); + &::set_label("PIC_me_up"); + &::blindpop($dst); + &::add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-". + &::label("PIC_me_up") . "]"); } - - if ($const ne "") - { - push(@out,".section .rodata\n"); - push(@out,$const); - $const=""; - } - } - -sub main'data_byte - { - push(@out,"\t.byte\t".join(',',@_)."\n"); - } - -sub main'data_word - { - push(@out,"\t.long\t".join(',',@_)."\n"); - } - -sub main'align - { - my $val=$_[0],$p2,$i; - if ($main'aout) { - for ($p2=0;$val!=0;$val>>=1) { $p2++; } - $val=$p2-1; - $val.=",0x90"; - } - push(@out,".align\t$val\n"); - } - -# debug output functions: puts, putx, printf - -sub main'puts - { - &pushvars(); - &main'push('$Lstring' . ++$constl); - &main'call('puts'); - $stack-=4; - &main'add("esp",4); - &popvars(); - - $const .= "Lstring$constl:\n\t.string \"@_[0]\"\n"; - } - -sub main'putx - { - &pushvars(); - &main'push($_[0]); - &main'push('$Lstring' . ++$constl); - &main'call('printf'); - &main'add("esp",8); - $stack-=8; - &popvars(); - - $const .= "Lstring$constl:\n\t.string \"\%X\"\n"; - } - -sub main'printf - { - $ostack = $stack; - &pushvars(); - for ($i = @_ - 1; $i >= 0; $i--) - { - if ($i == 0) # change this to support %s format strings - { - &main'push('$Lstring' . ++$constl); - $const .= "Lstring$constl:\n\t.string \"@_[$i]\"\n"; - } - else - { - if ($_[$i] =~ /([0-9]*)\(%esp\)/) - { - &main'push(($1 + $stack - $ostack) . '(%esp)'); - } - else - { - &main'push($_[$i]); - } - } - } - &main'call('printf'); - $stack-=4*@_; - &main'add("esp",4*@_); - &popvars(); - } - -sub pushvars - { - &main'pushf(); - &main'push("edx"); - &main'push("ecx"); - &main'push("eax"); - } - -sub popvars - { - &main'pop("eax"); - &main'pop("ecx"); - &main'pop("edx"); - &main'popf(); - } - -sub main'picmeup - { - local($dst,$sym)=@_; - if ($main'cpp) - { - local($tmp)=<<___; -#if (defined(ELF) || defined(SOL)) && defined(PIC) - call 1f -1: popl $regs{$dst} - addl \$_GLOBAL_OFFSET_TABLE_+[.-1b],$regs{$dst} - movl $sym\@GOT($regs{$dst}),$regs{$dst} -#else - leal $sym,$regs{$dst} -#endif -___ - push(@out,$tmp); - } - elsif ($main'pic && ($main'elf || $main'aout)) - { - &main'call(&main'label("PIC_me_up")); - &main'set_label("PIC_me_up"); - &main'blindpop($dst); - &main'add($dst,"\$${under}_GLOBAL_OFFSET_TABLE_+[.-". - &main'label("PIC_me_up") . "]"); - &main'mov($dst,&main'DWP($under.$sym."\@GOT",$dst)); - } else - { - &main'lea($dst,&main'DWP($sym)); - } + { &::lea($dst,&::DWP("${under}_GLOBAL_OFFSET_TABLE_+[.-$reflabel]", + $base)); } + &::mov($dst,&::DWP($under.$sym."\@GOT",$dst)); + } + else + { &::lea($dst,&::DWP($sym)); } +} -sub main'blindpop { &out1("popl",@_); } +sub ::initseg +{ my($f)=@_; + my($tmp,$ctor); -sub main'initseg - { - local($f)=@_; - local($tmp); - if ($main'elf) - { - $tmp=<<___; + if ($::elf) + { $tmp=<<___; .section .init call $under$f jmp .Linitalign .align $align .Linitalign: ___ - } - elsif ($main'coff) - { - $tmp=<<___; # applies to both Cygwin and Mingw + } + elsif ($::coff) + { $tmp=<<___; # applies to both Cygwin and Mingw .section .ctors .long $under$f ___ - } - elsif ($main'aout) - { - local($ctor)="${under}_GLOBAL_\$I\$$f"; - $tmp=".text\n"; - $tmp.=".type $ctor,\@function\n" if ($main'pic); - $tmp.=<<___; # OpenBSD way... + } + elsif ($::aout) + { $ctor="${under}_GLOBAL_\$I\$$f"; + $tmp=".text\n"; + $tmp.=".type $ctor,\@function\n" if ($::pic); + $tmp.=<<___; # OpenBSD way... .globl $ctor .align 2 $ctor: jmp $under$f ___ - } - push(@out,$tmp) if ($tmp); - } + } + push(@out,$tmp) if ($tmp); +} 1;