diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm/ppc-xlate.pl')
-rwxr-xr-x | src/lib/libcrypto/perlasm/ppc-xlate.pl | 152 |
1 files changed, 0 insertions, 152 deletions
diff --git a/src/lib/libcrypto/perlasm/ppc-xlate.pl b/src/lib/libcrypto/perlasm/ppc-xlate.pl deleted file mode 100755 index 4579671c97..0000000000 --- a/src/lib/libcrypto/perlasm/ppc-xlate.pl +++ /dev/null | |||
@@ -1,152 +0,0 @@ | |||
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; | ||