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 |