--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/srctools/tranasm/tranasm.pl Tue Oct 27 16:36:35 2009 +0000
@@ -0,0 +1,1439 @@
+#!/usr/bin/perl
+# 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:
+#
+# Description:
+#
+
+use strict;
+use Getopt::Long;
+use Cwd;
+
+my $Pwd = cwd;
+
+my $incroot = $Pwd;
+if ($Pwd =~ /.\:(.*)$/) {
+ $incroot = $1;
+ $incroot =~ s/\//\\/go;
+ $incroot = "$incroot"."\\";
+}
+
+if ($^O == "MSWin32" ) {
+ my $PATHSEP='\\'
+} else {
+ my $PATHSEP='/'
+}
+
+
+my $commentToken = "//";
+
+my $emitUnimplemented = 1;
+
+my %opts = ();
+
+my $result = GetOptions(\%opts,
+ "record-emitter",
+ "suppress-check",
+ "no-original",
+ "output:s",
+ "error-string:s",
+ "autoflush",
+ "help",
+ "lineno",
+ );
+
+Usage() if(!$result || $opts{'help'} || @ARGV < 1);
+
+my $errorString = "\t>>> CHECK THIS <<<";
+
+my $recordEmitter = $opts{"record-emitter"};
+my $plineno = $opts{"lineno"};
+my $forceCheck = !$opts{"suppress-check"};
+my $printOriginal = !$opts{"no-original"};
+my $outfile = $opts{"output"} if $opts{"output"};
+my $infile = @ARGV[0];
+$errorString = $opts{"error-string"} if $opts{"error-string"};
+
+#my $symbolsfile = "tranasm-symbols.log";
+my $symbolsfile = "";
+my $savedOut;
+# set to false to prevent recording files in \tranlated-files.log
+#my $recordFile = 0;
+
+#system "echo $infile >> \\translated-files.log" if $recordFile;
+my @unmangledSymbols;
+my $recordUnmangledSymbols = $symbolsfile;
+
+if ($outfile) {
+ open OUT, ">$outfile";
+ $savedOut = select OUT;
+}
+
+$| = $opts{"autoflush"};
+
+
+my $labelN = 0;
+my $labelRoot = "Label";
+
+my $lineno = 0;
+my @knownLabels = ();
+
+sub Croak($)
+{
+ my ($msg) = @_;
+ die "\nERROR: line $.: $msg";
+}
+
+sub PrintComment($)
+{
+ my ($comment) = @_;
+ printf "\t$commentToken$comment" if $comment;
+}
+
+sub PrintCheck() { printf "\t$errorString\n" if $forceCheck; }
+
+sub Nl () { printf "\n"; }
+
+# cache for results of unmangling....
+my %unmangledSymbols = ();
+# cache to say whether symbol was mangled
+my %mangledSymbols = ();
+
+my $sourcefile = "\"$infile\"";
+
+my @IncFiles;
+
+
+sub Unmangle ($)
+{
+ my ($str) = @_;
+ return $str if ($str =~ /\s*__cpp\(/); # these don't need unmangling
+ my $res = $unmangledSymbols{$str};
+ if ($res) {
+ my $l = $lineno;
+ if ($mangledSymbols{$str}) {
+ my $sfile = $sourcefile;
+ $sfile =~ s/\"//go;
+ $sfile =~ s/\\\\/${main::PATHSEP}/go;
+ push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = \?\?\? : @IncFiles"
+ }
+ return $res;
+ } else {
+ return $unmangledSymbols{$str} = UnmangleX($str);
+ }
+}
+
+sub UnmangleX ($)
+{
+ my ($str) = @_;
+
+ my $sfile = $sourcefile;
+ $sfile =~ s/\"//go;
+ $sfile =~ s/\\\\/${main::PATHSEP}/go;
+
+ # recognize non-c++ derived symbols/labels
+ if ($str =~ /^\s*(__.*)\s*$/) {
+ $str =~ s/\./_/;
+ return $str;
+ }
+
+ my $cppfilt = $ENV{CPPFILT} ? $ENV{CPPFILT} : "c++filt";
+ open UNM, "$cppfilt -s gnu $str|" or die "Error: Tranasm problem running $cppfilt to unmangle symbols.\n";
+ my $result = <UNM> ;
+ chop $result;
+
+ my $pat = "\^\\s*$result\\s*\$";
+ if ($str =~ $pat) {
+ return $str;
+ }
+
+ close UNM;
+ #strip of any args
+ if ($result =~ /([^\(]*)\s*\(/) {
+ my $res = $1;
+ if ($recordUnmangledSymbols) {
+ my $l = $lineno;
+ $mangledSymbols{$str} = 1;
+ push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = $result : @IncFiles";
+ }
+ $result = $res;
+ } else {
+ # didn't have args so try as a (static) var
+ my $res = "\&$result";
+ if ($recordUnmangledSymbols) {
+ my $l = $lineno;
+ $mangledSymbols{$str} = 1;
+ push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = $result : @IncFiles";
+ }
+ $result = $res;
+ }
+ return $result;
+}
+
+sub EmitOriginal($$)
+{
+ my ($orig , $emitter) = @_;
+ $orig =~ /\s*(.*)/;
+ printf "\t$commentToken Original - $1\n" if ($printOriginal);
+ printf "\t$commentToken emitted by $emitter\n" if ($recordEmitter);
+}
+
+sub EmitUnimplementedOpcode ($$$$)
+{
+ my ($original, $asm) = @_;
+ if ($emitUnimplemented) {
+ EmitOriginal ($original, "EmitUnimplementedOpcode");
+ if ($asm =~ /(\S+)\s+/ or $asm =~ /\.*(\S+)/){
+ my $opcode = uc $1;
+ printf "\t$commentToken Translation of opcode $opcode not implemented\n";
+ printf "\t**** Insert translation here ****\n";
+ }
+ else {
+ UnrecognisedAsmWarning("EmitUnimplementedOpcode", $original);
+ }
+ }
+}
+
+sub SimpleEmit ($$$$)
+{
+ my ($original, $str, $emitter, $comment) = @_;
+ PrintCheck();
+ EmitOriginal ($original, $emitter);
+ printf "$str";
+ PrintComment($comment);
+ Nl();
+}
+
+sub UnrecognisedAsmWarning ($$)
+{
+ my ($where, $what) = @_;
+ printf STDERR "WARNING: line $. unrecognised asm format in $where: $what";
+}
+
+sub Count ($$$$) {
+ my ($str, $c, $start, $end) = @_;
+ my $total = 0;
+ my @a = split //, $str;
+ for (;$start < $end; $start++) {
+ $total++ if ($a[$start] eq $c);
+ }
+ return $total;
+}
+
+sub TranslateConstrainedArgs($$) {
+ my ($args, $constraints) = @_;
+ my $ins = GetInputConstraints($constraints) if ($constraints);
+ my @arglist;
+ my @rl;
+ my $start = 0;
+ my $end = length $args;
+ my $cpos = index $args, ",", $start;
+ if ($cpos > -1) {
+ while ($cpos > -1) {
+ #make sure we got a match number of '('s and ')' $start and $cpos
+ my $nl = Count($args, '(', $start, $cpos);
+ my $nr = Count($args, ')', $start, $cpos);
+ if ($nl == $nr) {
+ my $arg = substr($args, $start, $cpos - $start);
+ push @arglist, $arg;
+ $start = $cpos + 1;
+ $cpos = index $args, ",", $start;
+ } else {
+ $cpos = index $args, ",", $cpos + 1;
+ }
+ }
+ push @arglist, substr($args, $start, $end);
+
+ } else {
+ push @arglist, ChopWhiteSpace($args);
+ }
+ foreach (@arglist) {
+ push @rl, SubstituteConstraint($_, $ins);
+ }
+ return join ", ", @rl;
+}
+
+sub GetInputConstraints($) {
+ my ($cs) = @_;
+ if ($cs =~ /\:\s+\:\s*(.*)/) {
+ return join "", split '\"i\" ', $1;
+ } else {
+ Croak("unrecognized contraints format: $cs\n");
+ }
+}
+
+sub ChopWhiteSpace ($) {
+ my ($str) = @_;
+ my @a = split //, $str;
+ my $n = length($str);
+ return $str if $n == 0;
+ while (--$n) {
+ if ($a[$n] eq ' ') {
+ next;
+ } else {
+ last;
+ }
+ }
+ $n++ unless $a[$n] eq ' ';
+ return substr $str, 0, $n;
+}
+
+sub SubstituteConstraint($$) {
+ my ($arg, $cs) = @_;
+ my $u;
+ $arg = ChopWhiteSpace($arg);
+ unless ($cs) {
+ if ($arg =~ /\s*(.*)\s*$/ ) {
+ $u = $1;
+ } else {
+ Croak("Arg not supplied in SubstituteConstraint\n");
+ }
+ } elsif ($arg =~ /\%\S+(\d+)/ ) {
+ my $i = $1;
+ my @c = split '\,', $cs;
+ $u = $c[$i];
+ } elsif ($arg =~ /\s*(.*)\s*$/ ) {
+ $u = $1;
+ } else {
+ Croak("Arg not supplied in SubstituteConstraint\n");
+ }
+ my $metau = quotemeta "$u";
+ if (NeedsImporting($u)) {
+ print "\timport $u ";
+ PrintComment("Added by Substitute Constraint");
+ Nl();
+ AssertSourceFile();
+ return "$u";
+ } elsif ($u =~ /\s*__cpp/) {
+ return $u;
+ } elsif (grep /^$metau/, @knownLabels) {
+ return $u;
+ } else {
+ return "__cpp($u)";
+ }
+}
+
+sub RegisterSymbol($)
+{
+ my ($sym) = @_;
+ return 1 if ($sym =~ /^r1[0-5]\s*$/i);
+ return 1 if ($sym =~ /^r[0-9]\s*$/i);
+ return 1 if ($sym =~ /^lr\s*$/i);
+ return 1 if ($sym =~ /^pc\s*$/i);
+ return 1 if ($sym =~ /^ip\s*$/i);
+ return 1 if ($sym =~ /^sp\s*$/i);
+ return 0;
+}
+
+
+sub NeedsImporting($)
+{
+ my ($sym) = @_;
+ return 0 if ($sym =~ /\s*0x/i );
+ return 0 if ($sym =~ /^\s*0\s*/ );
+ return 0 if ($sym =~ /^\s*\d+\s*/ );
+ return 0 if ($sym =~ /\s*\(/ );
+ return 0 if ($sym =~ /\s*__cpp\(/ );
+ return 0 if RegisterSymbol($sym);
+
+ my $unms = Unmangle($sym);
+ my $pat = quotemeta($unms);
+ unless ($sym =~ /$pat/) {
+ return 0;
+ }
+ if (($sym =~ /(\w*)/) && (grep /^$1/, @knownLabels) ) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+sub MaybeImportArgs($)
+{
+ my ($args) = @_;
+ my $arg;
+ foreach $arg (split /\,/, $args) {
+ MaybeEmitImport($arg);
+ }
+}
+sub GetInputConstraint($$$)
+{
+ # It would have been nice if we could have used split to get at the constraints
+ # but we can't coz ':' can obviously appear as part of a qualified name. So we have to do it
+ # by hand.
+
+ my ($constraints, $index, $noError) = @_;
+ # assume constraints look like " : output : input [: sideffects"]
+ my $i1 = index($constraints, ":"); # output field after this index
+ Croak("unrecognized contraints format: $constraints\n") if (!$noError and $i1 < 0);
+ my $i2 = index($constraints, ":", $i1 + 1); # input field after this index
+ Croak("unrecognized contraints format: $constraints\n") if !$noError and $i2 < 0;
+
+ Croak("can't deal with output constraints: $constraints\n")
+ if !$noError and (substr($constraints, $i1 + 1, $i2 - $i1 - 1) =~ /\S+/);
+
+ Croak("can't deal with side effect constraints: $constraints\n")
+ if (substr($constraints, $i2 + 1) =~ /(\s*\".+\".*\(.*\))\s*\:+/);
+
+ if ($i2 > 0
+ and (length($constraints) - 1) > $i2
+ and substr($constraints, $i2 + 1) =~ /(\s*\".+\".*\(.*\S+.*\))\s*\:*/) {
+ return $1;
+ } else {
+ return 0;
+ }
+}
+
+sub GetOutputConstraint($$)
+{
+ # It would have been nice if we could have used split to get at the constraints
+ # but we can't coz ':' can obviously appear as part of a qualified name. So we have to do it
+ # by hand.
+ my ($constraints, $index) = @_;
+ # assume constraints look like " : output : input [: sideffects"]
+ my $i1 = index($constraints, ":"); # output field after this index
+ my $i2 = index($constraints, ":", $i1 + 1); # output field after this index
+
+ if ($i2 != -1) {
+ if ( substr($constraints, $i1 + 1, $i2 - $i1 - 1) =~ /\s*(\".*\"\s*\S*.*\))\s*\:*/) {
+ return $1;
+ } else {
+ return 0;
+ }
+ } elsif ( substr($constraints, $i1 + 1) =~ /\s*(\".*\"\s*\S*.*\))\s*\:*/) {
+ return $1;
+ } else {
+ return 0;
+ }
+}
+
+# NB: assumes no mangled symbols in constraint expr.
+sub CppExprFromConstraint ($)
+{
+ my ($constraints) = @_;
+ return $constraints if ($constraints =~ /\s*__cpp/);
+ my $inputExpr;
+ if ($constraints =~ /\s*\".*\"\s+(.*)/) {
+ $inputExpr = $1;
+ } else {
+ Croak( "Unrecognized constraint pattern @ $lineno: $constraints");
+ }
+
+ unless ($inputExpr =~ /^\(/) {
+ $inputExpr = "($inputExpr)";
+ }
+
+ my $result = "__cpp$inputExpr";
+
+ return $result;
+}
+
+sub TranslateConstrainedInputAsmDefault ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ # we make some gross assumptions here which appear to hold for the majority of
+ # our code base namely:
+ # 1. there is normally only one input operand and
+ # 2. it is named 'a0'
+ # This allows us to carry out the simple minded substitution seen below.
+ my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));
+
+ $asm =~ s/\%a0/$cppExpr0/;
+ if ($asm =~ /(\w+)\s+(\S+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ PrintCheck();
+ EmitOriginal($original, "TranslateConstrainedInputAsmDefault");
+ EmitAsm($1, $2, $3, $4, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedInputAsmDefault", $original);
+ }
+}
+
+sub TranslateAsmDefault ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ TranslateConstrainedInputAsmDefault($original, $asm, $constraints, $comment);
+ } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)\s*,?(.+)?/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $op2 = $3;
+ my $op3 = $4;
+ # deal with hand introduced labels that correspond to a mangled C++ name
+ if ($op2 =~ /\s*\[[^\,]+\,\s*\#([^\-]+)/) {
+ my $adr = $1;
+ my $pattern = quotemeta($adr);
+ my $unmangledAdr = Unmangle($adr);
+ $op2 =~ s/$adr/$unmangledAdr/i unless $unmangledAdr =~ /$pattern/;
+ }
+ if ($opcode =~ /ldr/i) {
+ if ($op2 =~ /^(\d+)([fFbB])/) {
+ my $id = $1;
+ my $dir = uc $2;
+ $op2 = "%$dir$id";
+ }
+ }
+ # rename obsolete shift ASL -> LSL
+ if ($op3 =~ /([^\,]*)\,\s*asl (.*)/i) {
+ $op3 = "$1, lsl $2";
+ }
+ # deal with the likes of #___2PP.KernCSLocked-.-8
+ if ($op3 =~ /([^\-\s]\.[^\s\-])/ ) {
+ my $s = "$1";
+ my $p = quotemeta($1);
+ $s =~ s/\./\_/;
+ $op3 =~ s/$p/$s/;
+ }
+ PrintCheck();
+ EmitOriginal ($original, "TranslateAsmDefault");
+ EmitAsm($opcode, $op1, $op2, $op3, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateAsmDefault", $original);
+ }
+}
+
+
+# Work around 'feature' in embedded assembler stemming from the fact that
+# 'and' is both asm and a C++ keyword.
+sub TranslateConstrainedAnd ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ # we make some gross assumptions here which appear to hold for the majority of
+ # our code base namely:
+ # 1. there is normally only one input operand and
+ # 2. it is named 'a0'
+ # This allows us to carry out the simple minded substitution seen below.
+ my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));
+
+ $asm =~ s/\%a0/$cppExpr0/;
+ if ($asm =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $op2 = $3;
+ my $op3 = $4;
+ # rename obsolete shift ASL -> LSL
+ if ($op3 =~ /([^\,]*)\,\s*asl (.*)/) {
+ $op3 = "$1, lsl $2";
+ }
+ PrintCheck();
+ EmitOriginal ($original, "TranslateConstrainedAnd");
+
+ printf "\t$opcode $op1, $op2";
+ printf ", $op3" if $op3;
+ PrintComment($comment);
+ Nl();
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedAnd", $original);
+ }
+}
+
+sub TranslateAnd ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ TranslateConstrainedAnd($original, $asm, $constraints, $comment);
+ } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)\s*,?(.+)?/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $op2 = $3;
+ my $op3 = $4;
+ # rename obsolete shift ASL -> LSL
+ if ($op3 =~ /([^\,]*)\,\s*asl (.*)/) {
+ $op3 = "$1, lsl $2";
+ }
+ PrintCheck();
+ EmitOriginal ($original, "TranslateAnd");
+
+ printf "\t$opcode $op1, $op2";
+ printf ", $op3" if $op3;
+ PrintComment($comment);
+ Nl();
+ } else {
+ UnrecognisedAsmWarning("TranslateAnd", $original);
+ }
+}
+
+
+# based on TranslateConstrainedInputAsmDefault
+sub TranslateConstrainedCoprocessorInsn ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ # we make some gross assumptions here which appear to hold for the majority of
+ # our code base namely:
+ # 1. there is normally only one input operand and
+ # 2. it is named 'a0'
+ # This allows us to carry out the simple minded substitution seen below.
+ my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));
+
+ $asm =~ s/\%a0/$cppExpr0/;
+ if ($asm =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ my $opcode = $1;
+ my $coproc = lc $2;
+ my $op1 = $3;
+ my $op2 = $4;
+ $coproc = "p$coproc" unless $coproc =~ /^p.+/;
+ PrintCheck();
+ EmitOriginal($original, "TranslateConstrainedCoprocessorInsn");
+ EmitAsm($opcode, $coproc, $op1, $op2, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedCoprocessorInsn", $original);
+ }
+}
+
+# based on TranslateAsmDefault
+sub TranslateCoprocessorInsn ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ TranslateConstrainedCoprocessorInsn($original, $asm, $constraints, $comment);
+ } elsif (@_[1] =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ my $opcode = $1;
+ my $coproc = lc $2;
+ my $op1 = $3;
+ my $op2 = $4;
+ $coproc = "p$coproc" unless $coproc =~ /^p.+/;
+ PrintCheck();
+ EmitOriginal ($original, "TranslateCoprocessorInsn");
+ EmitAsm($opcode, $coproc, $op1, $op2, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateCoprocessorInsn", $original);
+ }
+}
+
+sub TranslateConstrainedSWI ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ # we make some gross assumptions here which appear to hold for the majority of
+ # our code base namely:
+ # 1. there is normally only one input operand and
+ # 2. it is named 'a0'
+ # This allows us to carry out the simple minded substitution seen below.
+ my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));
+
+ $asm =~ s/\%a0/$cppExpr0/;
+ if ($asm =~ /(\w+)\s+(.+)/) {
+ my $opcode = $1;
+ my $op1 = $2;
+ PrintCheck();
+ EmitOriginal($original, "TranslateConstrainedSWI");
+ $opcode = RequiredCase($opcode);
+ printf "\t$opcode $op1";
+ PrintComment($comment);
+ Nl();
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedSWI", $original);
+ }
+}
+
+sub TranslateSWI ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ TranslateConstrainedSWI($original, $asm, $constraints, $comment);
+ } elsif (@_[1] =~ /(\w+)\s+(.+)/) {
+ my $opcode = $1;
+ my $op1 = $2;
+ PrintCheck();
+ EmitOriginal ($original, "TranslateSWI");
+ $opcode = RequiredCase($opcode);
+ printf "\t$opcode $op1";
+ PrintComment($comment);
+ Nl();
+ } else {
+ UnrecognisedAsmWarning("TranslateSWI", $original);
+ }
+}
+
+
+sub TranslateLabel ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ( $asm =~ /\s*(\S+)\:/) {
+ my $label = $1;
+ $label = Unmangle($label) unless ($label =~ /^(\d+)/);
+ SimpleEmit($original, $label, "TranslateLabel", $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateLabel", $original);
+ }
+}
+
+sub TranslateConstrainedAdr ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ # we make some gross assumptions here which appear to hold for the majority of
+ # our code base namely:
+ # 1. there is normally only one input operand and
+ # 2. it is named 'a0'
+ # This allows us to carry out the simple minded substitution seen below.
+ my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));
+
+ $asm =~ s/\%a0/$cppExpr0/;
+ if ($asm =~ /(\w+)\s+(\S+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ PrintCheck();
+ EmitOriginal($original, "TranslateConstrainedAdr");
+ EmitAsm($1, $2, $3, $4, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedAdr", $original);
+ }
+}
+
+sub TranslateAdr ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ TranslateConstrainedAdr($original, $asm, $constraints, $comment);
+ } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $eadr = $3;
+ my $op3;
+
+ if ($eadr =~ /^(\d+)([fFbB])/) {
+ my $id = $1;
+ my $dir = uc $2;
+ $eadr = "%$dir$id";
+ } else {
+ my $unmangledEadr = Unmangle($eadr);
+ my $pattern = quotemeta($eadr);
+ $eadr = "__cpp($unmangledEadr)" unless $unmangledEadr =~ /$pattern/;
+ }
+ MaybeEmitImport($eadr);
+ PrintCheck();
+ EmitOriginal ($original, "TranslateAdr");
+ EmitAsm($opcode, $op1, $eadr, $op3, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateAdr", $original);
+ }
+}
+
+sub RequiredCase($)
+{
+ my ($s) = @_;
+ lc $s;
+}
+
+sub TranslateAlign ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ( $asm =~ /\s*\.align\s+(\S+)/i) {
+ my $alignment = $1;
+ my $boundary = "1:SHL:$1";
+# my $boundary = "";
+ my $boundary = "" if ($alignment =~ /\s*0\s*/);
+
+ my $directive = RequiredCase("ALIGN");
+ SimpleEmit($original, "\t$directive $boundary", "TranslateAlign", $comment);
+ }
+ else {
+ UnrecognisedAsmWarning("TranslateAlign", $original);
+ }
+}
+
+sub TranslateSpace ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ( $asm =~ /\s*\.space\s+(\S+)/i) {
+ my $directive = RequiredCase("SPACE");
+ SimpleEmit($original, "\t$directive $1", "TranslateSpace", $comment);
+ }
+ else {
+ UnrecognisedAsmWarning("TranslateSpace", $original);
+ }
+}
+
+sub TranslateByte ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("DCB");
+ $asm =~ /\s*.byte\s+(.*)/i;
+ my $args = $1;
+ if ($constraints) {
+ $args = TranslateConstrainedArgs($args, $constraints);
+ SimpleEmit($original, "\t$directive $args", "TranslateByte", $comment);
+ } else {
+ MaybeImportArgs($args);
+ SimpleEmit($original, "\t$directive $args", "TranslateByte", $comment);
+ }
+}
+
+sub CppExprList($)
+{
+ my ($arg) = @_;
+ return $arg if ($arg =~ /\s*__cpp/);
+
+ if ($arg =~ /(.*)\,\s*([^\s]*)/) {
+ my $result = CppExprList($1);
+ my $expr = $2;
+ if ($expr =~ /\s*0x\d+/) {
+ return $result .= ", __cpp($expr)";
+ } elsif ($expr =~ /\s*(\d+)/) {
+ my $hex = sprintf("%#.8x", $1);
+ return $result .= ", __cpp($hex)";
+ } else {
+ my $pattern = quotemeta($expr);
+ my $unmangledExpr = Unmangle($expr);
+ return ($unmangledExpr =~ /$pattern/) ? $expr : "__cpp(\&$unmangledExpr)";
+ }
+ } else {
+ if ($arg =~ /\s*0x\d+/) {
+ return " __cpp($arg)";
+ } elsif ($arg =~ /\s*(\d+)/) {
+ my $hex = sprintf("%#.8x", $1);
+ return " __cpp($hex)";
+ } else {
+ if ($arg =~ /\s*([^\s]*)/) {
+ $arg = $1;
+ my $pattern = quotemeta($arg);
+ my $unmangledArg = Unmangle($arg);
+ return ($unmangledArg =~ /$pattern/) ? $arg : "__cpp(\&$unmangledArg)";
+ }
+ }
+ }
+}
+
+# Add symbols here that aren't imported if they're 'special'.
+my %recognizedSymbols =
+ (
+ Followers => 1,
+ TheScheduler => 1,
+ TheMonitor => 1,
+ MonitorStack => 1,
+ ServerAccept => 1,
+ ServerReceive => 1,
+ wordmove => 1,
+ memcpy => 1,
+ memcompare => 1,
+ memclr => 1,
+ memset => 1,
+ memmove => 1,
+ );
+
+sub EmitRecognizedSymbol ($$$$)
+{
+ my ($original, $directive, $sym, $comment) = @_;
+ return 0 if ($sym =~ /\s*0x/i );
+ return 0 if ($sym =~ /^\s*0\s*/ );
+ return 0 if ($sym =~ /^\s*\d+\s*/ );
+ return 0 if ($sym =~ /\s*__cpp\(/ );
+ my $unms = Unmangle($sym);
+ my $pat = quotemeta($unms);
+ unless ($sym =~ /$pat/) {
+ SimpleEmit($original, "\t$directive __cpp($unms)", "TranslateWord", $comment);
+ return 1;
+ }
+ if (($sym =~ /(\S*)/) && !(grep /^$1$/, @knownLabels) ) {
+ SimpleEmit($original, "\timport $sym", "TranslateWord", "// added by Tranasm");
+ AssertSourceFile();
+ SimpleEmit($original, "\t$directive $sym", "TranslateWord", $comment);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub TranslateWord ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("DCD");
+ $asm =~ /\s*.word\s+(.*)/i;
+ my $args = $1;
+ if ($constraints) {
+ $args = TranslateConstrainedArgs($args, $constraints);
+ SimpleEmit($original, "\t$directive $args", "TranslateWord", $comment);
+ } else {
+ MaybeImportArgs($args);
+ SimpleEmit($original, "\t$directive $args", "TranslateWord", $comment);
+ }
+}
+
+sub TranslateCode ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("CODE");
+ if ( $asm =~ /\s*\.code\s+(\d+)\s*/i) {
+ SimpleEmit($original, "\t$directive$1", "TranslateCode", $comment);
+ }
+ else {
+ UnrecognisedAsmWarning("TranslateCode", $original);
+ }
+}
+
+sub TranslateGlobal ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("EXPORT");
+ if ( $asm =~ /\s*\.global\s+(\S+)/i) {
+ SimpleEmit($original, "\t$directive $1", "TranslateGlobal", $comment);
+ }
+ else {
+ UnrecognisedAsmWarning("TranslateGlobal", $original);
+ }
+}
+
+sub TranslateExtern ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("IMPORT");
+ if ( $asm =~ /\s*\.extern\s+(\S+)/i) {
+ SimpleEmit($original, "\t$directive $1", "TranslateExtern", $comment);
+ }
+ else {
+ UnrecognisedAsmWarning("TranslateExtern", $original);
+ }
+}
+
+sub TranslateNop ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $directive = RequiredCase("NOP");
+ SimpleEmit($original, "\t$directive", "TranslateNop", $comment);
+}
+
+sub EmitAsm($$$$$)
+{
+ my ($opcode, $op1, $op2, $op3, $comment) = @_;
+ $opcode = RequiredCase($opcode);
+ printf "\t%s %s, %s", $opcode, $op1, $op2;
+ printf(", %s", $op3) if $op3;
+ PrintComment($comment);
+ Nl();
+}
+
+sub TranslateBranchDefault ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($constraints) {
+ Croak( "TranslateBranchDefault can't deal with Constraint instructions\n E.G. - $original");
+ } elsif ($asm =~ /(\w+)\s+(.+)\s*$/) {
+ my $opcode = RequiredCase($1);
+ my $target = $2;
+
+ if ($target =~ /^(\d+)([fFbB])/) {
+ my $id = $1;
+ my $dir = uc $2;
+ $target = "%$dir$id";
+ } else {
+ my $unmangledTarget = Unmangle($target);
+ my $pattern = quotemeta($target);
+ $target = "__cpp($unmangledTarget)" unless $unmangledTarget =~ /$pattern/;
+ }
+ EmitOriginal ($original, "TranslateBranchDefault");
+ MaybeEmitImport($target);
+ printf("\t%s %s", $opcode, $target);
+ PrintComment($comment);
+ Nl();
+ } else {
+ UnrecognisedAsmWarning("TranslateBranchDefault", $original);
+ }
+}
+
+sub TranslatePushPop ($$$$)
+{
+ my ($original, $asm, $constraints, $comment) = @_;
+ if ($asm =~ /(\w+)\s+(.+)\s*$/) {
+ my $opcode = RequiredCase($1);
+ my $registers = $2;
+
+ if ($constraints) {
+ Croak( "TranslatePushPop can't deal with constrained instructions\n E.G. - $original\n");
+ } else {
+ EmitOriginal ($original, "TranslatePushPop");
+ printf "\t$opcode $registers";
+ PrintComment($comment);
+ Nl();
+ }
+ }
+ else {
+ UnrecognisedAsmWarning("TranslatePushPop", $comment);
+ }
+}
+
+sub TranslateConstrainedAsmDefault ($$$$)
+{
+ # Here we assume:
+ # 1. at most one output constraint
+ # 2. the output constraint is named '%0'
+ # 3. at most one input constraint
+ # 4. the input constraint is named '%a0'
+
+ my ($original, $asm, $constraints, $comment) = @_;
+ my $outputConstraint;
+ my $inputConstraint;
+ if ($outputConstraint = GetOutputConstraint($constraints, 0)) {
+ my $outputCppExpr = CppExprFromConstraint($outputConstraint);
+ $asm =~ s/\%0/$outputCppExpr/;
+ }
+ if ($inputConstraint = GetInputConstraint($constraints, 0, 1)) {
+ my $inputCppExpr = CppExprFromConstraint($inputConstraint);
+ $asm =~ s/\%a0/$inputCppExpr/;
+ }
+ if ($asm =~ /^\s*(\w+)\s+([^\,]+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $op2 = $3;
+ my $op3 = $4;
+ if ($outputConstraint) {
+ printf "\t>>> CHECK THIS - output constraints need special attention <<<\n";
+ } else {
+ PrintCheck();
+ }
+ EmitOriginal($original, "TranslateConstrainedAsmDefault");
+ $op1 =~ s/cpsr_flg/cpsr_f/i;
+ $op2 =~ s/asl /lsl /i if $op2;
+ $op3 =~ s/asl /lsl /i if $op3;
+ EmitAsm($opcode, $op1, $op2, $op3, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslateConstrainedAsmDefault", $original);
+ }
+}
+
+sub TranslatePotentialOutputConstrainedAsm ($$$$)
+{
+
+ my ($original, $asm, $constraints, $comment) = @_;
+
+ if ($constraints) {
+ TranslateConstrainedAsmDefault($original, $asm, $constraints, $comment);
+ } elsif ($asm =~ /(\w+)\s+([^\,]+)\s*\,\s*(.+)\s*,?(.+)?/) {
+ my $opcode = uc $1;
+ my $op1 = $2;
+ my $op2 = $3;
+ my $op3 = $4;
+ PrintCheck();
+ EmitOriginal ($original, "TranslatePotentialOutputConstrainedAsm");
+
+ # MSR cpsr,...
+ $op1 .= "_cxsf" if ($opcode =~ /msr/i and $op1 =~ /[cs]psr\s*$/);
+ $op1 =~ s/cpsr_flg/cpsr_f/i;
+ $op2 =~ s/asl /lsl /i if $op2;
+ $op3 =~ s/asl /lsl /i if $op3;
+ EmitAsm($opcode, $op1, $op2, $op3, $comment);
+ } else {
+ UnrecognisedAsmWarning("TranslatePotentialOutputConstrainedAsm", $original);
+ }
+}
+
+
+# Here's the table of translator functions
+my %opcodeTranslatorMapping =
+ (
+ "LABEL:"=>\&TranslateLabel,
+
+ ".ALIGN"=>\&TranslateAlign,
+ ".BSS"=>\&EmitUnimplementedOpcode,
+ ".BYTE"=>\&TranslateByte,
+ ".CODE"=>\&TranslateCode,
+ ".DATA"=>\&EmitUnimplementedOpcode,
+ ".GLOBAL"=>\&TranslateGlobal,
+ ".EXTERN"=>\&TranslateExtern,
+ ".HWORD"=>\&EmitUnimplementedOpcode,
+ ".LONG"=>\&EmitUnimplementedOpcode,
+ ".SECTION"=>\&EmitUnimplementedOpcode,
+ ".SPACE"=>\&TranslateSpace,
+ ".TEXT"=>\&EmitUnimplementedOpcode,
+ ".WORD"=>\&TranslateWord,
+ "ADC"=>\&TranslateAsmDefault,
+ "ADD"=>\&TranslateAsmDefault,
+ "ADR"=>\&TranslateAdr,
+ "AND"=>\&TranslateAnd,
+
+ "B"=>\&TranslateBranchDefault,
+ "BEQ"=>\&TranslateBranchDefault,
+ "BNE"=>\&TranslateBranchDefault,
+ "BHS"=>\&TranslateBranchDefault,
+ "BCS"=>\&TranslateBranchDefault,
+ "BCC"=>\&TranslateBranchDefault,
+ "BLO"=>\&TranslateBranchDefault,
+ "BMI"=>\&TranslateBranchDefault,
+ "BPL"=>\&TranslateBranchDefault,
+ "BVS"=>\&TranslateBranchDefault,
+ "BVC"=>\&TranslateBranchDefault,
+ "BHI"=>\&TranslateBranchDefault,
+ "BLS"=>\&TranslateBranchDefault,
+ "BGE"=>\&TranslateBranchDefault,
+ "BLT"=>\&TranslateBranchDefault,
+ "BGT"=>\&TranslateBranchDefault,
+ "BLE"=>\&TranslateBranchDefault,
+ "BCLR"=>\&TranslateBranchDefault,
+ "BIC"=>\&TranslateAsmDefault,
+ "BKPT"=>\&TranslateBranchDefault, # not really a branch but can reuse translator
+
+ "BL"=>\&TranslateBranchDefault,
+ "BLEQ"=>\&TranslateBranchDefault,
+ "BLNE"=>\&TranslateBranchDefault,
+ "BLHS"=>\&TranslateBranchDefault,
+ "BLCS"=>\&TranslateBranchDefault,
+ "BLCC"=>\&TranslateBranchDefault,
+ "BLLO"=>\&TranslateBranchDefault,
+ "BLMI"=>\&TranslateBranchDefault,
+ "BLPL"=>\&TranslateBranchDefault,
+ "BLVS"=>\&TranslateBranchDefault,
+ "BLVC"=>\&TranslateBranchDefault,
+ "BLHI"=>\&TranslateBranchDefault,
+ "BLLS"=>\&TranslateBranchDefault,
+ "BLGE"=>\&TranslateBranchDefault,
+ "BLLT"=>\&TranslateBranchDefault,
+ "BLGT"=>\&TranslateBranchDefault,
+ "BLLE"=>\&TranslateBranchDefault,
+
+ "BLX"=>\&TranslateBranchDefault,
+ "BLXEQ"=>\&TranslateBranchDefault,
+ "BLXNE"=>\&TranslateBranchDefault,
+ "BLXHS"=>\&TranslateBranchDefault,
+ "BLXCS"=>\&TranslateBranchDefault,
+ "BLXCC"=>\&TranslateBranchDefault,
+ "BLXLO"=>\&TranslateBranchDefault,
+ "BLXMI"=>\&TranslateBranchDefault,
+ "BLXPL"=>\&TranslateBranchDefault,
+ "BLXVS"=>\&TranslateBranchDefault,
+ "BLXVC"=>\&TranslateBranchDefault,
+ "BLXHI"=>\&TranslateBranchDefault,
+ "BLXLS"=>\&TranslateBranchDefault,
+ "BLXGE"=>\&TranslateBranchDefault,
+ "BLXLT"=>\&TranslateBranchDefault,
+ "BLXGT"=>\&TranslateBranchDefault,
+ "BLXLE"=>\&TranslateBranchDefault,
+
+ "BSET"=>\&EmitUnimplementedOpcode,
+
+ "BX"=>\&TranslateBranchDefault,
+ "BXEQ"=>\&TranslateBranchDefault,
+ "BXNE"=>\&TranslateBranchDefault,
+ "BXHS"=>\&TranslateBranchDefault,
+ "BXCS"=>\&TranslateBranchDefault,
+ "BXCC"=>\&TranslateBranchDefault,
+ "BXLO"=>\&TranslateBranchDefault,
+ "BXMI"=>\&TranslateBranchDefault,
+ "BXPL"=>\&TranslateBranchDefault,
+ "BXVS"=>\&TranslateBranchDefault,
+ "BXVC"=>\&TranslateBranchDefault,
+ "BXHI"=>\&TranslateBranchDefault,
+ "BXLS"=>\&TranslateBranchDefault,
+ "BXGE"=>\&TranslateBranchDefault,
+ "BXLT"=>\&TranslateBranchDefault,
+ "BXGT"=>\&TranslateBranchDefault,
+ "BXLE"=>\&TranslateBranchDefault,
+ "CDP"=>\&TranslateAsmDefault,
+ "CLZ"=>\&TranslateAsmDefault,
+ "CMN"=>\&TranslateAsmDefault,
+ "CMP"=>\&TranslateAsmDefault,
+ "EOR"=>\&TranslateAsmDefault,
+ "LDC"=>\&TranslateAsmDefault,
+ "LDM"=>\&TranslateAsmDefault,
+ "LDR"=>\&TranslateAsmDefault,
+ "LDRB"=>\&TranslateAsmDefault,
+ "LSL"=>\&EmitUnimplementedOpcode,
+ "LSR"=>\&EmitUnimplementedOpcode,
+ "MCR"=>\&TranslateCoprocessorInsn,
+ "MLA"=>\&TranslateAsmDefault,
+ "MOV"=>\&TranslatePotentialOutputConstrainedAsm,
+ "MRC"=>\&TranslateCoprocessorInsn,
+ "MRS"=>\&TranslatePotentialOutputConstrainedAsm,
+ "MSR"=>\&TranslatePotentialOutputConstrainedAsm,
+ "MUL"=>\&TranslateAsmDefault,
+ "MVN"=>\&TranslateAsmDefault,
+ "NOP"=>\&TranslateNop,
+ "ORR"=>\&TranslateAsmDefault,
+ "POP"=>\&TranslatePushPop,
+ "PUSH"=>\&TranslatePushPop,
+ "RSB"=>\&TranslateAsmDefault,
+ "RSC"=>\&TranslateAsmDefault,
+ "SBC"=>\&TranslateAsmDefault,
+ "SMLAL"=>\&TranslateAsmDefault,
+ "STC"=>\&TranslateAsmDefault,
+ "STM"=>\&TranslateAsmDefault,
+ "STR"=>\&TranslateAsmDefault,
+ "SUB"=>\&TranslateAsmDefault,
+ "SWI"=>\&TranslateSWI,
+ "SWP"=>\&TranslateAsmDefault,
+ "TEQ"=>\&TranslateAsmDefault,
+ "TST"=>\&TranslateAsmDefault,
+ "UMLAL"=>\&TranslateAsmDefault,
+ "UMULL"=>\&TranslateAsmDefault,
+ "UMULLEQ"=>\&TranslateAsmDefault,
+ "UMULLNE"=>\&TranslateAsmDefault,
+ "UMULLCS"=>\&TranslateAsmDefault,
+ "UMULLCC"=>\&TranslateAsmDefault,
+ "UMULLHS"=>\&TranslateAsmDefault,
+ "UMULLLO"=>\&TranslateAsmDefault,
+ "UMULLMI"=>\&TranslateAsmDefault,
+ "UMULLPL"=>\&TranslateAsmDefault,
+ "UMULLVS"=>\&TranslateAsmDefault,
+ "UMULLVC"=>\&TranslateAsmDefault,
+ "UMULLHI"=>\&TranslateAsmDefault,
+ "UMULLLS"=>\&TranslateAsmDefault,
+ "UMULLGE"=>\&TranslateAsmDefault,
+ "UMULLLT"=>\&TranslateAsmDefault,
+ "UMULLGT"=>\&TranslateAsmDefault,
+ "UMULLLE"=>\&TranslateAsmDefault,
+ );
+
+my @unknownOpcodes;
+
+sub GetTranslator ($)
+{
+ my $opcode = shift;
+
+ # see if opcode looks like a label
+ return $opcodeTranslatorMapping{"LABEL:"} if ($opcode =~ /\w+\:$/);
+
+ # just look it up
+ my $translator = $opcodeTranslatorMapping{$opcode};
+ return $translator if $translator;
+
+ # see if we know the 'root' of the opcode
+ return $opcodeTranslatorMapping{substr($opcode, 0, 3)};
+}
+
+
+my %seenIncFiles = ();
+
+sub trackSourceLine($)
+{
+ my ($line) = @_;
+ if ($line =~ /\#line (\d+)\s*(.*)$/ ) {
+ $lineno = $1-1;
+ $sourcefile = $2;
+ if ($sourcefile =~ /.*\.h/i) {
+ unless ($seenIncFiles{$sourcefile}) {
+ $seenIncFiles{$sourcefile} = 1;
+ my $incfile = "$sourcefile";
+ $incfile =~ s/\"//go;
+ $incfile =~ s/\\\\/${main::PATHSEP}/go;
+ $incfile = "$incroot"."$incfile" unless ($incfile =~ /^${main::PATHSEP}/);
+ push @IncFiles, $incfile;
+ }
+ }
+ }
+}
+
+sub AssertSourceFile()
+{
+ printf "#line %d %s\n", $lineno, $sourcefile;
+}
+
+my @contents;
+
+sub AddLabel($) {
+ my ($label) = @_;
+ if ($label =~ /\s*(\S+)\s*/ ) {
+ $label = $1;
+ }
+ push @knownLabels, $label;
+}
+
+sub MaybeEmitImport ($) {
+ my ($l) = @_;
+ print "\timport $l\[DYNAMIC\]\n" if NeedsImporting($l);
+}
+
+sub Pass1()
+{
+ die "ERROR: Couldn't open $infile\n" unless open INP, "<$infile";
+ my $line;
+ MAINBLOCK: while ($line = <INP>) {
+ # strip off comment if present
+ my $statement;
+ my $comment = 0;
+
+ push @contents, $line;
+
+ if ($line =~ /^\s*$/) {
+ next MAINBLOCK;
+ }
+ if ($line =~ /(.*)\/\/(.+)/) {
+ $statement = $1;
+ $comment = $2;
+ } else {
+ $statement = $line;
+ }
+
+ if ($statement =~ /^((.*;\s*)|(\s*))asm\s*\(/) {
+ foreach $statement ( split /\;/, $statement ) {
+ TRANSLATE_ASM:
+ if ($statement =~ /^\s*asm\s*\(\s*\"(.*)\"\s*(:.*)*\)/) {
+ my $asm = $1;
+ my $constraints = $2;
+ $asm =~ s/\"\s*\"//g;
+ $asm =~ /\s*(\S+)/;
+ my $opcode = $1;
+
+ # if its a label record it
+ if ($opcode =~ /(\w+)\:$/) {
+ AddLabel($1);
+ }
+ }
+ }
+ }
+ }
+ close INP;
+}
+
+sub CanonicalizeAsm($) {
+ my ($s) = @_;
+ if ($s =~ /(asm\([^\)]+\))\s*\;(.*)/o) {
+ my $start = "$`";
+ my $subst = $1;
+ my $rem = $2;
+ $subst =~ s/\;/ \"\)\; asm\(\"/g;
+ return "$start"."$subst; ".CanonicalizeAsm($rem);
+ } else {
+ return $s;
+ }
+}
+
+sub Pass2()
+{
+ $lineno = 0;
+
+ my $startingBody = 0;
+ my $line;
+ MAINBLOCK: foreach $line ( @contents ) {
+ # strip off comment if present
+ my $statement;
+ my $comment = 0;
+
+ warn "$lineno\n" if $plineno;
+ $lineno++;
+ if ($line =~ /^\s*$/) {
+ print "$line";
+ next MAINBLOCK;
+ }
+ if ($line =~ /(.*)\/\/(.+)/) {
+ $statement = $1;
+ $comment = $2;
+ } else {
+ $statement = $line;
+ }
+
+ if ($statement =~ /^((.*;\s*)|(\s*))asm\s*\(/) {
+ # unfortunately we get things like:
+ # asm("mcr"#cc" p15, 0, "#r", c7, c5, 0; sub"#cc" pc, pc, #4 ");
+ # we need to turn this into asm("mcr"#cc" p15, 0, "#r", c7, c5, 0"); asm("sub"#cc" pc, pc, #4 ");
+ $statement = CanonicalizeAsm($statement);
+ foreach $statement ( split /\;/, $statement ) {
+ TRANSLATE_ASM:
+ if ($statement =~ /^\s*asm\s*\(\s*\"(.*)\"\s*(:.*)*\)/) {
+ my $asm = $1;
+ my $constraints = $2;
+ $asm =~ s/\"\s*\"//g;
+ $asm =~ /\s*(\S+)/;
+ my $opcode = uc $1;
+
+ AssertSourceFile();
+ my $translator = GetTranslator($opcode);
+ if ($translator) {
+ $translator->($line, $asm, $constraints, $comment);
+ } else {
+ push @unknownOpcodes, $opcode ;
+ EmitUnimplementedOpcode($line, $asm, $constraints, $comment);
+ }
+ } elsif ($statement =~ /^\s*(__declspec.*\s* __asm .*\)\s*\{)(.*)$/) {
+ AssertSourceFile();
+ print "$1\n";
+ print "\tPRESERVE8\n\tCODE32\n";
+ $statement = $2;
+ goto TRANSLATE_ASM;
+ } elsif ($statement =~ /^\s*(__asm .*\)\s*\{)(.*)$/) {
+ AssertSourceFile();
+ print "$1\n";
+ print "\tPRESERVE8\n\tCODE32\n";
+ $statement = $2;
+ goto TRANSLATE_ASM;
+ } elsif (($statement =~ /^\s*.*\s+__asm [^\{]*$/) || ($statement =~ /^\s*__asm [^\{]*$/)) {
+ AssertSourceFile();
+ print "$statement";
+ $startingBody = 1;
+ } elsif ($startingBody && ($statement =~ /^\s*\{\s*$/) ) {
+ AssertSourceFile();
+ print "$statement";
+ print "\tPRESERVE8\n\tCODE32\n";
+ $startingBody = 0;
+ } elsif ($statement =~ /\s*(\S.*)$/) {
+ print "\t$1;\n";
+ }
+ }
+ } elsif (($statement =~ /^\s*.*\s+__asm [^\{]*$/) || ($statement =~ /^\s*__asm [^\{]*$/)) {
+ AssertSourceFile();
+ print "$statement";
+ $startingBody = 1;
+ } elsif ($startingBody && ($statement =~ /^\s*\{\s*$/) ) {
+ AssertSourceFile();
+ print "$statement";
+ print "\tPRESERVE8\n\tCODE32\n";
+ $startingBody = 0;
+ } else {
+ trackSourceLine($line);
+ print "$line";
+ }
+ }
+}
+
+sub Main () {
+ Pass1();
+ Pass2();
+}
+
+Main();
+
+if ($outfile) {
+ select $savedOut;
+ close OUT;
+}
+
+if (@unknownOpcodes > 0){
+ printf STDERR "WARNING: The following opcodes were unrecognised:\n";
+ my $op;
+ foreach $op (sort @unknownOpcodes) { printf STDERR "\t$op\n";}
+}
+
+
+if ($recordUnmangledSymbols){
+ open US, ">>$symbolsfile";
+ foreach (@unmangledSymbols) { print US "$_ \n";}
+ close US;
+}
+
+
+sub Usage
+{
+ print <<EOT;
+
+tranasm
+
+ Translate GCC inline assembler into ARM embedded assembler
+
+Usage:
+ tranasm [options] file
+
+Where:
+ [file] The file to be translated.
+
+Options:
+ --record-emitter each translation annotated with name of translation function
+ --suppress-check omit deliberate errors inserted to force human checking
+ --no-original do not emit the original gcc inline assembler as comment
+ --error-string the string to emit as the deliberate error
+ --output the name of the output file
+ --help this message
+
+ Options may also be specified as a short abbreviation, ie -h or -o=foo.tr.
+ The default deliberate error is indicated thus />>> CHECK THIS .*<<</.
+EOT
+ exit 1;
+}
+
+__END__