*out=\@::out;
-$lprfx="\@L";
-$label="000";
-$under=($::netware)?'':'_';
+$::lbdecor="L\$"; # local label decoration
+$nmdecor=$::netware?"":"_"; # external name decoration
+$drdecor=$::mwerks?".":""; # directive decoration
+
$initseg="";
sub ::generic
if (!$::mwerks)
{ if ($opcode =~ m/^j/o && $#_==0) # optimize jumps
{ $_[0] = "NEAR $_[0]"; }
- elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
+ elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea
{ $_[1] =~ s/^[^\[]*\[/\[/o; }
+ elsif ($opcode eq "clflush" && $#_==0)
+ { $_[0] =~ s/^[^\[]*\[/\[/o; }
}
&::emit($opcode,@_);
1;
#
# 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 { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[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($post,$ret);
+ if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; }
+
if ($size ne "")
{ $ret .= "$size";
$ret .= " PTR" if ($::mwerks);
$addr =~ s/^\s+//;
# prepend global references with optional underscore
- $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
+ $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige;
# put address arithmetic expression in parenthesis
$addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
}
sub ::BP { &get_mem("BYTE",@_); }
sub ::DWP { &get_mem("DWORD",@_); }
+sub ::WP { &get_mem("WORD",@_); }
sub ::QWP { &get_mem("",@_); }
sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; }
sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; }
sub ::file
-{ if ($::mwerks) { push(@out,".section\t.text\n"); }
+{ if ($::mwerks) { push(@out,".section\t.text,64\n"); }
else
{ my $tmp=<<___;
-%ifdef __omf__
+%ifidn __OUTPUT_FORMAT__,obj
section code use32 class=code align=64
-%else
+%elifidn __OUTPUT_FORMAT__,win32
+\$\@feat.00 equ 1
section .text code align=64
+%else
+section .text code
%endif
___
push(@out,$tmp);
}
sub ::function_begin_B
-{ my $func=$under.shift;
- my $tmp=<<___;
-global $func
-align 16
-$func:
-___
- push(@out,$tmp);
+{ my $func=shift;
+ my $global=($func !~ /^_/);
+ my $begin="${::lbdecor}_${func}_begin";
+
+ $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops
+
+ &::LABEL($func,$global?"$begin":"$nmdecor$func");
+ $func=$nmdecor.$func;
+
+ 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 ::function_end_B
-{ my $i;
- foreach $i (%label) { undef $label{$i} if ($label{$i} =~ /^$prfx/); }
- $::stack=0;
+{ $::stack=0;
+ &::wipe_labels();
}
sub ::file_end
-{ # try to detect if SSE2 or MMX extensions were used on Win32...
- if ($::win32 && grep {/\b[x]?mm[0-7]\b|OPENSSL_ia32cap_P\b/i} @out)
- { # $1<<10 sets a reserved bit to signal that variable
- # was initialized already...
- my $code=<<___;
-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 ebp
- push edi
- push ebx
- mov edi,edx
- xor eax,eax
- cpuid
- xor eax,eax
- cmp ebx,'Genu'
- setne al
- mov ebp,eax
- cmp edx,'ineI'
- setne al
- or ebp,eax
- cmp eax,'ntel'
- setne al
- or ebp,eax
- mov eax,1
- cpuid
- cmp ebp,0
- jne ${lprfx}notP4
- and ah,15
- cmp ah,15
- jne ${lprfx}notP4
- or edx,1<<20
-${lprfx}notP4:
- bt edx,28
- jnc ${lprfx}done
- shr ebx,16
- cmp bl,1
- ja ${lprfx}done
- and edx,0xefffffff
-${lprfx}done:
- or edx,1<<10
- mov DWORD [edi],edx
- pop ebx
- pop edi
- pop ebp
-${lprfx}nocpuid:
- ret
-segment .CRT\$XCU data align=4
-dd ${lprfx}OPENSSL_ia32cap_init
-___
- my $data=<<___;
-segment .bss
-common ${under}OPENSSL_ia32cap_P 4
+{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out)
+ { my $comm=<<___;
+${drdecor}segment .bss
+${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 16
___
-
- #<not needed in OpenSSL context>#push (@out,$code);
-
# comment out OPENSSL_ia32cap_P declarations
- grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out;
- push (@out,$data)
+ grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out;
+ push (@out,$comm)
}
push (@out,$initseg) if ($initseg);
}
sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } }
-sub islabel # see is argument is known label
-{ my $i;
- foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
- undef;
-}
-
sub ::external_label
-{ push(@labels,@_);
- foreach (@_)
- { push(@out,".") if ($::mwerks);
- push(@out, "extern\t${under}$_\n");
- }
+{ foreach(@_)
+ { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); }
}
sub ::public_label
-{ $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
- push(@out,"global\t$label{$_[0]}\n");
-}
-
-sub ::label
-{ if (!defined($label{$_[0]}))
- { $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++; }
- $label{$_[0]};
-}
-
-sub ::set_label
-{ my $label=&::label($_[0]);
- &::align($_[1]) if ($_[1]>1);
- push(@out,"$label{$_[0]}:\n");
-}
+{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); }
sub ::data_byte
{ push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); }
-
+sub ::data_short
+{ push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n"); }
sub ::data_word
{ push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); }
sub ::align
-{ push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); }
+{ push(@out,"${drdecor}align\t$_[0]\n"); }
sub ::picmeup
{ my($dst,$sym)=@_;
}
sub ::initseg
-{ my($f)=$under.shift;
+{ my $f=$nmdecor.shift;
if ($::win32)
{ $initseg=<<___;
segment .CRT\$XCU data align=4
}
}
+sub ::dataseg
+{ if ($mwerks) { push(@out,".section\t.data,4\n"); }
+ else { push(@out,"section\t.data align=4\n"); }
+}
+
+sub ::safeseh
+{ my $nm=shift;
+ push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n");
+ push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n");
+ push(@out,"%endif\n");
+}
+
1;
projects / openssl.git / blobdiff