| Index: openssl/crypto/perlasm/x86nasm.pl
|
| ===================================================================
|
| --- openssl/crypto/perlasm/x86nasm.pl (revision 105093)
|
| +++ openssl/crypto/perlasm/x86nasm.pl (working copy)
|
| @@ -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;
|
| }
|
| +#
|
| +# 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 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);
|
| - }
|
| -
|
| 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";
|
| - }
|
| +{ my($size,$addr,$reg1,$reg2,$idx)=@_;
|
| + my($post,$ret);
|
|
|
| - if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
|
| + if ($size ne "")
|
| + { $ret .= "$size";
|
| + $ret .= " PTR" if ($::mwerks);
|
| + $ret .= " ";
|
| + }
|
| + $ret .= "[";
|
|
|
| - $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);
|
| - }
|
| + $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 =~ /^.+[\-\+].+$/);
|
|
|
| -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",@_); }
|
| + if (($addr ne "") && ($addr ne 0))
|
| + { if ($addr !~ /^-/) { $ret .= "$addr+"; }
|
| + else { $post=$addr; }
|
| + }
|
|
|
| -# 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",@_); }
|
| + if ($reg2 ne "")
|
| + { $idx!=0 or $idx=1;
|
| + $ret .= "$reg2*$idx";
|
| + $ret .= "+$reg1" if ($reg1 ne "");
|
| + }
|
| + else
|
| + { $ret .= "$reg1"; }
|
|
|
| -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"); }
|
| + $ret .= "$post]";
|
| + $ret =~ s/\+\]/]/; # in case $addr was the only argument
|
|
|
| -# 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",@_); }
|
| + $ret;
|
| +}
|
| +sub ::BP { &get_mem("BYTE",@_); }
|
| +sub ::DWP { &get_mem("DWORD",@_); }
|
| +sub ::QWP { &get_mem("",@_); }
|
| +sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; }
|
| +sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; }
|
|
|
| -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
|
| +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 ::function_begin_B
|
| +{ my $func=shift;
|
| + my $global=($func !~ /^_/);
|
| + my $begin="${::lbdecor}_${func}_begin";
|
|
|
| -sub main'function_end
|
| - {
|
| - my($func)=@_;
|
| + $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops
|
|
|
| - my($tmp)=<<"EOF";
|
| - pop edi
|
| - pop esi
|
| - pop ebx
|
| - pop ebp
|
| - ret
|
| -EOF
|
| - push(@out,$tmp);
|
| - $stack=0;
|
| - %label=();
|
| - }
|
| + &::LABEL($func,$global?"$begin":"$nmdecor$func");
|
| + $func=$nmdecor.$func;
|
|
|
| -sub main'function_end_B
|
| - {
|
| - $stack=0;
|
| - %label=();
|
| - }
|
| + 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'function_end_A
|
| - {
|
| - my($func)=@_;
|
| +sub ::function_end_B
|
| +{ $::stack=0;
|
| + &::wipe_labels();
|
| +}
|
|
|
| - my($tmp)=<<"EOF";
|
| - pop edi
|
| - pop esi
|
| - pop ebx
|
| - pop ebp
|
| - ret
|
| -EOF
|
| - push(@out,$tmp);
|
| - }
|
| +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'file_end
|
| - {
|
| - }
|
| +sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
|
|
|
| -sub main'wparam
|
| - {
|
| - my($num)=@_;
|
| +sub ::external_label
|
| +{ foreach(@_)
|
| + { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); }
|
| +}
|
|
|
| - return(&main'DWP($stack+$num*4,"esp","",0));
|
| - }
|
| +sub ::public_label
|
| +{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
|
|
|
| -sub main'swtmp
|
| - {
|
| - return(&main'DWP($_[0]*4,"esp","",0));
|
| - }
|
| +sub ::data_byte
|
| +{ push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); }
|
|
|
| -# 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 ::data_word
|
| +{ push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); }
|
|
|
| -sub main'comment
|
| - {
|
| - foreach (@_)
|
| - {
|
| - push(@out,"\t; $_\n");
|
| - }
|
| - }
|
| +sub ::align
|
| +{ push(@out,"${drdecor}align\t$_[0]\n"); }
|
|
|
| -sub main'public_label
|
| - {
|
| - $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
|
| - push(@out,".") if ($main'mwerks);
|
| - push(@out,"global\t$label{$_[0]}\n");
|
| - }
|
| +sub ::picmeup
|
| +{ my($dst,$sym)=@_;
|
| + &::lea($dst,&::DWP($sym));
|
| +}
|
|
|
| -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]);
|
| - }
|
| - push(@out,"$label{$_[0]}:\n");
|
| - }
|
| -
|
| -sub main'data_byte
|
| - {
|
| - push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n");
|
| - }
|
| -
|
| -sub main'data_word
|
| - {
|
| - push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
|
| - }
|
| -
|
| -sub main'align
|
| - {
|
| - push(@out,".") if ($main'mwerks);
|
| - push(@out,"align\t$_[0]\n");
|
| - }
|
| -
|
| -sub out1p
|
| - {
|
| - my($name,$p1)=@_;
|
| - my($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)=@_;
|
| - 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;
|
|
|