123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464 |
- #!/usr/local/bin/perl
- package x86ms;
- $label="L000";
- %lb=( 'eax', 'al',
- 'ebx', 'bl',
- 'ecx', 'cl',
- 'edx', 'dl',
- 'ax', 'al',
- 'bx', 'bl',
- 'cx', 'cl',
- 'dx', 'dl',
- );
- %hb=( 'eax', 'ah',
- 'ebx', 'bh',
- 'ecx', 'ch',
- 'edx', 'dh',
- 'ax', 'ah',
- 'bx', 'bh',
- 'cx', 'ch',
- 'dx', 'dh',
- );
- sub main'asm_init_output { @out=(); }
- sub main'asm_get_output { return(@out); }
- sub main'get_labels { return(@labels); }
- sub main'external_label
- {
- push(@labels,@_);
- foreach (@_) {
- push(@out, "EXTRN\t_$_:DWORD\n");
- }
- }
- sub main'LB
- {
- (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
- return($lb{$_[0]});
- }
- sub main'HB
- {
- (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
- return($hb{$_[0]});
- }
- sub main'BP
- {
- &get_mem("BYTE",@_);
- }
- sub main'DWP
- {
- &get_mem("DWORD",@_);
- }
- sub main'QWP
- {
- &get_mem("QWORD",@_);
- }
- sub main'BC
- {
- return @_;
- }
- sub main'DWC
- {
- return @_;
- }
- sub main'stack_push
- {
- local($num)=@_;
- $stack+=$num*4;
- &main'sub("esp",$num*4);
- }
- sub main'stack_pop
- {
- local($num)=@_;
- $stack-=$num*4;
- &main'add("esp",$num*4);
- }
- sub get_mem
- {
- local($size,$addr,$reg1,$reg2,$idx)=@_;
- local($t,$post);
- local($ret)="$size PTR ";
- $addr =~ s/^\s+//;
- if ($addr =~ /^(.+)\+(.+)$/)
- {
- $reg2=&conv($1);
- $addr="_$2";
- }
- elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
- {
- $addr="_$addr";
- }
- if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
- $reg1="$regs{$reg1}" if defined($regs{$reg1});
- $reg2="$regs{$reg2}" if defined($regs{$reg2});
- if (($addr ne "") && ($addr ne 0))
- {
- if ($addr !~ /^-/)
- { $ret.=$addr; }
- else { $post=$addr; }
- }
- if ($reg2 ne "")
- {
- $t="";
- $t="*$idx" if ($idx != 0);
- $reg1="+".$reg1 if ("$reg1$post" ne "");
- $ret.="[$reg2$t$reg1$post]";
- }
- else
- {
- $ret.="[$reg1$post]"
- }
- $ret =~ s/\[\]//; # in case $addr was the only argument
- return($ret);
- }
- sub main'mov { &out2("mov",@_); }
- sub main'movb { &out2("mov",@_); }
- sub main'and { &out2("and",@_); }
- sub main'or { &out2("or",@_); }
- sub main'shl { &out2("shl",@_); }
- sub main'shr { &out2("shr",@_); }
- sub main'xor { &out2("xor",@_); }
- sub main'xorb { &out2("xor",@_); }
- sub main'add { &out2("add",@_); }
- sub main'adc { &out2("adc",@_); }
- sub main'sub { &out2("sub",@_); }
- sub main'sbb { &out2("sbb",@_); }
- sub main'rotl { &out2("rol",@_); }
- sub main'rotr { &out2("ror",@_); }
- sub main'exch { &out2("xchg",@_); }
- sub main'cmp { &out2("cmp",@_); }
- sub main'lea { &out2("lea",@_); }
- sub main'mul { &out1("mul",@_); }
- sub main'div { &out1("div",@_); }
- sub main'dec { &out1("dec",@_); }
- sub main'inc { &out1("inc",@_); }
- sub main'jmp { &out1("jmp",@_); }
- sub main'jmp_ptr { &out1p("jmp",@_); }
- sub main'je { &out1("je",@_); }
- sub main'jle { &out1("jle",@_); }
- sub main'jz { &out1("jz",@_); }
- sub main'jge { &out1("jge",@_); }
- sub main'jl { &out1("jl",@_); }
- sub main'ja { &out1("ja",@_); }
- sub main'jae { &out1("jae",@_); }
- sub main'jb { &out1("jb",@_); }
- sub main'jbe { &out1("jbe",@_); }
- sub main'jc { &out1("jc",@_); }
- sub main'jnc { &out1("jnc",@_); }
- sub main'jnz { &out1("jnz",@_); }
- sub main'jne { &out1("jne",@_); }
- sub main'jno { &out1("jno",@_); }
- sub main'push { &out1("push",@_); $stack+=4; }
- sub main'pop { &out1("pop",@_); $stack-=4; }
- sub main'pushf { &out0("pushfd"); $stack+=4; }
- sub main'popf { &out0("popfd"); $stack-=4; }
- sub main'bswap { &out1("bswap",@_); &using486(); }
- sub main'not { &out1("not",@_); }
- sub main'call { &out1("call",($_[0]=~/^\$L/?'':'_').$_[0]); }
- sub main'call_ptr { &out1p("call",@_); }
- sub main'ret { &out0("ret"); }
- sub main'nop { &out0("nop"); }
- sub main'test { &out2("test",@_); }
- sub main'bt { &out2("bt",@_); }
- sub main'leave { &out0("leave"); }
- sub main'cpuid { &out0("DW\t0A20Fh"); }
- sub main'rdtsc { &out0("DW\t0310Fh"); }
- sub main'halt { &out0("hlt"); }
- sub main'movz { &out2("movzx",@_); }
- sub main'neg { &out1("neg",@_); }
- sub main'cld { &out0("cld"); }
- # SSE2
- sub main'emms { &out0("emms"); }
- sub main'movd { &out2("movd",@_); }
- sub main'movq { &out2("movq",@_); }
- sub main'movdqu { &out2("movdqu",@_); }
- sub main'movdqa { &out2("movdqa",@_); }
- sub main'movdq2q{ &out2("movdq2q",@_); }
- sub main'movq2dq{ &out2("movq2dq",@_); }
- sub main'paddq { &out2("paddq",@_); }
- sub main'pmuludq{ &out2("pmuludq",@_); }
- sub main'psrlq { &out2("psrlq",@_); }
- sub main'psllq { &out2("psllq",@_); }
- sub main'pxor { &out2("pxor",@_); }
- sub main'por { &out2("por",@_); }
- sub main'pand { &out2("pand",@_); }
- sub out2
- {
- local($name,$p1,$p2)=@_;
- local($l,$t);
- push(@out,"\t$name\t");
- $t=&conv($p1).",";
- $l=length($t);
- push(@out,$t);
- $l=4-($l+9)/8;
- push(@out,"\t" x $l);
- push(@out,&conv($p2));
- push(@out,"\n");
- }
- sub out0
- {
- local($name)=@_;
- push(@out,"\t$name\n");
- }
- sub out1
- {
- local($name,$p1)=@_;
- local($l,$t);
- push(@out,"\t$name\t".&conv($p1)."\n");
- }
- sub conv
- {
- local($p)=@_;
- $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
- return $p;
- }
- sub using486
- {
- return if $using486;
- $using486++;
- grep(s/\.386/\.486/,@out);
- }
- sub main'file
- {
- local($file)=@_;
- local($tmp)=<<"EOF";
- TITLE $file.asm
- .386
- .model FLAT
- _TEXT\$ SEGMENT PAGE 'CODE'
- EOF
- push(@out,$tmp);
- }
- sub main'function_begin
- {
- local($func,$extra)=@_;
- push(@labels,$func);
- local($tmp)=<<"EOF";
- PUBLIC _$func
- $extra
- _$func PROC NEAR
- push ebp
- push ebx
- push esi
- push edi
- EOF
- push(@out,$tmp);
- $stack=20;
- }
- sub main'function_begin_B
- {
- local($func,$extra)=@_;
- local($tmp)=<<"EOF";
- PUBLIC _$func
- $extra
- _$func PROC NEAR
- EOF
- push(@out,$tmp);
- $stack=4;
- }
- sub main'function_end
- {
- local($func)=@_;
- local($tmp)=<<"EOF";
- pop edi
- pop esi
- pop ebx
- pop ebp
- ret
- _$func ENDP
- EOF
- push(@out,$tmp);
- $stack=0;
- %label=();
- }
- sub main'function_end_B
- {
- local($func)=@_;
- local($tmp)=<<"EOF";
- _$func ENDP
- EOF
- push(@out,$tmp);
- $stack=0;
- %label=();
- }
- sub main'function_end_A
- {
- local($func)=@_;
- local($tmp)=<<"EOF";
- pop edi
- pop esi
- pop ebx
- pop ebp
- ret
- EOF
- push(@out,$tmp);
- }
- sub main'file_end
- {
- # try to detect if SSE2 or MMX extensions were used...
- if (grep {/xmm[0-7]\s*,/i} @out) {
- grep {s/\.[3-7]86/\.686\n\t\.XMM/} @out;
- }
- elsif (grep {/mm[0-7]\s*,/i} @out) {
- grep {s/\.[3-7]86/\.686\n\t\.MMX/} @out;
- }
- push(@out,"_TEXT\$ ENDS\n");
- push(@out,"END\n");
- }
- sub main'wparam
- {
- local($num)=@_;
- return(&main'DWP($stack+$num*4,"esp","",0));
- }
- sub main'swtmp
- {
- return(&main'DWP($_[0]*4,"esp","",0));
- }
- # Should use swtmp, which is above esp. Linix can trash the stack above esp
- #sub main'wtmp
- # {
- # local($num)=@_;
- #
- # return(&main'DWP(-(($num+1)*4),"esp","",0));
- # }
- sub main'comment
- {
- foreach (@_)
- {
- push(@out,"\t; $_\n");
- }
- }
- sub main'public_label
- {
- $label{$_[0]}="_$_[0]" if (!defined($label{$_[0]}));
- push(@out,"PUBLIC\t$label{$_[0]}\n");
- }
- sub main'label
- {
- if (!defined($label{$_[0]}))
- {
- $label{$_[0]}="\$${label}${_[0]}";
- $label++;
- }
- return($label{$_[0]});
- }
- sub main'set_label
- {
- if (!defined($label{$_[0]}))
- {
- $label{$_[0]}="\$${label}${_[0]}";
- $label++;
- }
- if ($_[1]!=0 && $_[1]>1)
- {
- main'align($_[1]);
- }
- if((defined $_[2]) && ($_[2] == 1))
- {
- push(@out,"$label{$_[0]}::\n");
- }
- elsif ($label{$_[0]} !~ /^\$/)
- {
- push(@out,"$label{$_[0]}\tLABEL PTR\n");
- }
- else
- {
- push(@out,"$label{$_[0]}:\n");
- }
- }
- sub main'data_byte
- {
- push(@out,"\tDB\t".join(',',@_)."\n");
- }
- sub main'data_word
- {
- push(@out,"\tDD\t".join(',',@_)."\n");
- }
- sub main'align
- {
- push(@out,"\tALIGN\t$_[0]\n");
- }
- sub out1p
- {
- local($name,$p1)=@_;
- local($l,$t);
- push(@out,"\t$name\t".&conv($p1)."\n");
- }
- sub main'picmeup
- {
- local($dst,$sym)=@_;
- &main'lea($dst,&main'DWP($sym));
- }
- sub main'blindpop { &out1("pop",@_); }
- sub main'initseg
- {
- local($f)=@_;
- local($tmp)=<<___;
- OPTION DOTNAME
- .CRT\$XCU SEGMENT DWORD PUBLIC 'DATA'
- EXTRN _$f:NEAR
- DD _$f
- .CRT\$XCU ENDS
- ___
- push(@out,$tmp);
- }
- 1;
|