]>
Commit | Line | Data |
---|---|---|
2c5d4daa AP |
1 | #!/usr/bin/env perl |
2 | ||
3 | # PowerPC assembler distiller by <appro>. | |
4 | ||
addd641f | 5 | my $flavour = shift; |
2c5d4daa AP |
6 | my $output = shift; |
7 | open STDOUT,">$output" || die "can't open $output: $!"; | |
8 | ||
2c5d4daa | 9 | my %GLOBALS; |
c6149e2f | 10 | my $dotinlocallabels=($flavour=~/linux/)?1:0; |
2c5d4daa AP |
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 | }; | |
f586d971 AP |
30 | /linux.*(32|64le)/ |
31 | && do { $ret .= ".globl $name\n"; | |
2c5d4daa | 32 | $ret .= ".type $name,\@function"; |
2c5d4daa AP |
33 | last; |
34 | }; | |
a3e07010 AP |
35 | /linux.*64/ && do { $ret .= ".globl $name\n"; |
36 | $ret .= ".type $name,\@function\n"; | |
2c5d4daa | 37 | $ret .= ".section \".opd\",\"aw\"\n"; |
2c5d4daa AP |
38 | $ret .= ".align 3\n"; |
39 | $ret .= "$name:\n"; | |
40 | $ret .= ".quad .$name,.TOC.\@tocbase,0\n"; | |
2c5d4daa AP |
41 | $ret .= ".previous\n"; |
42 | ||
43 | $name = ".$name"; | |
2c5d4daa AP |
44 | last; |
45 | }; | |
46 | } | |
47 | ||
48 | $ret = ".globl $name" if (!$ret); | |
49 | $$global = $name; | |
50 | $ret; | |
51 | }; | |
fe716ba6 | 52 | my $text = sub { |
f586d971 AP |
53 | my $ret = ($flavour =~ /aix/) ? ".csect" : ".text"; |
54 | $ret = ".abiversion 2\n".$ret if ($flavour =~ /linux.*64le/); | |
55 | $ret; | |
fe716ba6 | 56 | }; |
2c5d4daa AP |
57 | my $machine = sub { |
58 | my $junk = shift; | |
59 | my $arch = shift; | |
67d99090 AP |
60 | if ($flavour =~ /osx/) |
61 | { $arch =~ s/\"//g; | |
62 | $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); | |
63 | } | |
2c5d4daa AP |
64 | ".machine $arch"; |
65 | }; | |
a3e07010 | 66 | my $size = sub { |
d6019e16 | 67 | if ($flavour =~ /linux/) |
a3e07010 | 68 | { shift; |
d6019e16 | 69 | my $name = shift; $name =~ s|^[\.\_]||; |
f586d971 AP |
70 | my $ret = ".size $name,.-".($flavour=~/64$/?".":"").$name; |
71 | $ret .= "\n.size .$name,.-.$name" if ($flavour=~/64$/); | |
d6019e16 | 72 | $ret; |
a3e07010 AP |
73 | } |
74 | else | |
75 | { ""; } | |
76 | }; | |
d68ff710 AP |
77 | my $asciz = sub { |
78 | shift; | |
79 | my $line = join(",",@_); | |
80 | if ($line =~ /^"(.*)"$/) | |
287a9ee7 | 81 | { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } |
d68ff710 AP |
82 | else |
83 | { ""; } | |
84 | }; | |
8ff8a829 AP |
85 | my $quad = sub { |
86 | shift; | |
87 | my @ret; | |
88 | my ($hi,$lo); | |
89 | for (@_) { | |
90 | if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io) | |
91 | { $hi=$1?"0x$1":"0"; $lo="0x$2"; } | |
92 | elsif (/^([0-9]+)$/o) | |
93 | { $hi=$1>>32; $lo=$1&0xffffffff; } # error-prone with 32-bit perl | |
94 | else | |
95 | { $hi=undef; $lo=$_; } | |
96 | ||
97 | if (defined($hi)) | |
0e0a1053 | 98 | { push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo"); } |
8ff8a829 AP |
99 | else |
100 | { push(@ret,".quad $lo"); } | |
101 | } | |
102 | join("\n",@ret); | |
103 | }; | |
2c5d4daa AP |
104 | |
105 | ################################################################ | |
106 | # simplified mnemonics not handled by at least one assembler | |
107 | ################################################################ | |
108 | my $cmplw = sub { | |
109 | my $f = shift; | |
110 | my $cr = 0; $cr = shift if ($#_>1); | |
67d99090 AP |
111 | # Some out-of-date 32-bit GNU assembler just can't handle cmplw... |
112 | ($flavour =~ /linux.*32/) ? | |
113 | " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : | |
114 | " cmplw ".join(',',$cr,@_); | |
2c5d4daa AP |
115 | }; |
116 | my $bdnz = sub { | |
117 | my $f = shift; | |
0fcb905b | 118 | my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint |
2c5d4daa | 119 | " bc $bo,0,".shift; |
0fcb905b AP |
120 | } if ($flavour!~/linux/); |
121 | my $bltlr = sub { | |
122 | my $f = shift; | |
123 | my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint | |
124 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
125 | " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 : | |
126 | " bclr $bo,0"; | |
127 | }; | |
128 | my $bnelr = sub { | |
129 | my $f = shift; | |
130 | my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint | |
131 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
132 | " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 : | |
133 | " bclr $bo,2"; | |
134 | }; | |
7676eebf AP |
135 | my $beqlr = sub { |
136 | my $f = shift; | |
137 | my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint | |
138 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
139 | " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : | |
140 | " bclr $bo,2"; | |
141 | }; | |
0fcb905b AP |
142 | # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two |
143 | # arguments is 64, with "operand out of range" error. | |
144 | my $extrdi = sub { | |
145 | my ($f,$ra,$rs,$n,$b) = @_; | |
146 | $b = ($b+$n)&63; $n = 64-$n; | |
147 | " rldicl $ra,$rs,$b,$n"; | |
2c5d4daa | 148 | }; |
26e18383 AP |
149 | my $vmr = sub { |
150 | my ($f,$vx,$vy) = @_; | |
151 | " vor $vx,$vy,$vy"; | |
152 | }; | |
2c5d4daa AP |
153 | |
154 | while($line=<>) { | |
155 | ||
156 | $line =~ s|[#!;].*$||; # get rid of asm-style comments... | |
157 | $line =~ s|/\*.*\*/||; # ... and C-style comments... | |
158 | $line =~ s|^\s+||; # ... and skip white spaces in beginning... | |
159 | $line =~ s|\s+$||; # ... and at the end | |
160 | ||
161 | { | |
162 | $line =~ s|\b\.L(\w+)|L$1|g; # common denominator for Locallabel | |
163 | $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); | |
164 | } | |
165 | ||
166 | { | |
167 | $line =~ s|(^[\.\w]+)\:\s*||; | |
168 | my $label = $1; | |
f586d971 AP |
169 | if ($label) { |
170 | printf "%s:",($GLOBALS{$label} or $label); | |
171 | printf "\n.localentry\t$GLOBALS{$label},0" if ($GLOBALS{$label} && $flavour =~ /linux.*64le/); | |
172 | } | |
2c5d4daa AP |
173 | } |
174 | ||
175 | { | |
176 | $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; | |
177 | my $c = $1; $c = "\t" if ($c eq ""); | |
178 | my $mnemonic = $2; | |
179 | my $f = $3; | |
180 | my $opcode = eval("\$$mnemonic"); | |
26e18383 | 181 | $line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/); |
2c5d4daa AP |
182 | if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); } |
183 | elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } | |
184 | } | |
185 | ||
186 | print $line if ($line); | |
187 | print "\n"; | |
188 | } | |
189 | ||
190 | close STDOUT; |