1238405Sjkim#!/usr/bin/env perl 255714Skris 355714Skrispackage x86nasm; 455714Skris 5238405Sjkim*out=\@::out; 655714Skris 7238405Sjkim$::lbdecor="L\$"; # local label decoration 8238405Sjkim$nmdecor=$::netware?"":"_"; # external name decoration 9238405Sjkim$drdecor=$::mwerks?".":""; # directive decoration 1055714Skris 11238405Sjkim$initseg=""; 1255714Skris 13238405Sjkimsub ::generic 14238405Sjkim{ my $opcode=shift; 15238405Sjkim my $tmp; 1655714Skris 17238405Sjkim if (!$::mwerks) 18238405Sjkim { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps 19238405Sjkim { $_[0] = "NEAR $_[0]"; } 20238405Sjkim elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea 21238405Sjkim { $_[1] =~ s/^[^\[]*\[/\[/o; } 22238405Sjkim elsif ($opcode eq "clflush" && $#_==0) 23238405Sjkim { $_[0] =~ s/^[^\[]*\[/\[/o; } 24238405Sjkim } 25238405Sjkim &::emit($opcode,@_); 26238405Sjkim 1; 2755714Skris} 28238405Sjkim# 29238405Sjkim# opcodes not covered by ::generic above, mostly inconsistent namings... 30238405Sjkim# 31238405Sjkimsub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } 32238405Sjkimsub ::call_ptr { &::emit("call",@_); } 33238405Sjkimsub ::jmp_ptr { &::emit("jmp",@_); } 3455714Skris 3555714Skrissub get_mem 36238405Sjkim{ my($size,$addr,$reg1,$reg2,$idx)=@_; 37238405Sjkim my($post,$ret); 3855714Skris 39290207Sjkim if (!defined($idx) && 1*$reg2) { $idx=$reg2; $reg2=$reg1; undef $reg1; } 40290207Sjkim 41238405Sjkim if ($size ne "") 42238405Sjkim { $ret .= "$size"; 43238405Sjkim $ret .= " PTR" if ($::mwerks); 44238405Sjkim $ret .= " "; 45238405Sjkim } 46238405Sjkim $ret .= "["; 47109998Smarkm 48238405Sjkim $addr =~ s/^\s+//; 49238405Sjkim # prepend global references with optional underscore 50238405Sjkim $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; 51238405Sjkim # put address arithmetic expression in parenthesis 52238405Sjkim $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); 5355714Skris 54238405Sjkim if (($addr ne "") && ($addr ne 0)) 55238405Sjkim { if ($addr !~ /^-/) { $ret .= "$addr+"; } 56238405Sjkim else { $post=$addr; } 57238405Sjkim } 5855714Skris 59238405Sjkim if ($reg2 ne "") 60238405Sjkim { $idx!=0 or $idx=1; 61238405Sjkim $ret .= "$reg2*$idx"; 62238405Sjkim $ret .= "+$reg1" if ($reg1 ne ""); 63238405Sjkim } 64238405Sjkim else 65238405Sjkim { $ret .= "$reg1"; } 6655714Skris 67238405Sjkim $ret .= "$post]"; 68238405Sjkim $ret =~ s/\+\]/]/; # in case $addr was the only argument 6955714Skris 70238405Sjkim $ret; 71238405Sjkim} 72238405Sjkimsub ::BP { &get_mem("BYTE",@_); } 73238405Sjkimsub ::DWP { &get_mem("DWORD",@_); } 74238405Sjkimsub ::WP { &get_mem("WORD",@_); } 75238405Sjkimsub ::QWP { &get_mem("",@_); } 76238405Sjkimsub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } 77238405Sjkimsub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } 78160814Ssimon 79238405Sjkimsub ::file 80238405Sjkim{ if ($::mwerks) { push(@out,".section\t.text,64\n"); } 81238405Sjkim else 82238405Sjkim { my $tmp=<<___; 83238405Sjkim%ifidn __OUTPUT_FORMAT__,obj 84238405Sjkimsection code use32 class=code align=64 85238405Sjkim%elifidn __OUTPUT_FORMAT__,win32 86238405Sjkim\$\@feat.00 equ 1 87238405Sjkimsection .text code align=64 88160814Ssimon%else 89238405Sjkimsection .text code 90160814Ssimon%endif 91160814Ssimon___ 9255714Skris push(@out,$tmp); 93238405Sjkim } 94238405Sjkim} 9555714Skris 96238405Sjkimsub ::function_begin_B 97238405Sjkim{ my $func=shift; 98238405Sjkim my $global=($func !~ /^_/); 99238405Sjkim my $begin="${::lbdecor}_${func}_begin"; 10055714Skris 101238405Sjkim $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops 10255714Skris 103238405Sjkim &::LABEL($func,$global?"$begin":"$nmdecor$func"); 104238405Sjkim $func=$nmdecor.$func; 10555714Skris 106238405Sjkim push(@out,"${drdecor}global $func\n") if ($global); 107238405Sjkim push(@out,"${drdecor}align 16\n"); 108238405Sjkim push(@out,"$func:\n"); 109238405Sjkim push(@out,"$begin:\n") if ($global); 110238405Sjkim $::stack=4; 111238405Sjkim} 11255714Skris 113238405Sjkimsub ::function_end_B 114238405Sjkim{ $::stack=0; 115238405Sjkim &::wipe_labels(); 116238405Sjkim} 11755714Skris 118238405Sjkimsub ::file_end 119238405Sjkim{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) 120238405Sjkim { my $comm=<<___; 121238405Sjkim${drdecor}segment .bss 122290207Sjkim${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 16 123238405Sjkim___ 124238405Sjkim # comment out OPENSSL_ia32cap_P declarations 125238405Sjkim grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; 126238405Sjkim push (@out,$comm) 127238405Sjkim } 128238405Sjkim push (@out,$initseg) if ($initseg); 129238405Sjkim} 13055714Skris 131238405Sjkimsub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } 13255714Skris 133238405Sjkimsub ::external_label 134238405Sjkim{ foreach(@_) 135238405Sjkim { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } 136238405Sjkim} 13755714Skris 138238405Sjkimsub ::public_label 139238405Sjkim{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 14055714Skris 141238405Sjkimsub ::data_byte 142238405Sjkim{ push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } 143238405Sjkimsub ::data_short 144238405Sjkim{ push(@out,(($::mwerks)?".word\t":"dw\t").join(',',@_)."\n"); } 145238405Sjkimsub ::data_word 146238405Sjkim{ push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } 14755714Skris 148238405Sjkimsub ::align 149238405Sjkim{ push(@out,"${drdecor}align\t$_[0]\n"); } 15055714Skris 151238405Sjkimsub ::picmeup 152238405Sjkim{ my($dst,$sym)=@_; 153238405Sjkim &::lea($dst,&::DWP($sym)); 154238405Sjkim} 15555714Skris 156238405Sjkimsub ::initseg 157238405Sjkim{ my $f=$nmdecor.shift; 158238405Sjkim if ($::win32) 159238405Sjkim { $initseg=<<___; 160238405Sjkimsegment .CRT\$XCU data align=4 161238405Sjkimextern $f 162238405Sjkimdd $f 163238405Sjkim___ 164238405Sjkim } 165238405Sjkim} 166160814Ssimon 167238405Sjkimsub ::dataseg 168238405Sjkim{ if ($mwerks) { push(@out,".section\t.data,4\n"); } 169238405Sjkim else { push(@out,"section\t.data align=4\n"); } 170238405Sjkim} 17155714Skris 172238405Sjkimsub ::safeseh 173238405Sjkim{ my $nm=shift; 174238405Sjkim push(@out,"%if __NASM_VERSION_ID__ >= 0x02030000\n"); 175238405Sjkim push(@out,"safeseh ".&::LABEL($nm,$nmdecor.$nm)."\n"); 176238405Sjkim push(@out,"%endif\n"); 177238405Sjkim} 17855714Skris 179160814Ssimon1; 180