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