# Copyright (c) 2002-2009 Nokia Corporation and/or its subsidiary(-ies).

# All rights reserved.

# This component and the accompanying materials are made available

# under the terms of "Eclipse Public License v1.0"

# which accompanies this distribution, and is available

# at the URL "http://www.eclipse.org/legal/epl-v10.html".

#

# Initial Contributors:

# Nokia Corporation - initial contribution.

#

# Contributors:

# Mike Kinghan, mikek@symbian.org, for Symbian Foundation

#

# Description:

# e32toolp\e32util\armasm2as.pl

# Convert an ARMASM assembler source or include file to AS format

# Syntax:

# perl armasm2as.pl <input> <output>

# 

#

if (scalar(@ARGV)!=2) {

	die "perl armasm2as.pl <input> <output>\n";

}

my ($infile, $outfile) = @ARGV;

open IN, $infile or die "Can't open $infile for input\n";

my $gccfile;

my @input;

while (<IN>) {

	push @input, $_;

	next if defined($gccfile);

	next if (/^\s*$/);

	if (/^\s*\@/) {

		$gccfile = 1;	# If first non-blank line starts with @, assume already in GCC format

	} else {

		$gccfile = 0;

	}

}

close IN;

my @output;

my $outref = \@output;

if ($gccfile) {

	$outref = \@input;

} else {

	process(\@input, \@output);

}

open OUT, ">$outfile" or die "Can't open $outfile for write\n";

print OUT @$outref;

close OUT;

