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