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