sub process($$) {

	my $level=0;

	my @block;

	my ($inref, $outref) = @_;

	foreach $line (@$inref) {

		$line=~s/\s*$//;

		my $comment;

		if ($line =~ /\;(.*)$/o) {

			$comment = $1;

			$line =~ s/\;(.*)$//o;

			if ($line =~ /^\s*$/o and $level==0) {

				push @$outref, "$line\@$comment\n";

				next;

			}

			$comment = "\t\@$comment";

		}

		if ($line =~ /^\s+PRESERVE8/) {

			next;

		}

		if ($level == 1) {

			if ($line =~ /^\s+MEND/i) {

				process_macro(\@block, $outref);

				$level = 0;

			} else {

				push @block, $line;

			}

			next;

		} elsif ($level == 0) {

			if ($line =~ /^\s+MACRO\s*$/i) {

				@block = ();

				$level = 1;

				next;

			}

		}

		if ($line =~ /^\s+GBLL\s+(\S+)/i) {

			push @$outref, "\t.set\t$1, 0$comment\n";

			next;

		}

		if ($line =~ /^\s+GBLA\s+(\S+)/i) {

			push @$outref, "\t.set\t$1, 0$comment\n";

			next;

		}

		if ($line =~ /^\s+INCLUDE\s+(\S+)/i) {

			my $arg = $1;

			if ($arg =~ /(\w+)\.inc/io) {

				$arg = $1.'.ginc';

			}

			push @$outref, "\t.include\t\"$arg\"$comment\n";

			next;

		}

		if ($line =~ /^\s+IMPORT\s+(\S+)/i) {

			push @$outref, "\t.extern\t$1$comment\n";

			next;

		}

		if ($line =~ /^\s+EXPORT\s+(\S+)/i) {

			push @$outref, "\t.global\t$1$comment\n";

			next;

		}

		if ($line =~ /^\s+ELSE/i or $line =~ /^\s+\|/i ) {

			push @$outref, "\t.else$comment\n";

			next;

		}

		if ($line =~ /^\s+ENDIF/i or $line =~ /^\s+\]/i) {

			push @$outref, "\t.endif$comment\n";

			next;

		}

		if ($line =~ /^\s+LTORG/i) {

			push @$outref, "\t.ltorg$comment\n";

			next;

		}

		if ($line =~ /^\s+END$/i) {

			next;

		}

		if ($line =~ /^\s+\!\s*(\d+)\,\s*(.*?)$/) {

			my $msg = $2;

			push @$outref, "\t.print $msg\n\t.err$comment\n";

			next;

		}

		if ($line =~ /^\s+INIT_LOGICAL_SYMBOL\s+(\w+)(.*?)$/) {

			process_init_logical_symbol($1, $2, $outref, $comment);

			next;

		}

		if ($line =~ /^\s+INIT_NUMERIC_SYMBOL\s+(\w+)\s*\,\s*(.*?)$/) {

			process_init_numeric_symbol($1, $2, $outref, $comment);

			next;

		}

		if ($line =~ /^\s+AREA\s+(.*?)$/) {

			process_area($1, $outref, $comment);

			next;

		}

		if ($line =~ /^\s+\%\s+(.*?)$/) {

			my $expr = process_numeric_expr($1, $outref);

			push @$outref, "\t.space $expr$comment\n";

			next;

		}

		if ($line =~ /^\s+ALIGN\s*(.*?)$/) {

			process_align($1, $outref, $comment);

			next;

		}

		# Strip label if there is one

		my $label;

		if ($line =~ /^(\S+)\s*(.*?)$/) {

			$label = $1;

			$line = $2;

		} else {

			$line =~ s/^\s*//;

		}

		if ($line =~ /^SETL\s+(\S+)/i) {

			my $val = $1;

			my $expr = process_logical_expr($val, $outref);

			push @$outref, "\t.set\t$label,$expr$comment\n";

			next;

		}

		if ($line =~ /^SETA\s+(.*?)$/i) {

			my $val = $1;

			my $expr = process_numeric_expr($val, $outref);

			push @$outref, "\t.set\t$label,$expr$comment\n";

			next;

		}

		if ($line =~ /^(EQU|\*)\s+(.*?)$/i) {

			my $val = $2;

			my $expr = process_numeric_expr($val, $outref);

			push @$outref, "\t.equ\t$label,$expr$comment\n";

			next;

		}

		if ($line =~ /^(if|\[)\s+(.*?)$/i) {

			my $cond = $2;

			if ($cond =~ /^\s*(\:LNOT\:)?\s*\:DEF\:\s*(.*?)$/i) {

				my $n = $1;

				my $sym = $2;

				if ($sym =~ /^(\w|\\|\:)+$/) {

					if (uc($n) eq ':LNOT:') {

						push @$outref, "\t.ifndef\t$sym$comment\n";

					} else {

						push @$outref, "\t.ifdef\t$sym$comment\n";

					}

					next;

				}

			}

			my $expr = process_logical_expr($cond, $outref);

			push @$outref, "\t.if $expr$comment\n";

			next;

		}

		if ($line =~ /^(\=|DCB)\s*(.*?)$/) {

			process_dcb($label, $2, $outref, $comment);

			next;

		}

		if ($line =~ /^DCW\s*(.*?)$/) {

			process_dcw($label, $1, $outref, $comment);

			next;

		}

		if ($line =~ /^DCD\s*(.*?)$/) {

			process_dcd($label, $1, $outref, $comment);

			next;

		}

		if ($line =~ /^ROUT\s*$/) {

			$line = '';

		}

		if ($line =~ /^(\w+)\s+\%(\w+)\s*$/o) {

			# ARMASM local label reference

			my $inst = $1;

			my $llab = $2;

			if ($llab =~ /F\w?(\d+)/o) {

				$line = "$inst $1f";

			} elsif ($llab =~ /B\w?(\d+)/o) {

				$line = "$inst $1b";

			} else {

				die "Can't determine local label direction\n";

			}

		}

		if ($line =~ /^(\w+)\s+(\w+)\s*\,\s*\%(\w+)\s*$/o) {

			# ARMASM local label reference

			my $inst = $1;

			my $op1 = $2;

			my $llab = $3;

			if ($llab =~ /F\w?(\d+)/o) {

				$line = "$inst $op1\, $1f";

			} elsif ($llab =~ /B\w?(\d+)/o) {

				$line = "$inst $op1\, $1b";

			} else {

				die "Can't determine local label direction\n";

			}

		}

		$line = process_numeric_expr($line, $outref);

		if (defined($label)) {

			push @$outref, "$label\:\t$line$comment\n";

		} else {

			push @$outref, "\t$line$comment\n";

		}

	}

}

