link warnings caused by nasm modules.
[openssl.git] / crypto / perlasm / x86nasm.pl
1 #!/usr/bin/env perl
2
3 package x86nasm;
4
5 *out=\@::out;
6
7 $lprfx="\@L";
8 $label="000";
9 $under=($::netware)?'':'_';
10
11 sub ::generic
12 { my $opcode=shift;
13   my $tmp;
14
15     if (!$::mwerks)
16     {   if    ($opcode =~ m/^j/o && $#_==0) # optimize jumps
17         {   $_[0] = "NEAR $_[0]";       }
18         elsif ($opcode eq "lea" && $#_==1)# wipe storage qualifier from lea
19         {   $_[1] =~ s/^[^\[]*\[/\[/o;  }
20     }
21     &::emit($opcode,@_);
22   1;
23 }
24 #
25 # opcodes not covered by ::generic above, mostly inconsistent namings...
26 #
27 sub ::movz      { &::movzx(@_);         }
28 sub ::pushf     { &::pushfd;            }
29 sub ::popf      { &::popfd;             }
30
31 sub ::call      { &::emit("call",(&islabel($_[0]) or "$under$_[0]")); }
32 sub ::call_ptr  { &::emit("call",@_);   }
33 sub ::jmp_ptr   { &::emit("jmp",@_);    }
34
35 # chosen SSE instructions
36 sub ::movq
37 { my($p1,$p2,$optimize)=@_;
38
39     if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
40     # movq between mmx registers can sink Intel CPUs
41     {   &::pshufw($p1,$p2,0xe4);                }
42     else
43     {   &::emit("movq",@_);                     }
44 }
45 sub ::pshufw { &::emit("pshufw",@_); }
46
47 sub get_mem
48 { my($size,$addr,$reg1,$reg2,$idx)=@_;
49   my($post,$ret);
50
51     if ($size ne "")
52     {   $ret .= "$size";
53         $ret .= " PTR" if ($::mwerks);
54         $ret .= " ";
55     }
56     $ret .= "[";
57
58     $addr =~ s/^\s+//;
59     # prepend global references with optional underscore
60     $addr =~ s/^([^\+\-0-9][^\+\-]*)/islabel($1) or "$under$1"/ige;
61     # put address arithmetic expression in parenthesis
62     $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/);
63
64     if (($addr ne "") && ($addr ne 0))
65     {   if ($addr !~ /^-/)      { $ret .= "$addr+"; }
66         else                    { $post=$addr;      }
67     }
68
69     if ($reg2 ne "")
70     {   $idx!=0 or $idx=1;
71         $ret .= "$reg2*$idx";
72         $ret .= "+$reg1" if ($reg1 ne "");
73     }
74     else
75     {   $ret .= "$reg1";   }
76
77     $ret .= "$post]";
78     $ret =~ s/\+\]/]/; # in case $addr was the only argument
79
80   $ret;
81 }
82 sub ::BP        { &get_mem("BYTE",@_);  }
83 sub ::DWP       { &get_mem("DWORD",@_); }
84 sub ::QWP       { &get_mem("",@_);      }
85 sub ::BC        { (($::mwerks)?"":"BYTE ")."@_";  }
86 sub ::DWC       { (($::mwerks)?"":"DWORD ")."@_"; }
87
88 sub ::file
89 {   if ($::mwerks)      { push(@out,".section\t.text\n"); }
90     else
91     { my $tmp=<<___;
92 %ifdef __omf__
93 section code    use32 class=code align=64
94 %else
95 section .text   code align=64
96 %endif
97 ___
98         push(@out,$tmp);
99     }
100 }
101
102 sub ::function_begin_B
103 { my $func=$under.shift;
104   my $tmp=<<___;
105 global  $func
106 align   16
107 $func:
108 ___
109     push(@out,$tmp);
110     $::stack=4;
111 }
112 sub ::function_end_B
113 { my $i;
114     foreach $i (%label) { undef $label{$i} if ($label{$i} =~ /^$prfx/);  }
115     $::stack=0;
116 }
117
118 sub ::file_end
119 {   # try to detect if SSE2 or MMX extensions were used on Win32...
120     if ($::win32 && grep {/\s+[x]*mm[0-7]/i} @out)
121     {   # One can argue that it's wasteful to craft every
122         # SSE/MMX module with this snippet... Well, it's 72
123         # bytes long and for the moment we have two modules.
124         # Let's argue when we have 7 modules or so...
125         #
126         # $1<<10 sets a reserved bit to signal that variable
127         # was initialized already...
128         my $tmp=<<___;
129 align   16
130 ${lprfx}OPENSSL_ia32cap_init:
131         lea     edx,[${under}OPENSSL_ia32cap_P]
132         cmp     DWORD [edx],0
133         jne     NEAR ${lprfx}nocpuid
134         mov     DWORD [edx],1<<10
135         pushfd
136         pop     eax
137         mov     ecx,eax
138         xor     eax,1<<21
139         push    eax
140         popfd
141         pushfd
142         pop     eax
143         xor     eax,ecx
144         bt      eax,21
145         jnc     NEAR ${lprfx}nocpuid
146         push    edi
147         push    ebx
148         mov     edi,edx
149         mov     eax,1
150         cpuid
151         or      edx,1<<10
152         mov     DWORD [edi],edx
153         pop     ebx
154         pop     edi
155 ${lprfx}nocpuid:
156         ret
157
158 segment .CRT\$XCU data align=4
159 dd      ${lprfx}OPENSSL_ia32cap_init
160 segment .bss
161 common  ${under}OPENSSL_ia32cap_P 4
162 ___
163         # comment out OPENSSL_ia32cap_P declarations
164         grep {s/(^extern\s+${under}OPENSSL_ia32cap_P)/\;$1/} @out;
165         push (@out,$tmp);               
166     }
167 }
168
169 sub ::comment {   foreach (@_) { push(@out,"\t; $_\n"); }   }
170
171 sub islabel     # see is argument is known label
172 { my $i;
173     foreach $i (%label) { return $label{$i} if ($label{$i} eq $_[0]); }
174   undef;
175 }
176
177 sub ::external_label
178 {   push(@labels,@_);
179     foreach (@_)
180     {   push(@out,".") if ($::mwerks);
181         push(@out, "extern\t${under}$_\n");
182     }
183 }
184
185 sub ::public_label
186 {   $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
187     push(@out,"global\t$label{$_[0]}\n");
188 }
189
190 sub ::label
191 {   if (!defined($label{$_[0]}))
192     {   $label{$_[0]}="${lprfx}${label}${_[0]}"; $label++;   }
193   $label{$_[0]};
194 }
195
196 sub ::set_label
197 { my $label=&::label($_[0]);
198     &::align($_[1]) if ($_[1]>1);
199     push(@out,"$label{$_[0]}:\n");
200 }
201
202 sub ::data_byte
203 {   push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n");        }
204
205 sub ::data_word
206 {   push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n");        }
207
208 sub ::align
209 {   push(@out,".") if ($::mwerks); push(@out,"align\t$_[0]\n"); }
210
211 sub ::picmeup
212 { my($dst,$sym)=@_;
213     &::lea($dst,&::DWP($sym));
214 }
215
216 sub ::initseg
217 { my($f)=$under.shift;
218     if ($::win32)
219     { my($tmp)=<<___;
220 segment .CRT\$XCU rdata align=4
221 extern  $f
222 dd      $f
223 ___
224         push(@out,$tmp);
225     }
226 }
227
228 1;