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/
31			&& do {	$ret = "_GLOBAL($name)";
32				last;
33			      };
34    }
35
36    $ret = ".globl	$name\nalign 5\n$name:" if (!$ret);
37    $$global = $name;
38    $ret;
39};
40my $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};
45my $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};
54my $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};
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};
73my $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################################################################
96my $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};
104my $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/);
109my $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};
116my $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};
123my $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.
132my $extrdi = sub {
133    my ($f,$ra,$rs,$n,$b) = @_;
134    $b = ($b+$n)&63; $n = 64-$n;
135    "	rldicl	$ra,$rs,$b,$n";
136};
137my $vmr = sub {
138    my ($f,$vx,$vy) = @_;
139    "	vor	$vx,$vy,$vy";
140};
141
142# PowerISA 2.06 stuff
143sub 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
148my $lvx_u	= sub {	vsxmem_op(@_, 844); };	# lxvd2x
149my $stvx_u	= sub {	vsxmem_op(@_, 972); };	# stxvd2x
150my $lvdx_u	= sub {	vsxmem_op(@_, 588); };	# lxsdx
151my $stvdx_u	= sub {	vsxmem_op(@_, 716); };	# stxsdx
152my $lvx_4w	= sub { vsxmem_op(@_, 780); };	# lxvw4x
153my $stvx_4w	= sub { vsxmem_op(@_, 908); };	# stxvw4x
154
155# PowerISA 2.07 stuff
156sub vcrypto_op {
157    my ($f, $vrt, $vra, $vrb, $op) = @_;
158    "	.long	".sprintf "0x%X",(4<<26)|($vrt<<21)|($vra<<16)|($vrb<<11)|$op;
159}
160my $vcipher	= sub { vcrypto_op(@_, 1288); };
161my $vcipherlast	= sub { vcrypto_op(@_, 1289); };
162my $vncipher	= sub { vcrypto_op(@_, 1352); };
163my $vncipherlast= sub { vcrypto_op(@_, 1353); };
164my $vsbox	= sub { vcrypto_op(@_, 0, 1480); };
165my $vshasigmad	= sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1730); };
166my $vshasigmaw	= sub { my ($st,$six)=splice(@_,-2); vcrypto_op(@_, $st<<4|$six, 1666); };
167my $vpmsumb	= sub { vcrypto_op(@_, 1032); };
168my $vpmsumd	= sub { vcrypto_op(@_, 1224); };
169my $vpmsubh	= sub { vcrypto_op(@_, 1096); };
170my $vpmsumw	= sub { vcrypto_op(@_, 1160); };
171my $vaddudm	= sub { vcrypto_op(@_, 192);  };
172my $vadduqm	= sub { vcrypto_op(@_, 256);  };
173
174my $mtsle	= sub {
175    my ($f, $arg) = @_;
176    "	.long	".sprintf "0x%X",(31<<26)|($arg<<21)|(147*2);
177};
178
179print "#include <asm/ppc_asm.h>\n" if $flavour =~ /linux/;
180
181while($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    {
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
208close STDOUT;
209