sub process_macro($$) {

	my ($inref, $outref) = @_;

	my $line;

	while(1) {

		$line = shift @$inref;

		last if ($line !~ /^\s*$/);

	}

	unless ($line =~ /^\s+(\w+)\s*(.*?)$/) {

		die "Bad macro - no name\n";

	}

	my $macro_name = $1;

	if ($macro_name eq 'INIT_LOGICAL_SYMBOL' or $macro_name eq 'INIT_NUMERIC_SYMBOL') {

		return;

	}

	$line = $2;

	my @args = split ( '\s*,\s*', $line );

	foreach (@args) {

		die "Bad macro argument name\n" unless (/^\$\w+$/);

		s/^\$//;

	}

	my $ev = '';

	foreach $arg (@args) {

		$ev.="s/\\\$$arg(\\W\|\$)/\\\\$arg\$1/go;";

	}

	foreach (@$inref) {

		eval $ev;

	}

	push @$outref, "\t.macro $macro_name ".join(',',@args)."\n";

	process($inref, $outref);

	push @$outref, "\t.endm\n";

}

sub process_logical_expr($$) {

	my ($val, $outref) = @_;

	$val = process_numeric_expr($val, $outref);

	$val =~ s/\<\=/________LE________/g;	# protect <= and >= during expansion of =

	$val =~ s/\>\=/________GE________/g;

	$val =~ s/\=/\=\=/g;					# equality operator is = on ARMASM, == on AS

	$val =~ s/________LE________/\<\=/g;

	$val =~ s/________GE________/\>\=/g;

	$val =~ s/\{TRUE\}/(1)/g;

	$val =~ s/\{FALSE\}/(0)/g;

	my @lops = split( /(\s*\:LAND\:\s*|\s*\:LOR\:\s*|\s*\:LNOT\:\s*|\s*\:DEF\:\s*|\s*\(\s*|\s*\)\s*)/, $val );

	foreach (@lops) {

		s/\s*\:LAND\:\s*/\:LAND\:/go;

		s/\s*\:LOR\:\s*/\:LOR\:/go;

		s/\s*\:LNOT\:\s*/\:LNOT\:/go;

		s/\s*\:DEF\:\s*/\:DEF\:/go;

		s/\s*\(\s*/\(/go;

		s/\s*\)\s*/\)/go;

	}

	my @lops2;

	while (scalar (@lops)) {

		my $x = shift @lops;

		if ($x eq ':DEF:') {

			my $sym = shift @lops;

			$sym =~ s/^\s*//;

			$sym =~ s/\s*$//;

			if ($sym =~ /^(\w|\$|\\)+$/) {

				push @$outref, "\t.ifdef $sym\n\t.set __defined__$sym, 1\n\t.else\n\t.set __defined__$sym, 0\n\t.endif\n";

				push @lops2, " __defined__$sym ";

			} else {

				die "Bad :DEF: operand $sym\n";

			}

		} elsif ($x eq ':LAND:') {

			push @lops2, ' && ';

		} elsif ($x eq ':LOR:') {

			push @lops2, ' || ';

		} else {

			push @lops2, $x;

		}

	}

	my @lops3;

	while (scalar (@lops2)) {

		my $x = shift @lops2;

		if ($x eq ':LNOT:') {

			my $operand = shift @lops2;

			while (@lops2 && $operand =~ /^\s*$/) {

				$operand = shift @lops2;

			}

			if ($operand eq '(') {

				my $balance = 1;

				my $compound = $operand;

				while($balance > 0 && @lops2) {

					$operand = shift @lops2;

					if ($operand eq '(') {

						++$balance;

					}

					elsif ($operand eq ')') {

						--$balance;

					}

					$compound .= $operand;

				}

				push @lops3, "(0==$compound)";

			} 

			else {

				push @lops3, "(0==($operand))";

			}

		} else {

			push @lops3, $x;

		}

	}

	return join('',@lops3);

}

