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 |