From e3fc9c40a3ddca5774c9d4f26e3cd8d2d76dfc34 Mon Sep 17 00:00:00 2001 From: miod <> Date: Thu, 17 Apr 2014 20:17:45 +0000 Subject: Stop paying lip service to non-AT&T syntax assemblers in the x86 world. --- src/lib/libcrypto/perlasm/x86asm.pl | 12 +- src/lib/libcrypto/perlasm/x86masm.pl | 198 --------------------------- src/lib/libcrypto/perlasm/x86nasm.pl | 177 ------------------------ src/lib/libssl/src/crypto/perlasm/x86asm.pl | 12 +- src/lib/libssl/src/crypto/perlasm/x86masm.pl | 198 --------------------------- src/lib/libssl/src/crypto/perlasm/x86nasm.pl | 177 ------------------------ 6 files changed, 2 insertions(+), 772 deletions(-) delete mode 100644 src/lib/libcrypto/perlasm/x86masm.pl delete mode 100644 src/lib/libcrypto/perlasm/x86nasm.pl delete mode 100644 src/lib/libssl/src/crypto/perlasm/x86masm.pl delete mode 100644 src/lib/libssl/src/crypto/perlasm/x86nasm.pl diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl index bf783cff26..d74d1992f8 100644 --- a/src/lib/libcrypto/perlasm/x86asm.pl +++ b/src/lib/libcrypto/perlasm/x86asm.pl @@ -225,21 +225,13 @@ sub ::asm_init $filename=$fn; $i386=$cpu; - $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=$android=0; + $elf=$cpp=$coff=$aout=$macosx=$win32=$openbsd=$android=0; if (($type eq "elf")) { $elf=1; require "x86gas.pl"; } elsif (($type eq "a\.out")) { $aout=1; require "x86gas.pl"; } elsif (($type eq "coff" or $type eq "gaswin")) { $coff=1; require "x86gas.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"; } - elsif (($type eq "win32")) - { $win32=1; require "x86masm.pl"; } elsif (($type eq "macosx")) { $aout=1; $macosx=1; require "x86gas.pl"; } elsif (($type eq "openbsd-elf")) @@ -254,10 +246,8 @@ Pick one target type from elf - Linux, FreeBSD, Solaris x86, etc. a.out - DJGPP, elder OpenBSD, etc. coff - GAS/COFF such as Win32 targets - win32n - Windows 95/Windows NT NASM format openbsd-elf - OpenBSD elf openbsd-a.out - OpenBSD a.out - nw-nasm - NetWare NASM format macosx - Mac OS X EOF exit(1); diff --git a/src/lib/libcrypto/perlasm/x86masm.pl b/src/lib/libcrypto/perlasm/x86masm.pl deleted file mode 100644 index f937d07c87..0000000000 --- a/src/lib/libcrypto/perlasm/x86masm.pl +++ /dev/null @@ -1,198 +0,0 @@ -#!/usr/bin/env perl - -package x86masm; - -*out=\@::out; - -$::lbdecor="\$L"; # local label decoration -$nmdecor="_"; # external name decoration - -$initseg=""; -$segment=""; - -sub ::generic -{ my ($opcode,@arg)=@_; - - # fix hexadecimal constants - for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; } - - if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no [] - { $opcode="mov"; } - elsif ($opcode !~ /movq/) - { # fix xmm references - $arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[1]=~/\bxmm[0-7]\b/i); - $arg[1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i); - } - - &::emit($opcode,@arg); - 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 ::lock { &::data_byte(0xf0); } - -sub get_mem -{ my($size,$addr,$reg1,$reg2,$idx)=@_; - my($post,$ret); - - $ret .= "$size PTR " if ($size ne ""); - - $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; } - } - $ret .= "["; - - 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 =~ s/\[\s*\]//; - - $ret; -} -sub ::BP { &get_mem("BYTE",@_); } -sub ::WP { &get_mem("WORD",@_); } -sub ::DWP { &get_mem("DWORD",@_); } -sub ::QWP { &get_mem("QWORD",@_); } -sub ::BC { "@_"; } -sub ::DWC { "@_"; } - -sub ::file -{ my $tmp=<<___; -TITLE $_[0].asm -IF \@Version LT 800 -ECHO MASM version 8.00 or later is strongly recommended. -ENDIF -.486 -.MODEL FLAT -OPTION DOTNAME -IF \@Version LT 800 -.text\$ SEGMENT PAGE 'CODE' -ELSE -.text\$ SEGMENT ALIGN(64) 'CODE' -ENDIF -___ - push(@out,$tmp); - $segment = ".text\$"; -} - -sub ::function_begin_B -{ my $func=shift; - my $global=($func !~ /^_/); - my $begin="${::lbdecor}_${func}_begin"; - - &::LABEL($func,$global?"$begin":"$nmdecor$func"); - $func="ALIGN\t16\n".$nmdecor.$func."\tPROC"; - - if ($global) { $func.=" PUBLIC\n${begin}::\n"; } - else { $func.=" PRIVATE\n"; } - push(@out,$func); - $::stack=4; -} -sub ::function_end_B -{ my $func=shift; - - push(@out,"$nmdecor$func ENDP\n"); - $::stack=0; - &::wipe_labels(); -} - -sub ::file_end -{ my $xmmheader=<<___; -.686 -.XMM -IF \@Version LT 800 -XMMWORD STRUCT 16 -DQ 2 dup (?) -XMMWORD ENDS -ENDIF -___ - if (grep {/\b[x]?mm[0-7]\b/i} @out) { - grep {s/\.[3-7]86/$xmmheader/} @out; - } - - push(@out,"$segment ENDS\n"); - - if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) - { my $comm=<<___; -.bss SEGMENT 'BSS' -COMM ${nmdecor}OPENSSL_ia32cap_P:QWORD -.bss ENDS -___ - # comment out OPENSSL_ia32cap_P declarations - grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; - push (@out,$comm); - } - push (@out,$initseg) if ($initseg); - push (@out,"END\n"); -} - -sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } - -*::set_label_B = sub -{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; - -sub ::external_label -{ foreach(@_) - { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } -} - -sub ::public_label -{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } - -sub ::data_byte -{ push(@out,("DB\t").join(',',@_)."\n"); } - -sub ::data_short -{ push(@out,("DW\t").join(',',@_)."\n"); } - -sub ::data_word -{ push(@out,("DD\t").join(',',@_)."\n"); } - -sub ::align -{ push(@out,"ALIGN\t$_[0]\n"); } - -sub ::picmeup -{ my($dst,$sym)=@_; - &::lea($dst,&::DWP($sym)); -} - -sub ::initseg -{ my $f=$nmdecor.shift; - - $initseg.=<<___; -.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' -EXTERN $f:NEAR -DD $f -.CRT\$XCU ENDS -___ -} - -sub ::dataseg -{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } - -sub ::safeseh -{ my $nm=shift; - push(@out,"IF \@Version GE 710\n"); - push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n"); - push(@out,"ENDIF\n"); -} - -1; diff --git a/src/lib/libcrypto/perlasm/x86nasm.pl b/src/lib/libcrypto/perlasm/x86nasm.pl deleted file mode 100644 index ca2511c9eb..0000000000 --- a/src/lib/libcrypto/perlasm/x86nasm.pl +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/bin/env perl - -package x86nasm; - -*out=\@::out; - -$::lbdecor="L\$"; # local label decoration -$nmdecor=$::netware?"":"_"; # external name decoration -$drdecor=$::mwerks?".":""; # directive decoration - -$initseg=""; - -sub ::generic -{ my $opcode=shift; - my $tmp; - - 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; } - elsif ($opcode eq "clflush" && $#_==0) - { $_[0] =~ 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 get_mem -{ 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 ::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,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 code -%endif -___ - push(@out,$tmp); - } -} - -sub ::function_begin_B -{ 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 -{ $::stack=0; - &::wipe_labels(); -} - -sub ::file_end -{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) - { my $comm=<<___; -${drdecor}segment .bss -${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 8 -___ - # 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 ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } - -sub ::external_label -{ foreach(@_) - { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } -} - -sub ::public_label -{ 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,"${drdecor}align\t$_[0]\n"); } - -sub ::picmeup -{ my($dst,$sym)=@_; - &::lea($dst,&::DWP($sym)); -} - -sub ::initseg -{ my $f=$nmdecor.shift; - if ($::win32) - { $initseg=<<___; -segment .CRT\$XCU data align=4 -extern $f -dd $f -___ - } -} - -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; diff --git a/src/lib/libssl/src/crypto/perlasm/x86asm.pl b/src/lib/libssl/src/crypto/perlasm/x86asm.pl index bf783cff26..d74d1992f8 100644 --- a/src/lib/libssl/src/crypto/perlasm/x86asm.pl +++ b/src/lib/libssl/src/crypto/perlasm/x86asm.pl @@ -225,21 +225,13 @@ sub ::asm_init $filename=$fn; $i386=$cpu; - $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=$android=0; + $elf=$cpp=$coff=$aout=$macosx=$win32=$openbsd=$android=0; if (($type eq "elf")) { $elf=1; require "x86gas.pl"; } elsif (($type eq "a\.out")) { $aout=1; require "x86gas.pl"; } elsif (($type eq "coff" or $type eq "gaswin")) { $coff=1; require "x86gas.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"; } - elsif (($type eq "win32")) - { $win32=1; require "x86masm.pl"; } elsif (($type eq "macosx")) { $aout=1; $macosx=1; require "x86gas.pl"; } elsif (($type eq "openbsd-elf")) @@ -254,10 +246,8 @@ Pick one target type from elf - Linux, FreeBSD, Solaris x86, etc. a.out - DJGPP, elder OpenBSD, etc. coff - GAS/COFF such as Win32 targets - win32n - Windows 95/Windows NT NASM format openbsd-elf - OpenBSD elf openbsd-a.out - OpenBSD a.out - nw-nasm - NetWare NASM format macosx - Mac OS X EOF exit(1); diff --git a/src/lib/libssl/src/crypto/perlasm/x86masm.pl b/src/lib/libssl/src/crypto/perlasm/x86masm.pl deleted file mode 100644 index f937d07c87..0000000000 --- a/src/lib/libssl/src/crypto/perlasm/x86masm.pl +++ /dev/null @@ -1,198 +0,0 @@ -#!/usr/bin/env perl - -package x86masm; - -*out=\@::out; - -$::lbdecor="\$L"; # local label decoration -$nmdecor="_"; # external name decoration - -$initseg=""; -$segment=""; - -sub ::generic -{ my ($opcode,@arg)=@_; - - # fix hexadecimal constants - for (@arg) { s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/oi; } - - if ($opcode =~ /lea/ && @arg[1] =~ s/.*PTR\s+(\(.*\))$/OFFSET $1/) # no [] - { $opcode="mov"; } - elsif ($opcode !~ /movq/) - { # fix xmm references - $arg[0] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[1]=~/\bxmm[0-7]\b/i); - $arg[1] =~ s/\b[A-Z]+WORD\s+PTR/XMMWORD PTR/i if ($arg[0]=~/\bxmm[0-7]\b/i); - } - - &::emit($opcode,@arg); - 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 ::lock { &::data_byte(0xf0); } - -sub get_mem -{ my($size,$addr,$reg1,$reg2,$idx)=@_; - my($post,$ret); - - $ret .= "$size PTR " if ($size ne ""); - - $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; } - } - $ret .= "["; - - 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 =~ s/\[\s*\]//; - - $ret; -} -sub ::BP { &get_mem("BYTE",@_); } -sub ::WP { &get_mem("WORD",@_); } -sub ::DWP { &get_mem("DWORD",@_); } -sub ::QWP { &get_mem("QWORD",@_); } -sub ::BC { "@_"; } -sub ::DWC { "@_"; } - -sub ::file -{ my $tmp=<<___; -TITLE $_[0].asm -IF \@Version LT 800 -ECHO MASM version 8.00 or later is strongly recommended. -ENDIF -.486 -.MODEL FLAT -OPTION DOTNAME -IF \@Version LT 800 -.text\$ SEGMENT PAGE 'CODE' -ELSE -.text\$ SEGMENT ALIGN(64) 'CODE' -ENDIF -___ - push(@out,$tmp); - $segment = ".text\$"; -} - -sub ::function_begin_B -{ my $func=shift; - my $global=($func !~ /^_/); - my $begin="${::lbdecor}_${func}_begin"; - - &::LABEL($func,$global?"$begin":"$nmdecor$func"); - $func="ALIGN\t16\n".$nmdecor.$func."\tPROC"; - - if ($global) { $func.=" PUBLIC\n${begin}::\n"; } - else { $func.=" PRIVATE\n"; } - push(@out,$func); - $::stack=4; -} -sub ::function_end_B -{ my $func=shift; - - push(@out,"$nmdecor$func ENDP\n"); - $::stack=0; - &::wipe_labels(); -} - -sub ::file_end -{ my $xmmheader=<<___; -.686 -.XMM -IF \@Version LT 800 -XMMWORD STRUCT 16 -DQ 2 dup (?) -XMMWORD ENDS -ENDIF -___ - if (grep {/\b[x]?mm[0-7]\b/i} @out) { - grep {s/\.[3-7]86/$xmmheader/} @out; - } - - push(@out,"$segment ENDS\n"); - - if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) - { my $comm=<<___; -.bss SEGMENT 'BSS' -COMM ${nmdecor}OPENSSL_ia32cap_P:QWORD -.bss ENDS -___ - # comment out OPENSSL_ia32cap_P declarations - grep {s/(^EXTERN\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; - push (@out,$comm); - } - push (@out,$initseg) if ($initseg); - push (@out,"END\n"); -} - -sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } - -*::set_label_B = sub -{ my $l=shift; push(@out,$l.($l=~/^\Q${::lbdecor}\E[0-9]{3}/?":\n":"::\n")); }; - -sub ::external_label -{ foreach(@_) - { push(@out, "EXTERN\t".&::LABEL($_,$nmdecor.$_).":NEAR\n"); } -} - -sub ::public_label -{ push(@out,"PUBLIC\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } - -sub ::data_byte -{ push(@out,("DB\t").join(',',@_)."\n"); } - -sub ::data_short -{ push(@out,("DW\t").join(',',@_)."\n"); } - -sub ::data_word -{ push(@out,("DD\t").join(',',@_)."\n"); } - -sub ::align -{ push(@out,"ALIGN\t$_[0]\n"); } - -sub ::picmeup -{ my($dst,$sym)=@_; - &::lea($dst,&::DWP($sym)); -} - -sub ::initseg -{ my $f=$nmdecor.shift; - - $initseg.=<<___; -.CRT\$XCU SEGMENT DWORD PUBLIC 'DATA' -EXTERN $f:NEAR -DD $f -.CRT\$XCU ENDS -___ -} - -sub ::dataseg -{ push(@out,"$segment\tENDS\n_DATA\tSEGMENT\n"); $segment="_DATA"; } - -sub ::safeseh -{ my $nm=shift; - push(@out,"IF \@Version GE 710\n"); - push(@out,".SAFESEH ".&::LABEL($nm,$nmdecor.$nm)."\n"); - push(@out,"ENDIF\n"); -} - -1; diff --git a/src/lib/libssl/src/crypto/perlasm/x86nasm.pl b/src/lib/libssl/src/crypto/perlasm/x86nasm.pl deleted file mode 100644 index ca2511c9eb..0000000000 --- a/src/lib/libssl/src/crypto/perlasm/x86nasm.pl +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/bin/env perl - -package x86nasm; - -*out=\@::out; - -$::lbdecor="L\$"; # local label decoration -$nmdecor=$::netware?"":"_"; # external name decoration -$drdecor=$::mwerks?".":""; # directive decoration - -$initseg=""; - -sub ::generic -{ my $opcode=shift; - my $tmp; - - 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; } - elsif ($opcode eq "clflush" && $#_==0) - { $_[0] =~ 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 get_mem -{ 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 ::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,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 code -%endif -___ - push(@out,$tmp); - } -} - -sub ::function_begin_B -{ 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 -{ $::stack=0; - &::wipe_labels(); -} - -sub ::file_end -{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) - { my $comm=<<___; -${drdecor}segment .bss -${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 8 -___ - # 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 ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } - -sub ::external_label -{ foreach(@_) - { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } -} - -sub ::public_label -{ 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,"${drdecor}align\t$_[0]\n"); } - -sub ::picmeup -{ my($dst,$sym)=@_; - &::lea($dst,&::DWP($sym)); -} - -sub ::initseg -{ my $f=$nmdecor.shift; - if ($::win32) - { $initseg=<<___; -segment .CRT\$XCU data align=4 -extern $f -dd $f -___ - } -} - -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; -- cgit v1.2.3-55-g6feb