| OLD | NEW |
| (Empty) |
| 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 .= ".align 3\n"; | |
| 38 $ret .= "$name:\n"; | |
| 39 $ret .= ".quad .$name,.TOC.\@tocbase,0\n"; | |
| 40 $ret .= ".size $name,24\n"; | |
| 41 $ret .= ".previous\n"; | |
| 42 | |
| 43 $name = ".$name"; | |
| 44 last; | |
| 45 }; | |
| 46 } | |
| 47 | |
| 48 $ret = ".globl $name" if (!$ret); | |
| 49 $$global = $name; | |
| 50 $ret; | |
| 51 }; | |
| 52 my $text = sub { | |
| 53 ($flavour =~ /aix/) ? ".csect" : ".text"; | |
| 54 }; | |
| 55 my $machine = sub { | |
| 56 my $junk = shift; | |
| 57 my $arch = shift; | |
| 58 if ($flavour =~ /osx/) | |
| 59 { $arch =~ s/\"//g; | |
| 60 $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); | |
| 61 } | |
| 62 ".machine $arch"; | |
| 63 }; | |
| 64 my $size = sub { | |
| 65 if ($flavour =~ /linux.*32/) | |
| 66 { shift; | |
| 67 ".size " . join(",",@_); | |
| 68 } | |
| 69 else | |
| 70 { ""; } | |
| 71 }; | |
| 72 my $asciz = sub { | |
| 73 shift; | |
| 74 my $line = join(",",@_); | |
| 75 if ($line =~ /^"(.*)"$/) | |
| 76 { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } | |
| 77 else | |
| 78 { ""; } | |
| 79 }; | |
| 80 | |
| 81 ################################################################ | |
| 82 # simplified mnemonics not handled by at least one assembler | |
| 83 ################################################################ | |
| 84 my $cmplw = sub { | |
| 85 my $f = shift; | |
| 86 my $cr = 0; $cr = shift if ($#_>1); | |
| 87 # Some out-of-date 32-bit GNU assembler just can't handle cmplw... | |
| 88 ($flavour =~ /linux.*32/) ? | |
| 89 " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : | |
| 90 " cmplw ".join(',',$cr,@_); | |
| 91 }; | |
| 92 my $bdnz = sub { | |
| 93 my $f = shift; | |
| 94 my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint | |
| 95 " bc $bo,0,".shift; | |
| 96 } if ($flavour!~/linux/); | |
| 97 my $bltlr = sub { | |
| 98 my $f = shift; | |
| 99 my $bo = $f=~/\-/ ? 12+2 : 12; # 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|16<<1 : | |
| 102 " bclr $bo,0"; | |
| 103 }; | |
| 104 my $bnelr = sub { | |
| 105 my $f = shift; | |
| 106 my $bo = $f=~/\-/ ? 4+2 : 4; # 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 my $beqlr = sub { | |
| 112 my $f = shift; | |
| 113 my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint | |
| 114 ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | |
| 115 " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : | |
| 116 " bclr $bo,2"; | |
| 117 }; | |
| 118 # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two | |
| 119 # arguments is 64, with "operand out of range" error. | |
| 120 my $extrdi = sub { | |
| 121 my ($f,$ra,$rs,$n,$b) = @_; | |
| 122 $b = ($b+$n)&63; $n = 64-$n; | |
| 123 " rldicl $ra,$rs,$b,$n"; | |
| 124 }; | |
| 125 | |
| 126 while($line=<>) { | |
| 127 | |
| 128 $line =~ s|[#!;].*$||; # get rid of asm-style comments... | |
| 129 $line =~ s|/\*.*\*/||; # ... and C-style comments... | |
| 130 $line =~ s|^\s+||; # ... and skip white spaces in beginning... | |
| 131 $line =~ s|\s+$||; # ... and at the end | |
| 132 | |
| 133 { | |
| 134 $line =~ s|\b\.L(\w+)|L$1|g; # common denominator for Locallabel | |
| 135 $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); | |
| 136 } | |
| 137 | |
| 138 { | |
| 139 $line =~ s|(^[\.\w]+)\:\s*||; | |
| 140 my $label = $1; | |
| 141 printf "%s:",($GLOBALS{$label} or $label) if ($label); | |
| 142 } | |
| 143 | |
| 144 { | |
| 145 $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; | |
| 146 my $c = $1; $c = "\t" if ($c eq ""); | |
| 147 my $mnemonic = $2; | |
| 148 my $f = $3; | |
| 149 my $opcode = eval("\$$mnemonic"); | |
| 150 $line =~ s|\bc?[rf]([0-9]+)\b|$1|g if ($c ne "." and $flavour !~ /osx/); | |
| 151 if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); } | |
| 152 elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } | |
| 153 } | |
| 154 | |
| 155 print $line if ($line); | |
| 156 print "\n"; | |
| 157 } | |
| 158 | |
| 159 close STDOUT; | |
| OLD | NEW |