sub process_numeric_expr($$) {

	my ($val, $outref) = @_;

	$val =~ s/\&/0x/g;			# ARMASM accepts hex numbers starting with & or 0x, AS only accepts 0x

	$val =~ s/(\W|^)2_([0|1]+)(\W|$)/$1 0b$2$3/g;	# Binary numbers start with 2_ on ARMASM, 0b on AS

	$val =~ s/\:AND\:/\&/g;

	$val =~ s/\:OR\:/\|/g;

	$val =~ s/\:SHL\:/\<\</g;

	$val =~ s/\:SHR\:/\>\>/g;

	return $val;

}

sub process_init_logical_symbol($$$$) {

	my ($name, $rest, $outref, $comment) = @_;

	my $counter;

	if ($rest =~ /^\s*\,\s*(\w+)\s*$/) {

		$counter = $1;

	} elsif ($rest !~ /^\s*$/) {

		die "Bad INIT_LOGICAL_SYMBOL\n";

	}

	push @$outref, "\t.ifndef $name$comment\n\t.set $name, 0\n\t.else\n\t.set $name, 1\n";

	if ($counter) {

		push @$outref, "\t.set $counter, $counter \+ 1\n";

	}

	push @$outref, "\t.endif\n";

}

sub process_init_numeric_symbol($$$$) {

	my ($name, $value, $outref, $comment) = @_;

	my $expr = process_numeric_expr($value, $outref);

	push @$outref, "\t.ifndef $name$comment\n\t.set $name, $expr\n\t.endif\n";

}

sub process_area($$$) {

	my ($line, $outref, $comment) = @_;

	my @args = split(',',$line);

	my $align = 0;

	foreach (@args) {

		if (/^\s*ALIGN\s*\=\s*(\d+)\s*$/) {

			$align = $1;

		}

	}

	push @$outref, "\t.text$comment\n\t.p2align $align\n";

}

sub process_align($$$) {

	my ($line, $outref, $comment) = @_;

	if ($line =~ /^\s*$/o) {

		push @$outref, "\t.align$comment\n";

	} else {

		push @$outref, "\t.balign $line$comment\n";

	}

}

sub process_dcb($$$$) {

	my ($label, $args, $outref, $comment) = @_;

	if (defined($label)) {

		push @$outref, "$label\:";

	}

	while ($args !~ /^\s*$/) {

		my $arg;

		$args =~ s/^\s*//;

		if ($args =~ /^\"/) {

			$args =~ s/\\\"/________ESCAPED_QUOTE________/go;

			$args =~ /\"(.*?)\"\s*(.*?)$/o or die "Unterminated string literal\n";

			$arg = $1;

			$args = $2;

			$arg =~ s/________ESCAPED_QUOTE________/\\\"/go;

			push @$outref, "\t.ascii \"$arg\"$comment\n";

			undef $comment;

			last if ($args !~ /\s*\,(.*?)$/o);

			$args = $1;

		} else {

			$args =~ /(.*?)\s*(\,|$)(.*?)$/o;

			$arg = $1;

			$args = $3;

			my $expr = process_numeric_expr($arg, $outref);

			push @$outref, "\t.byte $expr$comment\n";

			undef $comment;

		}

	}

}

sub process_dcw($$$$) {

	my ($label, $args, $outref, $comment) = @_;

	if (defined($label)) {

		push @$outref, "$label\:";

	}

	while ($args !~ /^\s*$/) {

		my $arg;

		$args =~ s/^\s*//;

		$args =~ /(.*?)\s*(\,|$)(.*?)$/o;

		$arg = $1;

		$args = $3;

		my $expr = process_numeric_expr($arg, $outref);

		push @$outref, "\t.hword $expr$comment\n";

		undef $comment;

	}

}

sub process_dcd($$$$) {

	my ($label, $args, $outref, $comment) = @_;

	if (defined($label)) {

		push @$outref, "$label\:";

	}

	while ($args !~ /^\s*$/) {

		my $arg;

		$args =~ s/^\s*//;

		$args =~ /(.*?)\s*(\,|$)(.*?)$/o;

		$arg = $1;

		$args = $3;

		my $expr = process_numeric_expr($arg, $outref);

		push @$outref, "\t.word $expr$comment\n";

		undef $comment;

	}

}