diff -r 000000000000 -r 83f4b4db085c toolsandutils/e32tools/tranasm/tranasm.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/toolsandutils/e32tools/tranasm/tranasm.pl Tue Feb 02 01:39:43 2010 +0200 @@ -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 = ; + 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 = ) { + # 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 <>> CHECK THIS .*<<