Put DEPCRUNCH with resource.flm, but keep python as a globally available variable.
#!/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__