1 #!/usr/bin/env perl 2 3 package x86nasm; 4 5 *out=\@::out; 6 7 $::lbdecor="L\$"; # local label decoration 8 $nmdecor=$::netware?"":"_"; # external name decoration 9 $drdecor=$::mwerks?".":""; # directive decoration 10 11 $initseg=""; 12 13 sub ::generic 14 { my $opcode=shift; 15 my $tmp; 16 17 if (!$::mwerks) 18 { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps 19 { $_[0] = "NEAR $_[0]"; } 20 elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea 21 { $_[1] =~ s/^[^\[]*\[/\[/o; } 22 elsif ($opcode eq "clflush" && $#_==0) 23 { $_[0] =~ s/^[^\[]*\[/\[/o; } 24 } 25 &::emit($opcode,@_); 26 1; 27 } 28 # 29 # opcodes not covered by ::generic above, mostly inconsistent namings... 30 # 31 sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } 32 sub ::call_ptr { &::emit("call",@_); } 33 sub ::jmp_ptr { &::emit("jmp",@_); } 34 35 sub get_mem 36 { my($size,$addr,$reg1,$reg2,$idx)=@_; 37 my($post,$ret); 38 39 if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; } 40 41 if ($size ne "") 42 { $ret .= "$size"; 43 $ret .= " PTR" if ($::mwerks); 44 $ret .= " "; 45 } 46 $ret .= "["; 47 48 $addr =~ s/^\s+//; 49 # prepend global references with optional underscore 50 $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; 51 # put address arithmetic expression in parenthesis 52 $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); 53 54 if (($addr ne "") && ($addr ne 0)) 55 { if ($addr !~ /^-/) { $ret .= "$addr+"; } 56 else { $post=$addr; } 57 } 58 59 if ($reg2 ne "") 60 { $idx!=0 or $idx=1; 61 $ret .= "$reg2*$idx"; 62 $ret .= "+$reg1" if ($reg1 ne ""); 63 } 64 else 65 { $ret .= "$reg1"; } 66 67 $ret .= "$post]"; 68 $ret =~ s/\+\]/]/; # in case $addr was the only argument 69 70 $ret; 71 } 72 sub ::BP { &get_mem("BYTE",@_); } 73 sub ::DWP { &get_mem("DWORD",@_); } 74 sub ::WP { &get_mem("WORD",@_); } 75 sub ::QWP { &get_mem("",@_); } 76 sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } 77 sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } 78 79 sub ::file 80 { if ($::mwerks) { push(@out,".section\t.text,64\n"); } 81 else 82 { my $tmp=<<___; 83 %ifidn __OUTPUT_FORMAT__,obj 84 section code use32 class=code align=64 85 %elifidn __OUTPUT_FORMAT__,win32 86 %ifdef __YASM_VERSION_ID__ 87 %if __YASM_VERSION_ID__ < 01010000h 88 %error yasm version 1.1.0 or later needed. 89 %endif 90 ; Yasm automatically includes @feat.00 and complains about redefining it. 91 ; https://www.tortall.net/projects/yasm/manual/html/objfmt-win32-safeseh.html 92 %else 93 \$\@feat.00 equ 1 94 %endif 95 section .text code align=64 96 %else 97 section .text code 98 %endif 99 ___ 100 push(@out,$tmp); 101 } 102 } 103 104 sub ::function_begin_B 105 { my $func=shift; 106 my $global=($func !~ /^_/); 107 my $begin="${::lbdecor}_${func}_begin"; 108 109 $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops 110 111 &::LABEL($func,$global?"$begin":"$nmdecor$func"); 112 $func=$nmdecor.$func; 113 114 push(@out,"${drdecor}global $func\n") if ($global); 115 push(@out,"${drdecor}align 16\n"); 116 push(@out,"$func:\n"); 117 push(@out,"$begin:\n") if ($global); 118 $::stack=4; 119 } 120 121 sub ::function_end_B 122 { $::stack=0; 123 &::wipe_labels(); 124 } 125 126 sub ::file_end 127 { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) 128 { my $comm=<<___; 129 ${drdecor}segment .bss 130 ${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 16 131 ___ 132 # comment out OPENSSL_ia32cap_P declarations 133 grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; 134 push (@out,$comm) 135 } 136 push (@out,$initseg) if ($initseg); 137 } 138 139 sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } 140 141 sub ::external_label 142 { foreach(@_) 143 { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } 144 } 145 146 sub ::public_label 147 { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 148 149 sub ::data_byte 150 { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } 151 sub ::data_short 152 { push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n"); } 153 sub ::data_word 154 { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } 155 156 sub ::align 157 { push(@out,"${drdecor}align\t$_[0]\n"); } 158 159 sub ::picmeup 160 { my($dst,$sym)=@_; 161 &::lea($dst,&::DWP($sym)); 162 } 163 164 sub ::initseg 165 { my $f=$nmdecor.shift; 166 if ($::win32) 167 { $initseg=<<___; 168 segment .CRT\$XCU data align=4 169 extern $f 170 dd $f 171 ___ 172 } 173 } 174 175 sub ::dataseg 176 { if ($mwerks) { push(@out,".section\t.data,4\n"); } 177 else { push(@out,"section\t.data align=4\n"); } 178 } 179 180 sub ::safeseh 181 { my $nm=shift; 182 push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n"); 183 push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n"); 184 push(@out,"%endif\n"); 185 } 186 187 1; 188
