1#!/usr/bin/env perl
2
3# PowerPC assembler distiller by <appro>.
4
5my $flavour = shift;
6my $output = shift;
7open STDOUT,">$output" || die "can't open $output: $!";
8
9my %GLOBALS;
10my $dotinlocallabels=($flavour=~/linux/)?1:0;
11
12################################################################
13# directives which need special treatment on different platforms
14################################################################
15my $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};
52my $text = sub {
53    ($flavour =~ /aix/) ? ".csect" : ".text";
54};
55my $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};
64my $size = sub {
65    if ($flavour =~ /linux.*32/)
66    {	shift;
67	".size	" . join(",",@_);
68    }
69    else
70    {	"";	}
71};
72my $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################################################################
84my $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};
92my $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/);
97my $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};
104my $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};
111my $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.
120my $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
126while($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
159close STDOUT;
160