diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm')
-rwxr-xr-x | src/lib/libcrypto/perlasm/ppc-xlate.pl | 152 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86gas.pl | 247 |
2 files changed, 399 insertions, 0 deletions
diff --git a/src/lib/libcrypto/perlasm/ppc-xlate.pl b/src/lib/libcrypto/perlasm/ppc-xlate.pl new file mode 100755 index 0000000000..4579671c97 --- /dev/null +++ b/src/lib/libcrypto/perlasm/ppc-xlate.pl | |||
@@ -0,0 +1,152 @@ | |||
1 | #!/usr/bin/env perl | ||
2 | |||
3 | # PowerPC assembler distiller by <appro>. | ||
4 | |||
5 | my $flavour = shift; | ||
6 | my $output = shift; | ||
7 | open STDOUT,">$output" || die "can't open $output: $!"; | ||
8 | |||
9 | my %GLOBALS; | ||
10 | my $dotinlocallabels=($flavour=~/linux/)?1:0; | ||
11 | |||
12 | ################################################################ | ||
13 | # directives which need special treatment on different platforms | ||
14 | ################################################################ | ||
15 | my $globl = sub { | ||
16 | my $junk = shift; | ||
17 | my $name = shift; | ||
18 | my $global = \$GLOBALS{$name}; | ||
19 | my $ret; | ||
20 | |||
21 | $name =~ s|^[\.\_]||; | ||
22 | |||
23 | SWITCH: for ($flavour) { | ||
24 | /aix/ && do { $name = ".$name"; | ||
25 | last; | ||
26 | }; | ||
27 | /osx/ && do { $name = "_$name"; | ||
28 | last; | ||
29 | }; | ||
30 | /linux.*32/ && do { $ret .= ".globl $name\n"; | ||
31 | $ret .= ".type $name,\@function"; | ||
32 | last; | ||
33 | }; | ||
34 | /linux.*64/ && do { $ret .= ".globl .$name\n"; | ||
35 | $ret .= ".type .$name,\@function\n"; | ||
36 | $ret .= ".section \".opd\",\"aw\"\n"; | ||
37 | $ret .= ".globl $name\n"; | ||
38 | $ret .= ".align 3\n"; | ||
39 | $ret .= "$name:\n"; | ||
40 | $ret .= ".quad .$name,.TOC.\@tocbase,0\n"; | ||
41 | $ret .= ".size $name,24\n"; | ||
42 | $ret .= ".previous\n"; | ||
43 | |||
44 | $name = ".$name"; | ||
45 | last; | ||
46 | }; | ||
47 | } | ||
48 | |||
49 | $ret = ".globl $name" if (!$ret); | ||
50 | $$global = $name; | ||
51 | $ret; | ||
52 | }; | ||
53 | my $text = sub { | ||
54 | ($flavour =~ /aix/) ? ".csect" : ".text"; | ||
55 | }; | ||
56 | my $machine = sub { | ||
57 | my $junk = shift; | ||
58 | my $arch = shift; | ||
59 | if ($flavour =~ /osx/) | ||
60 | { $arch =~ s/\"//g; | ||
61 | $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); | ||
62 | } | ||
63 | ".machine $arch"; | ||
64 | }; | ||
65 | my $asciz = sub { | ||
66 | shift; | ||
67 | my $line = join(",",@_); | ||
68 | if ($line =~ /^"(.*)"$/) | ||
69 | { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } | ||
70 | else | ||
71 | { ""; } | ||
72 | }; | ||
73 | |||
74 | ################################################################ | ||
75 | # simplified mnemonics not handled by at least one assembler | ||
76 | ################################################################ | ||
77 | my $cmplw = sub { | ||
78 | my $f = shift; | ||
79 | my $cr = 0; $cr = shift if ($#_>1); | ||
80 | # Some out-of-date 32-bit GNU assembler just can't handle cmplw... | ||
81 | ($flavour =~ /linux.*32/) ? | ||
82 | " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : | ||
83 | " cmplw ".join(',',$cr,@_); | ||
84 | }; | ||
85 | my $bdnz = sub { | ||
86 | my $f = shift; | ||
87 | my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint | ||
88 | " bc $bo,0,".shift; | ||
89 | } if ($flavour!~/linux/); | ||
90 | my $bltlr = sub { | ||
91 | my $f = shift; | ||
92 | my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint | ||
93 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
94 | " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 : | ||
95 | " bclr $bo,0"; | ||
96 | }; | ||
97 | my $bnelr = sub { | ||
98 | my $f = shift; | ||
99 | my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint | ||
100 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
101 | " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 : | ||
102 | " bclr $bo,2"; | ||
103 | }; | ||
104 | my $beqlr = sub { | ||
105 | my $f = shift; | ||
106 | my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint | ||
107 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
108 | " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : | ||
109 | " bclr $bo,2"; | ||
110 | }; | ||
111 | # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two | ||
112 | # arguments is 64, with "operand out of range" error. | ||
113 | my $extrdi = sub { | ||
114 | my ($f,$ra,$rs,$n,$b) = @_; | ||
115 | $b = ($b+$n)&63; $n = 64-$n; | ||
116 | " rldicl $ra,$rs,$b,$n"; | ||
117 | }; | ||
118 | |||
119 | while($line=<>) { | ||
120 | |||
121 | $line =~ s|[#!;].*$||; # get rid of asm-style comments... | ||
122 | $line =~ s|/\*.*\*/||; # ... and C-style comments... | ||
123 | $line =~ s|^\s+||; # ... and skip white spaces in beginning... | ||
124 | $line =~ s|\s+$||; # ... and at the end | ||
125 | |||
126 | { | ||
127 | $line =~ s|\b\.L(\w+)|L$1|g; # common denominator for Locallabel | ||
128 | $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); | ||
129 | } | ||
130 | |||
131 | { | ||
132 | $line =~ s|(^[\.\w]+)\:\s*||; | ||
133 | my $label = $1; | ||
134 | printf "%s:",($GLOBALS{$label} or $label) if ($label); | ||
135 | } | ||
136 | |||
137 | { | ||
138 | $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; | ||
139 | my $c = $1; $c = "\t" if ($c eq ""); | ||
140 | my $mnemonic = $2; | ||
141 | my $f = $3; | ||
142 | my $opcode = eval("\$$mnemonic"); | ||
143 | $line =~ s|\bc?[rf]([0-9]+)\b|$1|g if ($c ne "." and $flavour !~ /osx/); | ||
144 | if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); } | ||
145 | elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } | ||
146 | } | ||
147 | |||
148 | print $line if ($line); | ||
149 | print "\n"; | ||
150 | } | ||
151 | |||
152 | close STDOUT; | ||
diff --git a/src/lib/libcrypto/perlasm/x86gas.pl b/src/lib/libcrypto/perlasm/x86gas.pl new file mode 100644 index 0000000000..6eab727fd4 --- /dev/null +++ b/src/lib/libcrypto/perlasm/x86gas.pl | |||
@@ -0,0 +1,247 @@ | |||
1 | #!/usr/bin/env perl | ||
2 | |||
3 | package x86gas; | ||
4 | |||
5 | *out=\@::out; | ||
6 | |||
7 | $::lbdecor=$::aout?"L":".L"; # local label decoration | ||
8 | $nmdecor=($::aout or $::coff)?"_":""; # external name decoration | ||
9 | |||
10 | $initseg=""; | ||
11 | |||
12 | $align=16; | ||
13 | $align=log($align)/log(2) if ($::aout); | ||
14 | $com_start="#" if ($::aout or $::coff); | ||
15 | |||
16 | sub opsize() | ||
17 | { my $reg=shift; | ||
18 | if ($reg =~ m/^%e/o) { "l"; } | ||
19 | elsif ($reg =~ m/^%[a-d][hl]$/o) { "b"; } | ||
20 | elsif ($reg =~ m/^%[xm]/o) { undef; } | ||
21 | else { "w"; } | ||
22 | } | ||
23 | |||
24 | # swap arguments; | ||
25 | # expand opcode with size suffix; | ||
26 | # prefix numeric constants with $; | ||
27 | sub ::generic | ||
28 | { my($opcode,@arg)=@_; | ||
29 | my($suffix,$dst,$src); | ||
30 | |||
31 | @arg=reverse(@arg); | ||
32 | |||
33 | for (@arg) | ||
34 | { s/^(\*?)(e?[a-dsixphl]{2})$/$1%$2/o; # gp registers | ||
35 | s/^([xy]?mm[0-7])$/%$1/o; # xmm/mmx registers | ||
36 | s/^(\-?[0-9]+)$/\$$1/o; # constants | ||
37 | s/^(\-?0x[0-9a-f]+)$/\$$1/o; # constants | ||
38 | } | ||
39 | |||
40 | $dst = $arg[$#arg] if ($#arg>=0); | ||
41 | $src = $arg[$#arg-1] if ($#arg>=1); | ||
42 | if ($dst =~ m/^%/o) { $suffix=&opsize($dst); } | ||
43 | elsif ($src =~ m/^%/o) { $suffix=&opsize($src); } | ||
44 | else { $suffix="l"; } | ||
45 | undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o); | ||
46 | |||
47 | if ($#_==0) { &::emit($opcode); } | ||
48 | elsif ($opcode =~ m/^j/o && $#_==1) { &::emit($opcode,@arg); } | ||
49 | elsif ($opcode eq "call" && $#_==1) { &::emit($opcode,@arg); } | ||
50 | elsif ($opcode =~ m/^set/&& $#_==1) { &::emit($opcode,@arg); } | ||
51 | else { &::emit($opcode.$suffix,@arg);} | ||
52 | |||
53 | 1; | ||
54 | } | ||
55 | # | ||
56 | # opcodes not covered by ::generic above, mostly inconsistent namings... | ||
57 | # | ||
58 | sub ::movzx { &::movzb(@_); } | ||
59 | sub ::pushfd { &::pushfl; } | ||
60 | sub ::popfd { &::popfl; } | ||
61 | sub ::cpuid { &::emit(".byte\t0x0f,0xa2"); } | ||
62 | sub ::rdtsc { &::emit(".byte\t0x0f,0x31"); } | ||
63 | |||
64 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } | ||
65 | sub ::call_ptr { &::generic("call","*$_[0]"); } | ||
66 | sub ::jmp_ptr { &::generic("jmp","*$_[0]"); } | ||
67 | |||
68 | *::bswap = sub { &::emit("bswap","%$_[0]"); } if (!$::i386); | ||
69 | |||
70 | sub ::DWP | ||
71 | { my($addr,$reg1,$reg2,$idx)=@_; | ||
72 | my $ret=""; | ||
73 | |||
74 | $addr =~ s/^\s+//; | ||
75 | # prepend global references with optional underscore | ||
76 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; | ||
77 | |||
78 | $reg1 = "%$reg1" if ($reg1); | ||
79 | $reg2 = "%$reg2" if ($reg2); | ||
80 | |||
81 | $ret .= $addr if (($addr ne "") && ($addr ne 0)); | ||
82 | |||
83 | if ($reg2) | ||
84 | { $idx!= 0 or $idx=1; | ||
85 | $ret .= "($reg1,$reg2,$idx)"; | ||
86 | } | ||
87 | elsif ($reg1) | ||
88 | { $ret .= "($reg1)"; } | ||
89 | |||
90 | $ret; | ||
91 | } | ||
92 | sub ::QWP { &::DWP(@_); } | ||
93 | sub ::BP { &::DWP(@_); } | ||
94 | sub ::BC { @_; } | ||
95 | sub ::DWC { @_; } | ||
96 | |||
97 | sub ::file | ||
98 | { push(@out,".file\t\"$_[0].s\"\n.text\n"); } | ||
99 | |||
100 | sub ::function_begin_B | ||
101 | { my $func=shift; | ||
102 | my $global=($func !~ /^_/); | ||
103 | my $begin="${::lbdecor}_${func}_begin"; | ||
104 | |||
105 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); | ||
106 | $func=$nmdecor.$func; | ||
107 | |||
108 | push(@out,".globl\t$func\n") if ($global); | ||
109 | if ($::coff) | ||
110 | { push(@out,".def\t$func;\t.scl\t".(3-$global).";\t.type\t32;\t.endef\n"); } | ||
111 | elsif (($::aout and !$::pic) or $::macosx) | ||
112 | { } | ||
113 | else | ||
114 | { push(@out,".type $func,\@function\n"); } | ||
115 | push(@out,".align\t$align\n"); | ||
116 | push(@out,"$func:\n"); | ||
117 | push(@out,"$begin:\n") if ($global); | ||
118 | $::stack=4; | ||
119 | } | ||
120 | |||
121 | sub ::function_end_B | ||
122 | { my $func=shift; | ||
123 | push(@out,".size\t$nmdecor$func,.-".&::LABEL($func)."\n") if ($::elf); | ||
124 | $::stack=0; | ||
125 | &::wipe_labels(); | ||
126 | } | ||
127 | |||
128 | sub ::comment | ||
129 | { | ||
130 | if (!defined($com_start) or $::elf) | ||
131 | { # Regarding $::elf above... | ||
132 | # GNU and SVR4 as'es use different comment delimiters, | ||
133 | push(@out,"\n"); # so we just skip ELF comments... | ||
134 | return; | ||
135 | } | ||
136 | foreach (@_) | ||
137 | { | ||
138 | if (/^\s*$/) | ||
139 | { push(@out,"\n"); } | ||
140 | else | ||
141 | { push(@out,"\t$com_start $_ $com_end\n"); } | ||
142 | } | ||
143 | } | ||
144 | |||
145 | sub ::external_label | ||
146 | { foreach(@_) { &::LABEL($_,$nmdecor.$_); } } | ||
147 | |||
148 | sub ::public_label | ||
149 | { push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | ||
150 | |||
151 | sub ::file_end | ||
152 | { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) { | ||
153 | my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,4"; | ||
154 | if ($::elf) { push (@out,"$tmp,4\n"); } | ||
155 | else { push (@out,"$tmp\n"); } | ||
156 | } | ||
157 | if ($::macosx) | ||
158 | { if (%non_lazy_ptr) | ||
159 | { push(@out,".section __IMPORT,__pointers,non_lazy_symbol_pointers\n"); | ||
160 | foreach $i (keys %non_lazy_ptr) | ||
161 | { push(@out,"$non_lazy_ptr{$i}:\n.indirect_symbol\t$i\n.long\t0\n"); } | ||
162 | } | ||
163 | } | ||
164 | push(@out,$initseg) if ($initseg); | ||
165 | } | ||
166 | |||
167 | sub ::data_byte { push(@out,".byte\t".join(',',@_)."\n"); } | ||
168 | sub ::data_word { push(@out,".long\t".join(',',@_)."\n"); } | ||
169 | |||
170 | sub ::align | ||
171 | { my $val=$_[0],$p2,$i; | ||
172 | if ($::aout) | ||
173 | { for ($p2=0;$val!=0;$val>>=1) { $p2++; } | ||
174 | $val=$p2-1; | ||
175 | $val.=",0x90"; | ||
176 | } | ||
177 | push(@out,".align\t$val\n"); | ||
178 | } | ||
179 | |||
180 | sub ::picmeup | ||
181 | { my($dst,$sym,$base,$reflabel)=@_; | ||
182 | |||
183 | if ($::pic && ($::elf || $::aout)) | ||
184 | { if (!defined($base)) | ||
185 | { &::call(&::label("PIC_me_up")); | ||
186 | &::set_label("PIC_me_up"); | ||
187 | &::blindpop($dst); | ||
188 | $base=$dst; | ||
189 | $reflabel=&::label("PIC_me_up"); | ||
190 | } | ||
191 | if ($::macosx) | ||
192 | { my $indirect=&::static_label("$nmdecor$sym\$non_lazy_ptr"); | ||
193 | &::mov($dst,&::DWP("$indirect-$reflabel",$base)); | ||
194 | $non_lazy_ptr{"$nmdecor$sym"}=$indirect; | ||
195 | } | ||
196 | else | ||
197 | { &::lea($dst,&::DWP("_GLOBAL_OFFSET_TABLE_+[.-$reflabel]", | ||
198 | $base)); | ||
199 | &::mov($dst,&::DWP("$sym\@GOT",$dst)); | ||
200 | } | ||
201 | } | ||
202 | else | ||
203 | { &::lea($dst,&::DWP($sym)); } | ||
204 | } | ||
205 | |||
206 | sub ::initseg | ||
207 | { my $f=$nmdecor.shift; | ||
208 | |||
209 | if ($::elf) | ||
210 | { $initseg.=<<___; | ||
211 | .section .init | ||
212 | call $f | ||
213 | jmp .Linitalign | ||
214 | .align $align | ||
215 | .Linitalign: | ||
216 | ___ | ||
217 | } | ||
218 | elsif ($::coff) | ||
219 | { $initseg.=<<___; # applies to both Cygwin and Mingw | ||
220 | .section .ctors | ||
221 | .long $f | ||
222 | ___ | ||
223 | } | ||
224 | elsif ($::macosx) | ||
225 | { $initseg.=<<___; | ||
226 | .mod_init_func | ||
227 | .align 2 | ||
228 | .long $f | ||
229 | ___ | ||
230 | } | ||
231 | elsif ($::aout) | ||
232 | { my $ctor="${nmdecor}_GLOBAL_\$I\$$f"; | ||
233 | $initseg.=".text\n"; | ||
234 | $initseg.=".type $ctor,\@function\n" if ($::pic); | ||
235 | $initseg.=<<___; # OpenBSD way... | ||
236 | .globl $ctor | ||
237 | .align 2 | ||
238 | $ctor: | ||
239 | jmp $f | ||
240 | ___ | ||
241 | } | ||
242 | } | ||
243 | |||
244 | sub ::dataseg | ||
245 | { push(@out,".data\n"); } | ||
246 | |||
247 | 1; | ||