Home | History | Annotate | Download | only in perlasm
      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;
    160