| OLD | NEW |
| (Empty) |
| 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 ($size ne "") | |
| 40 { $ret .= "$size"; | |
| 41 $ret .= " PTR" if ($::mwerks); | |
| 42 $ret .= " "; | |
| 43 } | |
| 44 $ret .= "["; | |
| 45 | |
| 46 $addr =~ s/^\s+//; | |
| 47 # prepend global references with optional underscore | |
| 48 $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; | |
| 49 # put address arithmetic expression in parenthesis | |
| 50 $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); | |
| 51 | |
| 52 if (($addr ne "") && ($addr ne 0)) | |
| 53 { if ($addr !~ /^-/) { $ret .= "$addr+"; } | |
| 54 else { $post=$addr; } | |
| 55 } | |
| 56 | |
| 57 if ($reg2 ne "") | |
| 58 { $idx!=0 or $idx=1; | |
| 59 $ret .= "$reg2*$idx"; | |
| 60 $ret .= "+$reg1" if ($reg1 ne ""); | |
| 61 } | |
| 62 else | |
| 63 { $ret .= "$reg1"; } | |
| 64 | |
| 65 $ret .= "$post]"; | |
| 66 $ret =~ s/\+\]/]/; # in case $addr was the only argument | |
| 67 | |
| 68 $ret; | |
| 69 } | |
| 70 sub ::BP { &get_mem("BYTE",@_); } | |
| 71 sub ::DWP { &get_mem("DWORD",@_); } | |
| 72 sub ::WP { &get_mem("WORD",@_); } | |
| 73 sub ::QWP { &get_mem("",@_); } | |
| 74 sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } | |
| 75 sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } | |
| 76 | |
| 77 sub ::file | |
| 78 { if ($::mwerks) { push(@out,".section\t.text,64\n"); } | |
| 79 else | |
| 80 { my $tmp=<<___; | |
| 81 %ifidn __OUTPUT_FORMAT__,obj | |
| 82 section code use32 class=code align=64 | |
| 83 %elifidn __OUTPUT_FORMAT__,win32 | |
| 84 \$\@feat.00 equ 1 | |
| 85 section .text code align=64 | |
| 86 %else | |
| 87 section .text code | |
| 88 %endif | |
| 89 ___ | |
| 90 push(@out,$tmp); | |
| 91 } | |
| 92 } | |
| 93 | |
| 94 sub ::function_begin_B | |
| 95 { my $func=shift; | |
| 96 my $global=($func !~ /^_/); | |
| 97 my $begin="${::lbdecor}_${func}_begin"; | |
| 98 | |
| 99 $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops | |
| 100 | |
| 101 &::LABEL($func,$global?"$begin":"$nmdecor$func"); | |
| 102 $func=$nmdecor.$func; | |
| 103 | |
| 104 push(@out,"${drdecor}global $func\n") if ($global); | |
| 105 push(@out,"${drdecor}align 16\n"); | |
| 106 push(@out,"$func:\n"); | |
| 107 push(@out,"$begin:\n") if ($global); | |
| 108 $::stack=4; | |
| 109 } | |
| 110 | |
| 111 sub ::function_end_B | |
| 112 { $::stack=0; | |
| 113 &::wipe_labels(); | |
| 114 } | |
| 115 | |
| 116 sub ::file_end | |
| 117 { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) | |
| 118 { my $comm=<<___; | |
| 119 ${drdecor}segment .bss | |
| 120 ${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 8 | |
| 121 ___ | |
| 122 # comment out OPENSSL_ia32cap_P declarations | |
| 123 grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; | |
| 124 push (@out,$comm) | |
| 125 } | |
| 126 push (@out,$initseg) if ($initseg); | |
| 127 } | |
| 128 | |
| 129 sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } | |
| 130 | |
| 131 sub ::external_label | |
| 132 { foreach(@_) | |
| 133 { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } | |
| 134 } | |
| 135 | |
| 136 sub ::public_label | |
| 137 { push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | |
| 138 | |
| 139 sub ::data_byte | |
| 140 { push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } | |
| 141 sub ::data_short | |
| 142 { push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n"); } | |
| 143 sub ::data_word | |
| 144 { push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } | |
| 145 | |
| 146 sub ::align | |
| 147 { push(@out,"${drdecor}align\t$_[0]\n"); } | |
| 148 | |
| 149 sub ::picmeup | |
| 150 { my($dst,$sym)=@_; | |
| 151 &::lea($dst,&::DWP($sym)); | |
| 152 } | |
| 153 | |
| 154 sub ::initseg | |
| 155 { my $f=$nmdecor.shift; | |
| 156 if ($::win32) | |
| 157 { $initseg=<<___; | |
| 158 segment .CRT\$XCU data align=4 | |
| 159 extern $f | |
| 160 dd $f | |
| 161 ___ | |
| 162 } | |
| 163 } | |
| 164 | |
| 165 sub ::dataseg | |
| 166 { if ($mwerks) { push(@out,".section\t.data,4\n"); } | |
| 167 else { push(@out,"section\t.data align=4\n"); } | |
| 168 } | |
| 169 | |
| 170 sub ::safeseh | |
| 171 { my $nm=shift; | |
| 172 push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n"); | |
| 173 push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n"); | |
| 174 push(@out,"%endif\n"); | |
| 175 } | |
| 176 | |
| 177 1; | |
| OLD | NEW |