ppc-xlate.pl 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230
  1. #!/usr/bin/env perl
  2. # SPDX-License-Identifier: GPL-2.0
  3. # PowerPC assembler distiller by <appro>.
  4. my $flavour = shift;
  5. my $output = shift;
  6. open STDOUT,">$output" || die "can't open $output: $!";
  7. my %GLOBALS;
  8. my $dotinlocallabels=($flavour=~/linux/)?1:0;
  9. ################################################################
  10. # directives which need special treatment on different platforms
  11. ################################################################
  12. my $globl = sub {
  13. my $junk = shift;
  14. my $name = shift;
  15. my $global = \$GLOBALS{$name};
  16. my $ret;
  17. $name =~ s|^[\.\_]||;
  18. SWITCH: for ($flavour) {
  19. /aix/ && do { $name = ".$name";
  20. last;
  21. };
  22. /osx/ && do { $name = "_$name";
  23. last;
  24. };
  25. /linux/
  26. && do { $ret = "_GLOBAL($name)";
  27. last;
  28. };
  29. }
  30. $ret = ".globl $name\nalign 5\n$name:" if (!$ret);
  31. $$global = $name;
  32. $ret;
  33. };
  34. my $text = sub {
  35. my $ret = ($flavour =~ /aix/) ? ".csect\t.text[PR],7" : ".text";
  36. $ret = ".abiversion 2\n".$ret if ($flavour =~ /linux.*64le/);
  37. $ret;
  38. };
  39. my $machine = sub {
  40. my $junk = shift;
  41. my $arch = shift;
  42. if ($flavour =~ /osx/)
  43. { $arch =~ s/\"//g;
  44. $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any");
  45. }
  46. ".machine $arch";
  47. };
  48. my $size = sub {
  49. if ($flavour =~ /linux/)
  50. { shift;
  51. my $name = shift; $name =~ s|^[\.\_]||;
  52. my $ret = ".size $name,.-".($flavour=~/64$/?".":"").$name;
  53. $ret .= "\n.size .$name,.-.$name" if ($flavour=~/64$/);
  54. $ret;
  55. }
  56. else
  57. { ""; }
  58. };
  59. my $asciz = sub {
  60. shift;
  61. my $line = join(",",@_);
  62. if ($line =~ /^"(.*)"$/)
  63. { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; }
  64. else
  65. { ""; }
  66. };
  67. my $quad = sub {
  68. shift;
  69. my @ret;
  70. my ($hi,$lo);
  71. for (@_) {
  72. if (/^0x([0-9a-f]*?)([0-9a-f]{1,8})$/io)
  73. { $hi=$1?"0x$1":"0"; $lo="0x$2"; }
  74. elsif (/^([0-9]+)$/o)
  75. { $hi=$1>>32; $lo=$1&0xffffffff; } # error-prone with 32-bit perl
  76. else
  77. { $hi=undef; $lo=$_; }
  78. if (defined($hi))
  79. { push(@ret,$flavour=~/le$/o?".long\t$lo,$hi":".long\t$hi,$lo"); }
  80. else
  81. { push(@ret,".quad $lo"); }
  82. }
  83. join("\n",@ret);
  84. };
  85. ################################################################
  86. # simplified mnemonics not handled by at least one assembler
  87. ################################################################
  88. my $cmplw = sub {
  89. my $f = shift;
  90. my $cr = 0; $cr = shift if ($#_>1);
  91. # Some out-of-date 32-bit GNU assembler just can't handle cmplw...
  92. ($flavour =~ /linux.*32/) ?
  93. " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 :
  94. " cmplw ".join(',',$cr,@_);
  95. };
  96. my $bdnz = sub {
  97. my $f = shift;
  98. my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint
  99. " bc $bo,0,".shift;
  100. } if ($flavour!~/linux/);
  101. my $bltlr = sub {
  102. my $f = shift;
  103. my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint
  104. ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
  105. " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 :
  106. " bclr $bo,0";
  107. };
  108. my $bnelr = sub {
  109. my $f = shift;
  110. my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint
  111. ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
  112. " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 :
  113. " bclr $bo,2";
  114. };
  115. my $beqlr = sub {
  116. my $f = shift;
  117. my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint
  118. ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints
  119. " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 :
  120. " bclr $bo,2";
  121. };
  122. # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two
  123. # arguments is 64, with "operand out of range" error.
  124. my $extrdi = sub {
  125. my ($f,$ra,$rs,$n,$b) = @_;
  126. $b = ($b+$n)&63; $n = 64-$n;
  127. " rldicl $ra,$rs,$b,$n";
  128. };
  129. my $vmr = sub {
  130. my ($f,$vx,$vy) = @_;
  131. " vor $vx,$vy,$vy";
  132. };
  133. # Some ABIs specify vrsave, special-purpose register #256, as reserved
  134. # for system use.
  135. my $no_vrsave = ($flavour =~ /linux-ppc64le/);
  136. my $mtspr = sub {
  137. my ($f,$idx,$ra) = @_;
  138. if ($idx == 256 && $no_vrsave) {
  139. " or $ra,$ra,$ra";
  140. } else {
  141. " mtspr $idx,$ra";
  142. }
  143. };
  144. my $mfspr = sub {
  145. my ($f,$rd,$idx) = @_;
  146. if ($idx == 256 && $no_vrsave) {
  147. " li $rd,-1";
  148. } else {
  149. " mfspr $rd,$idx";
  150. }
  151. };
  152. # PowerISA 2.06 stuff
  153. sub vsxmem_op {
  154. my ($f, $vrt, $ra, $rb, $op) = @_;
  155. " .long ".sprintf "0x%X",(31<<26)|($vrt<<21)|($ra<<16)|($rb<<11)|($op*2+1);
  156. }
  157. # made-up unaligned memory reference AltiVec/VMX instructions
  158. my $lvx_u = sub { vsxmem_op(@_, 844); }; # lxvd2x
  159. my $stvx_u = sub { vsxmem_op(@_, 972); }; # stxvd2x
  160. my $lvdx_u = sub { vsxmem_op(@_, 588); }; # lxsdx
  161. my $stvdx_u = sub { vsxmem_op(@_, 716); }; # stxsdx
  162. my $lvx_4w = sub { vsxmem_op(@_, 780); }; # lxvw4x
  163. my $stvx_4w = sub { vsxmem_op(@_, 908); }; # stxvw4x
  164. # PowerISA 2.07 stuff
  165. sub vcrypto_op {
  166. my ($f, $vrt, $vra, $vrb, $op) = @_;
  167. " .long ".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op;
  168. }
  169. my $vcipher = sub { vcrypto_op(@_, 1288); };
  170. my $vcipherlast = sub { vcrypto_op(@_, 1289); };
  171. my $vncipher = sub { vcrypto_op(@_, 1352); };
  172. my $vncipherlast= sub { vcrypto_op(@_, 1353); };
  173. my $vsbox = sub { vcrypto_op(@_, 0, 1480); };
  174. my $vshasigmad = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); };
  175. my $vshasigmaw = sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); };
  176. my $vpmsumb = sub { vcrypto_op(@_, 1032); };
  177. my $vpmsumd = sub { vcrypto_op(@_, 1224); };
  178. my $vpmsubh = sub { vcrypto_op(@_, 1096); };
  179. my $vpmsumw = sub { vcrypto_op(@_, 1160); };
  180. my $vaddudm = sub { vcrypto_op(@_, 192); };
  181. my $vadduqm = sub { vcrypto_op(@_, 256); };
  182. my $mtsle = sub {
  183. my ($f, $arg) = @_;
  184. " .long ".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2);
  185. };
  186. print "#include <asm/ppc_asm.h>\n" if $flavour =~ /linux/;
  187. while($line=<>) {
  188. $line =~ s|[#!;].*$||; # get rid of asm-style comments...
  189. $line =~ s|/\*.*\*/||; # ... and C-style comments...
  190. $line =~ s|^\s+||; # ... and skip white spaces in beginning...
  191. $line =~ s|\s+$||; # ... and at the end
  192. {
  193. $line =~ s|\b\.L(\w+)|L$1|g; # common denominator for Locallabel
  194. $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels);
  195. }
  196. {
  197. $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||;
  198. my $c = $1; $c = "\t" if ($c eq "");
  199. my $mnemonic = $2;
  200. my $f = $3;
  201. my $opcode = eval("\$$mnemonic");
  202. $line =~ s/\b(c?[rf]|v|vs)([0-9]+)\b/$2/g if ($c ne "." and $flavour !~ /osx/);
  203. if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); }
  204. elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; }
  205. }
  206. print $line if ($line);
  207. print "\n";
  208. }
  209. close STDOUT;