ppc-xlate.pl (10337B)
1 #!/usr/bin/env perl 2 3 # PowerPC assembler distiller by \@dot-asm. 4 5 ################################################################ 6 # Recognized "flavour"-s are: 7 # 8 # linux{32|64}[le] GNU assembler and ELF symbol decorations, 9 # with little-endian option 10 # linux64v2 GNU asssembler and big-endian instantiation 11 # of latest ELF specification 12 # aix{32|64} AIX assembler and symbol decorations 13 # osx{32|64} Mac OS X assembler and symbol decoratons 14 15 my $flavour = shift; 16 my $output = shift; 17 open STDOUT,">$output" || die "can't open $output: $!"; 18 19 my %GLOBALS; 20 my %TYPES; 21 my $dotinlocallabels=($flavour=~/linux/)?1:0; 22 23 ################################################################ 24 # directives which need special treatment on different platforms 25 ################################################################ 26 my $type = sub { 27 my ($dir,$name,$type) = @_; 28 29 $TYPES{$name} = $type; 30 if ($flavour =~ /linux/) { 31 $name =~ s|^\.||; 32 ".type $name,$type"; 33 } else { 34 ""; 35 } 36 }; 37 my $globl = sub { 38 my $junk = shift; 39 my $name = shift; 40 my $global = \$GLOBALS{$name}; 41 my $type = \$TYPES{$name}; 42 my $ret; 43 44 $name =~ s|^\.||; 45 46 SWITCH: for ($flavour) { 47 /aix/ && do { if (!$$type) { 48 $$type = "\@function"; 49 } 50 if ($$type =~ /function/) { 51 $name = ".$name"; 52 } 53 last; 54 }; 55 /osx/ && do { $name = "_$name"; 56 last; 57 }; 58 /linux.*(32|64(le|v2))/ 59 && do { $ret .= ".globl $name"; 60 if (!$$type) { 61 $ret .= "\n.type $name,\@function"; 62 $$type = "\@function"; 63 } 64 last; 65 }; 66 /linux.*64/ && do { $ret .= ".globl $name"; 67 if (!$$type) { 68 $ret .= "\n.type $name,\@function"; 69 $$type = "\@function"; 70 } 71 if ($$type =~ /function/) { 72 $ret .= "\n.section \".opd\",\"aw\""; 73 $ret .= "\n.align 3"; 74 $ret .= "\n$name:"; 75 $ret .= "\n.quad .$name,.TOC.\@tocbase,0"; 76 $ret .= "\n.previous"; 77 $name = ".$name"; 78 } 79 last; 80 }; 81 } 82 83 $ret = ".globl $name" if (!$ret); 84 $$global = $name; 85 $ret; 86 }; 87 my $text = sub { 88 my $ret = ($flavour =~ /aix/) ? ".csect\t.text[PR],7" : ".text"; 89 $ret = ".abiversion 2\n".$ret if ($flavour =~ /linux.*64(le|v2)/); 90 $ret; 91 }; 92 my $machine = sub { 93 my $junk = shift; 94 my $arch = shift; 95 if ($flavour =~ /osx/) 96 { $arch =~ s/\"//g; 97 $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); 98 } 99 ".machine $arch"; 100 }; 101 my $size = sub { 102 if ($flavour =~ /linux/) 103 { shift; 104 my $name = shift; 105 my $real = $GLOBALS{$name} ? \$GLOBALS{$name} : \$name; 106 my $ret = ".size $$real,.-$$real"; 107 $name =~ s|^\.||; 108 if ($$real ne $name) { 109 $ret .= "\n.size $name,.-$$real"; 110 } 111 $ret; 112 } 113 else 114 { ""; } 115 }; 116 my $asciz = sub { 117 shift; 118 my $line = join(",",@_); 119 if ($line =~ /^"(.*)"$/) 120 { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } 121 else 122 { ""; } 123 }; 124 my $quad = sub { 125 shift; 126 my @ret; 127 my ($hi,$lo); 128 for (@_) { 129 if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io) 130 { $hi=$1?"0x$1":"0"; $lo="0x$2"; } 131 elsif (/^([0-9]+)$/o) 132 { $hi=$1>>32; $lo=$1&0xffffffff; } # error-prone with 32-bit perl 133 else 134 { $hi=undef; $lo=$_; } 135 136 if (defined($hi)) 137 { push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo"); } 138 else 139 { push(@ret,".quad $lo"); } 140 } 141 join("\n",@ret); 142 }; 143 144 ################################################################ 145 # simplified mnemonics not handled by at least one assembler 146 ################################################################ 147 my $cmplw = sub { 148 my $f = shift; 149 my $cr = 0; $cr = shift if ($#_>1); 150 # Some out-of-date 32-bit GNU assembler just can't handle cmplw... 151 ($flavour =~ /linux.*32/) ? 152 " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : 153 " cmplw ".join(',',$cr,@_); 154 }; 155 my $bdnz = sub { 156 my $f = shift; 157 my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint 158 " bc $bo,0,".shift; 159 } if ($flavour!~/linux/); 160 my $bltlr = sub { 161 my $f = shift; 162 my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint 163 ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints 164 " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 : 165 " bclr $bo,0"; 166 }; 167 my $bnelr = sub { 168 my $f = shift; 169 my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint 170 ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints 171 " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 : 172 " bclr $bo,2"; 173 }; 174 my $beqlr = sub { 175 my $f = shift; 176 my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint 177 ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints 178 " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : 179 " bclr $bo,2"; 180 }; 181 # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two 182 # arguments is 64, with "operand out of range" error. 183 my $extrdi = sub { 184 my ($f,$ra,$rs,$n,$b) = @_; 185 $b = ($b+$n)&63; $n = 64-$n; 186 " rldicl $ra,$rs,$b,$n"; 187 }; 188 my $vmr = sub { 189 my ($f,$vx,$vy) = @_; 190 " vor $vx,$vy,$vy"; 191 }; 192 193 # Some ABIs specify vrsave, special-purpose register #256, as reserved 194 # for system use. 195 my $no_vrsave = ($flavour =~ /aix|linux64(le|v2)/); 196 my $mtspr = sub { 197 my ($f,$idx,$ra) = @_; 198 if ($idx == 256 && $no_vrsave) { 199 " or $ra,$ra,$ra"; 200 } else { 201 " mtspr $idx,$ra"; 202 } 203 }; 204 my $mfspr = sub { 205 my ($f,$rd,$idx) = @_; 206 if ($idx == 256 && $no_vrsave) { 207 " li $rd,-1"; 208 } else { 209 " mfspr $rd,$idx"; 210 } 211 }; 212 213 # PowerISA 2.06 stuff 214 sub vsxmem_op { 215 my ($f, $vrt, $ra, $rb, $op) = @_; 216 " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|($rb<<11)|($op*2+1); 217 } 218 # made-up unaligned memory reference AltiVec/VMX instructions 219 my $lvx_u = sub { vsxmem_op(@_, 844); }; # lxvd2x 220 my $stvx_u = sub { vsxmem_op(@_, 972); }; # stxvd2x 221 my $lvdx_u = sub { vsxmem_op(@_, 588); }; # lxsdx 222 my $stvdx_u = sub { vsxmem_op(@_, 716); }; # stxsdx 223 my $lvx_4w = sub { vsxmem_op(@_, 780); }; # lxvw4x 224 my $stvx_4w = sub { vsxmem_op(@_, 908); }; # stxvw4x 225 my $lvx_splt = sub { vsxmem_op(@_, 332); }; # lxvdsx 226 # VSX instruction[s] masqueraded as made-up AltiVec/VMX 227 my $vpermdi = sub { # xxpermdi 228 my ($f, $vrt, $vra, $vrb, $dm) = @_; 229 $dm = oct($dm) if ($dm =~ /^0/); 230 " .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($dm<<8)|(10<<3)|7; 231 }; 232 233 # PowerISA 2.07 stuff 234 sub vcrypto_op { 235 my ($f, $vrt, $vra, $vrb, $op) = @_; 236 " .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op; 237 } 238 sub vfour { 239 my ($f, $vrt, $vra, $vrb, $vrc, $op) = @_; 240 " .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|($vrc<<6)|$op; 241 }; 242 my $vcipher = sub { vcrypto_op(@_, 1288); }; 243 my $vcipherlast = sub { vcrypto_op(@_, 1289); }; 244 my $vncipher = sub { vcrypto_op(@_, 1352); }; 245 my $vncipherlast= sub { vcrypto_op(@_, 1353); }; 246 my $vsbox = sub { vcrypto_op(@_, 0, 1480); }; 247 my $vshasigmad = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); }; 248 my $vshasigmaw = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); }; 249 my $vpmsumb = sub { vcrypto_op(@_, 1032); }; 250 my $vpmsumd = sub { vcrypto_op(@_, 1224); }; 251 my $vpmsubh = sub { vcrypto_op(@_, 1096); }; 252 my $vpmsumw = sub { vcrypto_op(@_, 1160); }; 253 # These are not really crypto, but vcrypto_op template works 254 my $vaddudm = sub { vcrypto_op(@_, 192); }; 255 my $vadduqm = sub { vcrypto_op(@_, 256); }; 256 my $vmuleuw = sub { vcrypto_op(@_, 648); }; 257 my $vmulouw = sub { vcrypto_op(@_, 136); }; 258 my $vrld = sub { vcrypto_op(@_, 196); }; 259 my $vsld = sub { vcrypto_op(@_, 1476); }; 260 my $vsrd = sub { vcrypto_op(@_, 1732); }; 261 my $vsubudm = sub { vcrypto_op(@_, 1216); }; 262 my $vaddcuq = sub { vcrypto_op(@_, 320); }; 263 my $vaddeuqm = sub { vfour(@_,60); }; 264 my $vaddecuq = sub { vfour(@_,61); }; 265 my $vmrgew = sub { vfour(@_,0,1932); }; 266 my $vmrgow = sub { vfour(@_,0,1676); }; 267 268 my $mtsle = sub { 269 my ($f, $arg) = @_; 270 " .long ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2); 271 }; 272 273 # VSX instructions masqueraded as AltiVec/VMX 274 my $mtvrd = sub { 275 my ($f, $vrt, $ra) = @_; 276 " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(179<<1)|1; 277 }; 278 my $mtvrwz = sub { 279 my ($f, $vrt, $ra) = @_; 280 " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|(243<<1)|1; 281 }; 282 my $lvwzx_u = sub { vsxmem_op(@_, 12); }; # lxsiwzx 283 my $stvwx_u = sub { vsxmem_op(@_, 140); }; # stxsiwx 284 285 # PowerISA 3.0 stuff 286 my $maddhdu = sub { vfour(@_,49); }; 287 my $maddld = sub { vfour(@_,51); }; 288 my $darn = sub { 289 my ($f, $rt, $l) = @_; 290 " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($l<<16)|(755<<1); 291 }; 292 my $iseleq = sub { 293 my ($f, $rt, $ra, $rb) = @_; 294 " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|(2<<6)|30; 295 }; 296 # VSX instruction[s] masqueraded as made-up AltiVec/VMX 297 my $vspltib = sub { # xxspltib 298 my ($f, $vrt, $imm8) = @_; 299 $imm8 = oct($imm8) if ($imm8 =~ /^0/); 300 $imm8 &= 0xff; 301 " .long ".sprintf "0x%X",(60<<26)|($vrt<<21)|($imm8<<11)|(360<<1)|1; 302 }; 303 304 # PowerISA 3.0B stuff 305 my $addex = sub { 306 my ($f, $rt, $ra, $rb, $cy) = @_; # only cy==0 is specified in 3.0B 307 " .long ".sprintf "0x%X",(31<<26)|($rt<<21)|($ra<<16)|($rb<<11)|($cy<<9)|(170<<1); 308 }; 309 my $vmsumudm = sub { vfour(@_,35); }; 310 311 while($line=<>) { 312 313 $line =~ s|[#!;].*$||; # get rid of asm-style comments... 314 $line =~ s|/\*.*\*/||; # ... and C-style comments... 315 $line =~ s|^\s+||; # ... and skip white spaces in beginning... 316 $line =~ s|\s+$||; # ... and at the end 317 318 { 319 $line =~ s|\.L(\w+)|L$1|g; # common denominator for Locallabel 320 $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); 321 } 322 323 { 324 $line =~ s|(^[\.\w]+)\:\s*||; 325 my $label = $1; 326 if ($label) { 327 my $xlated = ($GLOBALS{$label} or $label); 328 print "$xlated:"; 329 if ($flavour =~ /linux.*64(le|v2)/) { 330 if ($TYPES{$label} =~ /function/) { 331 printf "\n.localentry %s,0\n",$xlated; 332 } 333 } 334 } 335 } 336 337 { 338 $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; 339 my $c = $1; $c = "\t" if ($c eq ""); 340 my $mnemonic = $2; 341 my $f = $3; 342 my $opcode = eval("\$$mnemonic"); 343 $line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/); 344 if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(/,\s*/,$line)); } 345 elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } 346 } 347 348 print $line if ($line); 349 print "\n"; 350 } 351 352 close STDOUT;