Padlock engine: make it independent of inline assembler.
[openssl.git] / crypto / perlasm / x86nasm.pl
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;