diff options
Diffstat (limited to 'openssl/crypto/perlasm/x86nasm.pl')
| -rw-r--r-- | openssl/crypto/perlasm/x86nasm.pl | 559 |
1 files changed, 135 insertions, 424 deletions
diff --git a/openssl/crypto/perlasm/x86nasm.pl b/openssl/crypto/perlasm/x86nasm.pl index fa38f89c0..ce2bed9bb 100644 --- a/openssl/crypto/perlasm/x86nasm.pl +++ b/openssl/crypto/perlasm/x86nasm.pl @@ -1,455 +1,166 @@ -#!/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', - ); +$::lbdecor="L\$"; # local label decoration +$nmdecor=$::netware?"":"_"; # external name decoration +$drdecor=$::mwerks?".":""; # directive decoration -%hb=( 'eax', 'ah', - 'ebx', 'bh', - 'ecx', 'ch', - 'edx', 'dh', - 'ax', 'ah', - 'bx', 'bh', - 'cx', 'ch', - 'dx', 'dh', - ); +$initseg=""; -sub main'asm_init_output { @out=(); } -sub main'asm_get_output { return(@out); } -sub main'get_labels { return(@labels); } +sub ::generic +{ my $opcode=shift; + my $tmp; -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 ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } +sub ::call_ptr { &::emit("call",@_); } +sub ::jmp_ptr { &::emit("jmp",@_); } 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'imul { &out2("imul",@_); } -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=<<___; -%ifdef __omf__ -section code use32 class=code +{ 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 "$nmdecor$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,64\n"); } + else + { my $tmp=<<___; +%ifidn __OUTPUT_FORMAT__,obj +section code use32 class=code align=64 +%elifidn __OUTPUT_FORMAT__,win32 +\$\@feat.00 equ 1 +section .text code align=64 %else -section .text +section .text code %endif ___ - push(@out,$tmp); - } - } - -sub main'function_begin - { - my($func,$extra)=@_; - - push(@labels,$func); - push(@out,".") if ($main'mwerks); - 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)=@_; - push(@out,".") if ($main'mwerks); - my($tmp)=<<"EOF"; -global $under$func -$under$func: -EOF - push(@out,$tmp); - $stack=4; - } - -sub main'function_end - { - my($func)=@_; - - my($tmp)=<<"EOF"; - pop edi - pop esi - 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 - 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)); - } +sub ::function_begin_B +{ my $func=shift; + my $global=($func !~ /^_/); + my $begin="${::lbdecor}_${func}_begin"; -# 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)); -# } + $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops -sub main'comment - { - foreach (@_) - { - push(@out,"\t; $_\n"); - } - } + &::LABEL($func,$global?"$begin":"$nmdecor$func"); + $func=$nmdecor.$func; -sub main'public_label - { - $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]})); - push(@out,".") if ($main'mwerks); - push(@out,"global\t$label{$_[0]}\n"); - } + push(@out,"${drdecor}global $func\n") if ($global); + push(@out,"${drdecor}align 16\n"); + push(@out,"$func:\n"); + push(@out,"$begin:\n") if ($global); + $::stack=4; +} -sub main'label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}="\@${label}${_[0]}"; - $label++; - } - return($label{$_[0]}); - } +sub ::function_end_B +{ $::stack=0; + &::wipe_labels(); +} -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 ::file_end +{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) + { my $comm=<<___; +${drdecor}segment .bss +${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 4 +___ + # comment out OPENSSL_ia32cap_P declarations + grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; + push (@out,$comm) + } + push (@out,$initseg) if ($initseg); +} -sub main'data_byte - { - push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n"); - } +sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } -sub main'data_word - { - push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n"); - } +sub ::external_label +{ foreach(@_) + { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } +} -sub main'align - { - push(@out,".") if ($main'mwerks); - push(@out,"align\t$_[0]\n"); - } +sub ::public_label +{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[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,"${drdecor}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=$nmdecor.shift; + if ($::win32) + { $initseg=<<___; +segment .CRT\$XCU data align=4 +extern $f +dd $f ___ - push(@out,$tmp); - } - } + } +} + +sub ::dataseg +{ if ($mwerks) { push(@out,".section\t.data,4\n"); } + else { push(@out,"section\t.data align=4\n"); } +} 1; |