1 #!/usr/bin/perl

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

     3 # All rights reserved.

     4 # This component and the accompanying materials are made available

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

     6 # which accompanies this distribution, and is available

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

     8 #

     9 # Initial Contributors:

    10 # Nokia Corporation - initial contribution.

    11 #

    12 # Contributors:

    13 #

    14 # Description:

    15 #

    16 

    17 use strict;

    18 use Getopt::Long;

    19 use Cwd;

    20 

    21 my $Pwd = cwd;

    22 

    23 my $incroot = $Pwd;

    24 if ($Pwd =~ /.\:(.*)$/) {

    25 	$incroot = $1;

    26 	$incroot =~ s/\//\\/go;

    27 	$incroot = "$incroot"."\\";

    28 }

    29 

    30 if ($^O == "MSWin32" ) {

    31 	my $PATHSEP='\\'

    32 } else {

    33 	my $PATHSEP='/'

    34 }

    35 

    36 

    37 my $commentToken = "//";

    38 

    39 my $emitUnimplemented = 1;

    40 

    41 my %opts = ();

    42 

    43 my $result = GetOptions(\%opts,

    44 						"record-emitter",

    45 						"suppress-check",

    46 						"no-original",

    47 						"output:s",

    48 						"error-string:s",

    49 						"autoflush",

    50 						"help",

    51 						"lineno",

    52 						);

    53 

    54 Usage() if(!$result || $opts{'help'} || @ARGV < 1);

    55 

    56 my $errorString = "\t>>> CHECK THIS <<<";

    57 

    58 my $recordEmitter = $opts{"record-emitter"};

    59 my $plineno = $opts{"lineno"};

    60 my $forceCheck = !$opts{"suppress-check"};

    61 my $printOriginal = !$opts{"no-original"};

    62 my $outfile = $opts{"output"} if $opts{"output"};

    63 my $infile = @ARGV[0];

    64 $errorString = $opts{"error-string"} if $opts{"error-string"};

    65 

    66 #my $symbolsfile = "tranasm-symbols.log";

    67 my $symbolsfile = "";

    68 my $savedOut;

    69 # set to false to prevent recording files in \tranlated-files.log

    70 #my $recordFile = 0;

    71 

    72 #system "echo $infile >> \\translated-files.log" if $recordFile;

    73 my @unmangledSymbols;

    74 my $recordUnmangledSymbols = $symbolsfile;

    75 

    76 if ($outfile) {

    77 	open OUT, ">$outfile";

    78 	$savedOut = select OUT;

    79 }

    80 

    81 $| = $opts{"autoflush"};

    82 

    83 

    84 my $labelN = 0;

    85 my $labelRoot = "Label";

    86 

    87 my $lineno = 0;

    88 my @knownLabels = ();

    89 

    90 sub Croak($)

    91 {

    92 	my ($msg) = @_;

    93     die  "\nERROR: line $.: $msg";

    94 }

    95 

    96 sub PrintComment($)

    97 {

    98 	my ($comment) = @_;

    99     printf "\t$commentToken$comment" if $comment;

   100 }

   101 

   102 sub PrintCheck() { printf "\t$errorString\n" if $forceCheck; }

   103 

   104 sub Nl () { printf "\n"; }

   105 

   106 # cache for results of unmangling....

   107 my %unmangledSymbols = ();

   108 # cache to say whether symbol was mangled

   109 my %mangledSymbols = ();

   110 

   111 my $sourcefile = "\"$infile\"";

   112 

   113 my @IncFiles;

   114 

   115 

   116 sub Unmangle ($)

   117 {

   118 	my ($str) = @_;

   119 	return $str if ($str =~ /\s*__cpp\(/); # these don't need unmangling

   120 	my $res = $unmangledSymbols{$str};

   121 	if ($res) {

   122 		my $l = $lineno;

   123 		if ($mangledSymbols{$str}) {

   124 			my $sfile = $sourcefile;

   125 			$sfile =~ s/\"//go;

   126 			$sfile =~ s/\\\\/${main::PATHSEP}/go;

   127 			push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = \?\?\? : @IncFiles"

   128 			}

   129 		return $res;

   130 	} else {

   131 		return $unmangledSymbols{$str} = UnmangleX($str);

   132 	}

   133 }

   134 

   135 sub UnmangleX ($)

   136 {

   137 	my ($str) = @_;

   138 

   139 	my $sfile = $sourcefile;

   140 	$sfile =~ s/\"//go;

   141 	$sfile =~ s/\\\\/${main::PATHSEP}/go;

   142 

   143 	# recognize non-c++ derived symbols/labels

   144 	if ($str =~ /^\s*(__.*)\s*$/) {

   145 	    $str =~ s/\./_/;

   146 	    return $str;

   147 	} 

   148 

   149 	my $cppfilt = $ENV{CPPFILT} ? $ENV{CPPFILT} : "c++filt";

   150 	open UNM, "$cppfilt -s gnu $str|" or die "Error: Tranasm problem running $cppfilt to unmangle symbols.\n";

   151 	my $result = <UNM> ;

   152 	chop $result;

   153 

   154 	my $pat = "\^\\s*$result\\s*\$";

   155 	if ($str =~ $pat) {

   156 	    return $str;

   157 	}

   158 

   159 	close UNM;

   160 	#strip of any args

   161 	if ($result =~ /([^\(]*)\s*\(/) {

   162 		my $res = $1;

   163 		if ($recordUnmangledSymbols) {

   164 			my $l = $lineno;

   165 			$mangledSymbols{$str} = 1;

   166 			push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = $result : @IncFiles";

   167 		}

   168 		$result = $res;

   169 	} else {

   170 		# didn't have args so try as a (static) var

   171 		my $res = "\&$result";

   172 		if ($recordUnmangledSymbols) {

   173 			my $l = $lineno;

   174 			$mangledSymbols{$str} = 1;

   175 			push @unmangledSymbols, "$incroot$sfile $l: Symbol = $str : Result = $res : Filt = $result : @IncFiles";

   176 		}

   177 		$result = $res;

   178 	}		

   179 	return $result;

   180 }

   181 

   182 sub EmitOriginal($$)

   183 {

   184 	my ($orig , $emitter) = @_;

   185 	$orig =~ /\s*(.*)/;

   186 	printf "\t$commentToken Original - $1\n" if ($printOriginal);

   187 	printf "\t$commentToken emitted by $emitter\n" if ($recordEmitter);

   188 }

   189 

   190 sub EmitUnimplementedOpcode ($$$$)

   191 {

   192     my ($original, $asm) = @_;

   193     if ($emitUnimplemented) {

   194 		EmitOriginal ($original, "EmitUnimplementedOpcode");

   195 		if ($asm =~ /(\S+)\s+/ or $asm =~ /\.*(\S+)/){

   196 			my $opcode = uc $1;

   197 			printf "\t$commentToken Translation of opcode $opcode not implemented\n";

   198 			printf "\t**** Insert translation here ****\n";

   199 		}

   200 		else { 

   201 			UnrecognisedAsmWarning("EmitUnimplementedOpcode", $original);

   202 		}

   203     }

   204 }

   205 

   206 sub SimpleEmit ($$$$)

   207 {

   208 	my ($original, $str, $emitter, $comment) = @_;

   209 	PrintCheck();

   210     EmitOriginal ($original, $emitter);

   211     printf "$str";

   212     PrintComment($comment);

   213     Nl();

   214 }

   215 

   216 sub UnrecognisedAsmWarning ($$)

   217 {

   218     my ($where, $what) = @_;

   219     printf STDERR "WARNING: line $. unrecognised asm format in $where: $what";

   220 }

   221 

   222 sub Count ($$$$) {

   223 	my ($str, $c, $start, $end) = @_;

   224 	my $total = 0;

   225 	my @a = split //, $str;

   226 	for (;$start < $end; $start++) {

   227 		$total++ if ($a[$start] eq $c);

   228 	}

   229 	return $total;

   230 }

   231 

   232 sub TranslateConstrainedArgs($$) {

   233 	my ($args, $constraints) = @_;

   234 	my $ins = GetInputConstraints($constraints) if ($constraints);

   235 	my @arglist;

   236 	my @rl;

   237 	my $start = 0;

   238 	my $end = length $args;

   239 	my $cpos = index $args, ",", $start;

   240 	if ($cpos > -1) {

   241 		while ($cpos > -1) {

   242 			#make sure we got a match number of '('s and ')' $start and $cpos

   243 			my $nl = Count($args, '(', $start, $cpos);

   244 			my $nr = Count($args, ')', $start, $cpos);

   245 			if ($nl == $nr) {

   246 				my $arg = substr($args, $start, $cpos - $start);

   247 				push @arglist, $arg;

   248 				$start = $cpos + 1;

   249 				$cpos = index $args, ",", $start;

   250 			} else {

   251 				$cpos = index $args, ",", $cpos + 1;

   252 			}

   253 		}

   254 		push @arglist, substr($args, $start, $end);

   255 

   256 	} else {

   257 		push @arglist, ChopWhiteSpace($args);

   258 	}

   259 	foreach (@arglist) {

   260 		push @rl, SubstituteConstraint($_, $ins);

   261 	}

   262 	return join ", ", @rl;

   263 }

   264 

   265 sub GetInputConstraints($) {

   266 	my ($cs) = @_;

   267 	if ($cs =~ /\:\s+\:\s*(.*)/) {

   268 		return join "", split '\"i\" ', $1;

   269 	} else {

   270 		Croak("unrecognized contraints format: $cs\n");

   271 	}

   272 }

   273 

   274 sub ChopWhiteSpace ($) {

   275 	my ($str) = @_;

   276 	my @a = split //, $str;

   277 	my $n = length($str);

   278 	return $str if $n == 0;

   279 	while (--$n) {

   280 	    if ($a[$n] eq ' ') {

   281 		next;

   282 	    } else {

   283 		last;

   284 	    }

   285 	}

   286 	$n++ unless $a[$n] eq ' ';

   287 	return substr $str, 0, $n;

   288 }

   289 

   290 sub SubstituteConstraint($$) {

   291     my ($arg, $cs) = @_;

   292     my $u;

   293 	$arg = ChopWhiteSpace($arg);

   294 	unless ($cs) {

   295 		if ($arg =~ /\s*(.*)\s*$/ ) {

   296 			$u = $1;

   297 		} else {

   298 			Croak("Arg not supplied in SubstituteConstraint\n");

   299 		}

   300 	} elsif ($arg =~ /\%\S+(\d+)/ ) {

   301 		my $i = $1;

   302 		my @c = split '\,', $cs;

   303         $u = $c[$i];

   304     } elsif ($arg =~ /\s*(.*)\s*$/ ) {

   305 		$u = $1;

   306     } else {

   307 		Croak("Arg not supplied in SubstituteConstraint\n");

   308 	}

   309 	my $metau = quotemeta "$u";

   310 	if (NeedsImporting($u)) {

   311 		print "\timport $u ";

   312 		PrintComment("Added by Substitute Constraint");

   313 		Nl();

   314 		AssertSourceFile();

   315 		return "$u";

   316 	} elsif ($u =~ /\s*__cpp/) {

   317 		return $u;

   318 	} elsif (grep /^$metau/, @knownLabels) {

   319 		return $u;

   320 	} else {

   321 		return "__cpp($u)";

   322 	}

   323 }

   324 

   325 sub RegisterSymbol($)

   326 {

   327 	my ($sym) = @_;

   328 	return 1 if ($sym =~ /^r1[0-5]\s*$/i);

   329 	return 1 if ($sym =~ /^r[0-9]\s*$/i);

   330 	return 1 if ($sym =~ /^lr\s*$/i);

   331 	return 1 if ($sym =~ /^pc\s*$/i);

   332 	return 1 if ($sym =~ /^ip\s*$/i);

   333 	return 1 if ($sym =~ /^sp\s*$/i);

   334 	return 0;

   335 }	

   336 

   337 

   338 sub NeedsImporting($)

   339 {

   340 	my ($sym) = @_;

   341 	return 0 if ($sym =~ /\s*0x/i );

   342 	return 0 if ($sym =~ /^\s*0\s*/ );

   343 	return 0 if ($sym =~ /^\s*\d+\s*/ );

   344 	return 0 if ($sym =~ /\s*\(/ );

   345 	return 0 if ($sym =~ /\s*__cpp\(/ );

   346 	return 0 if RegisterSymbol($sym);

   347 

   348 	my $unms = Unmangle($sym);

   349 	my $pat = quotemeta($unms);

   350 	unless ($sym =~ /$pat/) {

   351 		return 0;

   352 	}

   353 	if (($sym =~ /(\w*)/) && (grep /^$1/, @knownLabels) ) {

   354 		return 0;

   355 	} else {

   356 		return 1;

   357 	}

   358 }

   359 	

   360 sub MaybeImportArgs($)

   361 {

   362 	my ($args) = @_;

   363 	my $arg;

   364 	foreach $arg (split /\,/, $args) {

   365 		MaybeEmitImport($arg);

   366 	}

   367 }

   368 sub GetInputConstraint($$$)

   369 {

   370     # It would have been nice if we could have used split to get at the constraints

   371     # but we can't coz ':' can obviously appear as part of a qualified name. So we have to do it

   372     # by hand.

   373 

   374     my ($constraints, $index, $noError) = @_;

   375     # assume constraints look like " : output : input [: sideffects"]

   376     my $i1 = index($constraints, ":"); # output field after this index

   377     Croak("unrecognized contraints format: $constraints\n") if (!$noError and $i1 < 0);

   378     my $i2 = index($constraints, ":", $i1 + 1); # input field after this index

   379     Croak("unrecognized contraints format: $constraints\n") if !$noError and $i2 < 0;

   380 

   381     Croak("can't deal with output constraints: $constraints\n") 

   382 		if !$noError and (substr($constraints, $i1 + 1, $i2 - $i1 - 1) =~ /\S+/);

   383 

   384     Croak("can't deal with side effect constraints: $constraints\n") 

   385 		if (substr($constraints, $i2 + 1) =~ /(\s*\".+\".*\(.*\))\s*\:+/);

   386 

   387     if ($i2 > 0 

   388 		and (length($constraints) - 1) > $i2 

   389 		and substr($constraints, $i2 + 1) =~ /(\s*\".+\".*\(.*\S+.*\))\s*\:*/) {

   390         return $1;

   391     } else {

   392 		return 0;

   393     }

   394 }

   395 

   396 sub GetOutputConstraint($$)

   397 {

   398     # It would have been nice if we could have used split to get at the constraints

   399     # but we can't coz ':' can obviously appear as part of a qualified name. So we have to do it

   400     # by hand.

   401     my ($constraints, $index) = @_;

   402     # assume constraints look like " : output : input [: sideffects"]

   403     my $i1 = index($constraints, ":"); # output field after this index

   404     my $i2 = index($constraints, ":", $i1 + 1); # output field after this index

   405 

   406 	if ($i2 != -1) {

   407 		if ( substr($constraints, $i1 + 1, $i2 - $i1 - 1) =~ /\s*(\".*\"\s*\S*.*\))\s*\:*/) {

   408 			return $1;

   409 		} else {

   410 			return 0;

   411 		}

   412 	} elsif ( substr($constraints, $i1 + 1) =~ /\s*(\".*\"\s*\S*.*\))\s*\:*/) {

   413 		return $1;

   414     } else {

   415 		return 0;

   416     }

   417 }

   418 

   419 # NB: assumes no mangled symbols in constraint expr.

   420 sub CppExprFromConstraint ($)

   421 {

   422     my ($constraints) = @_;

   423 	return $constraints if ($constraints =~ /\s*__cpp/);

   424     my $inputExpr;

   425     if ($constraints =~ /\s*\".*\"\s+(.*)/) {

   426 		$inputExpr = $1;

   427     } else {

   428 		Croak( "Unrecognized constraint pattern @ $lineno: $constraints");

   429     }

   430 

   431     unless ($inputExpr =~ /^\(/) {

   432 		$inputExpr = "($inputExpr)";

   433     }

   434 

   435     my $result = "__cpp$inputExpr";

   436 

   437     return $result;

   438 }

   439 

   440 sub TranslateConstrainedInputAsmDefault ($$$$)

   441 {

   442     my ($original, $asm, $constraints, $comment) = @_;

   443 

   444     # we make some gross assumptions here which appear to hold for the majority of 

   445     # our code base namely:

   446     # 1. there is normally only one input operand and 

   447     # 2. it is named 'a0'

   448     # This allows us to carry out the simple minded substitution seen below.

   449     my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));

   450 

   451     $asm =~ s/\%a0/$cppExpr0/;

   452     if ($asm =~ /(\w+)\s+(\S+)\s*\,\s*(.+)\s*,?(.+)?/) {

   453 	PrintCheck();

   454 	EmitOriginal($original, "TranslateConstrainedInputAsmDefault");

   455 	EmitAsm($1, $2, $3, $4, $comment);

   456     } else {

   457 	UnrecognisedAsmWarning("TranslateConstrainedInputAsmDefault", $original);

   458     }

   459 }

   460 

   461 sub TranslateAsmDefault ($$$$)

   462 {

   463     my ($original, $asm, $constraints, $comment) = @_;

   464     if ($constraints) {

   465 		TranslateConstrainedInputAsmDefault($original, $asm, $constraints, $comment);

   466     } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)\s*,?(.+)?/) {

   467 		my $opcode = uc $1;

   468 		my $op1 = $2;

   469 		my $op2 = $3;

   470 		my $op3 = $4;

   471 		# deal with hand introduced labels that correspond to a mangled C++ name

   472 		if ($op2 =~ /\s*\[[^\,]+\,\s*\#([^\-]+)/) {

   473 			my $adr = $1;

   474 			my $pattern = quotemeta($adr);

   475 			my $unmangledAdr = Unmangle($adr);

   476 			$op2 =~ s/$adr/$unmangledAdr/i unless $unmangledAdr =~ /$pattern/;

   477 		}

   478 		if ($opcode =~ /ldr/i) {

   479 			if ($op2 =~ /^(\d+)([fFbB])/) {

   480 				my $id = $1;

   481 				my $dir = uc $2;

   482 				$op2 = "%$dir$id";

   483 			} 

   484 		}

   485 		# rename obsolete shift ASL -> LSL

   486 		if ($op3 =~ /([^\,]*)\,\s*asl (.*)/i) {

   487 			$op3 = "$1, lsl $2";

   488 		}

   489 		# deal with the likes of #___2PP.KernCSLocked-.-8

   490 		if ($op3 =~ /([^\-\s]\.[^\s\-])/ ) {

   491 			my $s = "$1";

   492 			my $p = quotemeta($1);

   493 			$s =~ s/\./\_/;

   494 			$op3 =~ s/$p/$s/;

   495 		}

   496 		PrintCheck();

   497 		EmitOriginal ($original, "TranslateAsmDefault");

   498 		EmitAsm($opcode, $op1, $op2, $op3, $comment);

   499     } else {

   500 		UnrecognisedAsmWarning("TranslateAsmDefault", $original);

   501     }

   502 }

   503 

   504 

   505 # Work around 'feature' in embedded assembler stemming from the fact that

   506 # 'and' is both asm and a C++ keyword.

   507 sub TranslateConstrainedAnd ($$$$)

   508 {

   509     my ($original, $asm, $constraints, $comment) = @_;

   510 

   511     # we make some gross assumptions here which appear to hold for the majority of 

   512     # our code base namely:

   513     # 1. there is normally only one input operand and 

   514     # 2. it is named 'a0'

   515     # This allows us to carry out the simple minded substitution seen below.

   516     my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));

   517 

   518 	$asm =~ s/\%a0/$cppExpr0/;

   519     if ($asm =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {

   520 	my $opcode = uc $1;

   521 	my $op1 = $2;

   522 	my $op2 = $3;

   523 	my $op3 = $4;

   524 		# rename obsolete shift ASL -> LSL

   525 		if ($op3 =~ /([^\,]*)\,\s*asl (.*)/) {

   526 			$op3 = "$1, lsl $2";

   527 		}

   528 		PrintCheck();

   529 		EmitOriginal ($original, "TranslateConstrainedAnd");

   530 

   531 		printf "\t$opcode $op1, $op2";

   532 		printf ", $op3" if $op3;

   533 		PrintComment($comment);

   534 		Nl();

   535     } else {

   536 	UnrecognisedAsmWarning("TranslateConstrainedAnd", $original);

   537     }

   538 }

   539 

   540 sub TranslateAnd ($$$$)

   541 {

   542     my ($original, $asm, $constraints, $comment) = @_;

   543     if ($constraints) {

   544 		TranslateConstrainedAnd($original, $asm, $constraints, $comment);

   545     } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)\s*,?(.+)?/) {

   546 		my $opcode = uc $1;

   547 		my $op1 = $2;

   548 		my $op2 = $3;

   549 		my $op3 = $4;

   550 		# rename obsolete shift ASL -> LSL

   551 		if ($op3 =~ /([^\,]*)\,\s*asl (.*)/) {

   552 			$op3 = "$1, lsl $2";

   553 		}

   554 		PrintCheck();

   555 		EmitOriginal ($original, "TranslateAnd");

   556 

   557 		printf "\t$opcode $op1, $op2";

   558 		printf ", $op3" if $op3;

   559 		PrintComment($comment);

   560 		Nl();

   561     } else {

   562 		UnrecognisedAsmWarning("TranslateAnd", $original);

   563     }

   564 }

   565 

   566 

   567 # based on TranslateConstrainedInputAsmDefault

   568 sub TranslateConstrainedCoprocessorInsn ($$$$)

   569 {

   570     my ($original, $asm, $constraints, $comment) = @_;

   571 

   572     # we make some gross assumptions here which appear to hold for the majority of 

   573     # our code base namely:

   574     # 1. there is normally only one input operand and 

   575     # 2. it is named 'a0'

   576     # This allows us to carry out the simple minded substitution seen below.

   577     my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));

   578 

   579 	$asm =~ s/\%a0/$cppExpr0/;

   580     if ($asm =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {

   581 	my $opcode = $1;

   582 	my $coproc = lc $2;

   583 	my $op1 = $3;

   584 	my $op2 = $4;

   585 	$coproc = "p$coproc" unless $coproc =~ /^p.+/;

   586 	PrintCheck();

   587 	EmitOriginal($original, "TranslateConstrainedCoprocessorInsn");

   588 	EmitAsm($opcode, $coproc, $op1, $op2, $comment);

   589     } else {

   590 	UnrecognisedAsmWarning("TranslateConstrainedCoprocessorInsn", $original);

   591     }

   592 }

   593 

   594 # based on TranslateAsmDefault

   595 sub TranslateCoprocessorInsn ($$$$)

   596 {

   597     my ($original, $asm, $constraints, $comment) = @_;

   598     if ($constraints) {

   599 	TranslateConstrainedCoprocessorInsn($original, $asm, $constraints, $comment);

   600     } elsif (@_[1] =~ /(\w+)\s+(.+)\s*\,\s*(.+)\s*,?(.+)?/) {

   601 	my $opcode = $1;

   602 	my $coproc = lc $2;

   603 	my $op1 = $3;

   604 	my $op2 = $4;

   605 	$coproc = "p$coproc" unless $coproc =~ /^p.+/;

   606 	PrintCheck();

   607 	EmitOriginal ($original, "TranslateCoprocessorInsn");

   608 	EmitAsm($opcode, $coproc, $op1, $op2, $comment);

   609     } else {

   610 	UnrecognisedAsmWarning("TranslateCoprocessorInsn", $original);

   611     }

   612 }

   613 

   614 sub TranslateConstrainedSWI ($$$$)

   615 {

   616     my ($original, $asm, $constraints, $comment) = @_;

   617 

   618     # we make some gross assumptions here which appear to hold for the majority of 

   619     # our code base namely:

   620     # 1. there is normally only one input operand and 

   621     # 2. it is named 'a0'

   622     # This allows us to carry out the simple minded substitution seen below.

   623     my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));

   624 

   625 	$asm =~ s/\%a0/$cppExpr0/;

   626     if ($asm =~ /(\w+)\s+(.+)/) {

   627 	my $opcode = $1;

   628 	my $op1 = $2;

   629 	PrintCheck();

   630 	EmitOriginal($original, "TranslateConstrainedSWI");

   631 	$opcode = RequiredCase($opcode);

   632     printf "\t$opcode $op1";

   633     PrintComment($comment);

   634     Nl();

   635     } else {

   636 	UnrecognisedAsmWarning("TranslateConstrainedSWI", $original);

   637     }

   638 }

   639 

   640 sub TranslateSWI ($$$$)

   641 {

   642     my ($original, $asm, $constraints, $comment) = @_;

   643     if ($constraints) {

   644 		TranslateConstrainedSWI($original, $asm, $constraints, $comment);

   645     } elsif (@_[1] =~ /(\w+)\s+(.+)/) {

   646 	my $opcode = $1;

   647 	my $op1 = $2;

   648 	PrintCheck();

   649 	EmitOriginal ($original, "TranslateSWI");

   650 	$opcode = RequiredCase($opcode);

   651     printf "\t$opcode $op1";

   652     PrintComment($comment);

   653     Nl();

   654     } else {

   655 	UnrecognisedAsmWarning("TranslateSWI", $original);

   656     }

   657 }

   658 

   659 

   660 sub TranslateLabel ($$$$)

   661 {

   662     my ($original, $asm, $constraints, $comment) = @_;

   663 	if ( $asm =~ /\s*(\S+)\:/) {

   664 		my $label = $1;

   665 		$label = Unmangle($label) unless ($label =~ /^(\d+)/);

   666 		SimpleEmit($original, $label, "TranslateLabel", $comment);

   667     } else { 

   668 		UnrecognisedAsmWarning("TranslateLabel", $original);

   669     }

   670 }

   671 

   672 sub TranslateConstrainedAdr ($$$$)

   673 {

   674     my ($original, $asm, $constraints, $comment) = @_;

   675 

   676     # we make some gross assumptions here which appear to hold for the majority of 

   677     # our code base namely:

   678     # 1. there is normally only one input operand and 

   679     # 2. it is named 'a0'

   680     # This allows us to carry out the simple minded substitution seen below.

   681     my $cppExpr0 = CppExprFromConstraint(GetInputConstraint($constraints, 0, 0));

   682 

   683     $asm =~ s/\%a0/$cppExpr0/;

   684     if ($asm =~ /(\w+)\s+(\S+)\s*\,\s*(.+)\s*,?(.+)?/) {

   685 	PrintCheck();

   686 	EmitOriginal($original, "TranslateConstrainedAdr");

   687 	EmitAsm($1, $2, $3, $4, $comment);

   688     } else {

   689 	UnrecognisedAsmWarning("TranslateConstrainedAdr", $original);

   690     }

   691 }

   692 

   693 sub TranslateAdr ($$$$)

   694 {

   695     my ($original, $asm, $constraints, $comment) = @_;

   696     if ($constraints) {

   697 		TranslateConstrainedAdr($original, $asm, $constraints, $comment);

   698     } elsif (@_[1] =~ /(\w+)\s+([^\,]+)\s*\,\s*([^\,]+)/) {

   699 		my $opcode = uc $1;

   700 		my $op1 = $2;

   701 		my $eadr = $3;

   702 		my $op3;

   703 		

   704 		if ($eadr =~ /^(\d+)([fFbB])/) {

   705 				my $id = $1;

   706 				my $dir = uc $2;

   707 				$eadr = "%$dir$id";

   708 		} else {

   709 			my $unmangledEadr = Unmangle($eadr);

   710 			my $pattern = quotemeta($eadr);

   711 			$eadr = "__cpp($unmangledEadr)" unless $unmangledEadr =~ /$pattern/;

   712 		}

   713 		MaybeEmitImport($eadr);

   714 		PrintCheck();

   715 		EmitOriginal ($original, "TranslateAdr");

   716 		EmitAsm($opcode, $op1, $eadr, $op3, $comment);

   717     } else {

   718 		UnrecognisedAsmWarning("TranslateAdr", $original);

   719     }

   720 }

   721 

   722 sub RequiredCase($)

   723 {

   724 	my ($s) = @_;

   725 	lc $s;

   726 }

   727 

   728 sub TranslateAlign ($$$$)

   729 {

   730     my ($original, $asm, $constraints, $comment) = @_;

   731     if ( $asm =~ /\s*\.align\s+(\S+)/i) {

   732 		my $alignment = $1;

   733 		my $boundary = "1:SHL:$1";

   734 #		my $boundary = "";

   735 		my $boundary = "" if ($alignment =~ /\s*0\s*/);

   736 		

   737 		my $directive = RequiredCase("ALIGN");

   738 		SimpleEmit($original, "\t$directive $boundary", "TranslateAlign", $comment);

   739     }

   740     else { 

   741 		UnrecognisedAsmWarning("TranslateAlign", $original);

   742     }

   743 }

   744 

   745 sub TranslateSpace ($$$$)

   746 {

   747     my ($original, $asm, $constraints, $comment) = @_;

   748     if ( $asm =~ /\s*\.space\s+(\S+)/i) {

   749 		my $directive = RequiredCase("SPACE");

   750 		SimpleEmit($original, "\t$directive $1", "TranslateSpace", $comment);

   751     }

   752     else { 

   753 		UnrecognisedAsmWarning("TranslateSpace", $original);

   754     }

   755 }

   756 

   757 sub TranslateByte ($$$$)

   758 {

   759     my ($original, $asm, $constraints, $comment) = @_;

   760 	my $directive = RequiredCase("DCB");

   761 	$asm =~ /\s*.byte\s+(.*)/i;

   762 	my $args = $1;

   763 	if ($constraints) {

   764 		$args = TranslateConstrainedArgs($args, $constraints);

   765 		SimpleEmit($original, "\t$directive $args", "TranslateByte", $comment);

   766 	} else {

   767 		MaybeImportArgs($args);

   768 		SimpleEmit($original, "\t$directive $args", "TranslateByte", $comment);

   769 	}

   770 }

   771 

   772 sub CppExprList($)

   773 {

   774     my ($arg) = @_;

   775 	return $arg if ($arg =~ /\s*__cpp/);

   776 

   777     if ($arg =~ /(.*)\,\s*([^\s]*)/) {

   778 		my $result = CppExprList($1);

   779 		my $expr = $2;

   780 		if ($expr =~ /\s*0x\d+/) {

   781 			return $result .= ", __cpp($expr)";

   782 		} elsif ($expr =~ /\s*(\d+)/) {

   783 			my $hex = sprintf("%#.8x", $1);

   784 			return $result .= ", __cpp($hex)";

   785 		} else {

   786 			my $pattern = quotemeta($expr);

   787 			my $unmangledExpr = Unmangle($expr);

   788 			return ($unmangledExpr =~ /$pattern/) ? $expr : "__cpp(\&$unmangledExpr)";

   789 		}

   790     } else {

   791 		if ($arg =~ /\s*0x\d+/) {

   792 			return " __cpp($arg)";

   793 		} elsif ($arg =~ /\s*(\d+)/) {

   794 			my $hex = sprintf("%#.8x", $1);

   795 			return " __cpp($hex)";

   796 		} else {

   797 			if ($arg =~ /\s*([^\s]*)/) {

   798 				$arg = $1;

   799 				my $pattern = quotemeta($arg);

   800 				my $unmangledArg = Unmangle($arg);

   801 				return ($unmangledArg =~ /$pattern/) ? $arg : "__cpp(\&$unmangledArg)";

   802 			}

   803 		}

   804     }

   805 }

   806 

   807 # Add symbols here that aren't imported if they're 'special'.

   808 my %recognizedSymbols = 

   809 	(

   810 	 Followers => 1,

   811 	 TheScheduler => 1,

   812 	 TheMonitor => 1,

   813 	 MonitorStack => 1,

   814 	 ServerAccept => 1,

   815 	 ServerReceive => 1,

   816 	 wordmove => 1,

   817 	 memcpy => 1,

   818 	 memcompare => 1,

   819 	 memclr => 1,

   820 	 memset => 1,

   821 	 memmove => 1,

   822 	 );

   823 

   824 sub EmitRecognizedSymbol ($$$$)

   825 {

   826 	my ($original, $directive, $sym, $comment) = @_;

   827 	return 0 if ($sym =~ /\s*0x/i );

   828 	return 0 if ($sym =~ /^\s*0\s*/ );

   829 	return 0 if ($sym =~ /^\s*\d+\s*/ );

   830 	return 0 if ($sym =~ /\s*__cpp\(/ );

   831 	my $unms = Unmangle($sym);

   832 	my $pat = quotemeta($unms);

   833 	unless ($sym =~ /$pat/) {

   834 		SimpleEmit($original, "\t$directive __cpp($unms)", "TranslateWord", $comment);

   835 		return 1;

   836 	}

   837 	if (($sym =~ /(\S*)/) && !(grep /^$1$/, @knownLabels) ) {

   838 		SimpleEmit($original, "\timport $sym", "TranslateWord", "// added by Tranasm");

   839 		AssertSourceFile();

   840 		SimpleEmit($original, "\t$directive $sym", "TranslateWord", $comment);

   841 		return 1;

   842 	} else {

   843 		return 0;

   844 	}

   845 }

   846 

   847 sub TranslateWord ($$$$)

   848 {

   849     my ($original, $asm, $constraints, $comment) = @_;

   850 	my $directive = RequiredCase("DCD");

   851 	$asm =~ /\s*.word\s+(.*)/i;

   852 	my $args = $1;

   853 	if ($constraints) {

   854 		$args = TranslateConstrainedArgs($args, $constraints);

   855 		SimpleEmit($original, "\t$directive $args", "TranslateWord", $comment);

   856 	} else {

   857 		MaybeImportArgs($args);

   858 		SimpleEmit($original, "\t$directive $args", "TranslateWord", $comment);

   859 	}

   860 }

   861 

   862 sub TranslateCode ($$$$)

   863 {

   864     my ($original, $asm, $constraints, $comment) = @_;

   865 	my $directive = RequiredCase("CODE");

   866     if ( $asm =~ /\s*\.code\s+(\d+)\s*/i) {

   867 		SimpleEmit($original, "\t$directive$1", "TranslateCode", $comment);

   868     }

   869     else { 

   870 		UnrecognisedAsmWarning("TranslateCode", $original);

   871     }

   872 }

   873 

   874 sub TranslateGlobal ($$$$)

   875 {

   876     my ($original, $asm, $constraints, $comment) = @_;

   877 	my $directive = RequiredCase("EXPORT");

   878     if ( $asm =~ /\s*\.global\s+(\S+)/i) {

   879 		SimpleEmit($original, "\t$directive $1", "TranslateGlobal", $comment);

   880     }

   881     else { 

   882 		UnrecognisedAsmWarning("TranslateGlobal", $original);

   883     }

   884 }

   885 

   886 sub TranslateExtern ($$$$)

   887 {

   888     my ($original, $asm, $constraints, $comment) = @_;

   889 	my $directive = RequiredCase("IMPORT");

   890     if ( $asm =~ /\s*\.extern\s+(\S+)/i) {

   891 		SimpleEmit($original, "\t$directive $1", "TranslateExtern", $comment);

   892     }

   893     else { 

   894 		UnrecognisedAsmWarning("TranslateExtern", $original);

   895     }

   896 }

   897 

   898 sub TranslateNop ($$$$)

   899 {

   900     my ($original, $asm, $constraints, $comment) = @_;

   901 	my $directive = RequiredCase("NOP");

   902     SimpleEmit($original, "\t$directive", "TranslateNop", $comment);

   903 }

   904 

   905 sub EmitAsm($$$$$)

   906 {

   907 	my ($opcode, $op1, $op2, $op3, $comment) = @_;

   908 	$opcode = RequiredCase($opcode);

   909     printf "\t%s %s, %s", $opcode, $op1, $op2;

   910     printf(", %s", $op3) if $op3;

   911     PrintComment($comment);

   912     Nl();

   913 }

   914 

   915 sub TranslateBranchDefault ($$$$)

   916 {

   917     my ($original, $asm, $constraints, $comment) = @_;    

   918 	if ($constraints) {

   919 		Croak( "TranslateBranchDefault can't deal with Constraint instructions\n E.G. - $original");

   920 	} elsif ($asm =~ /(\w+)\s+(.+)\s*$/) {

   921 		my $opcode = RequiredCase($1);

   922 		my $target = $2;

   923 

   924 		if ($target =~ /^(\d+)([fFbB])/) {

   925 			my $id = $1;

   926 			my $dir = uc $2;

   927 			$target = "%$dir$id";

   928 		} else {

   929 			my $unmangledTarget = Unmangle($target);

   930 			my $pattern = quotemeta($target);

   931 			$target = "__cpp($unmangledTarget)" unless $unmangledTarget =~ /$pattern/;

   932 		}

   933 		EmitOriginal ($original, "TranslateBranchDefault");

   934 		MaybeEmitImport($target);

   935 		printf("\t%s %s", $opcode, $target);

   936 		PrintComment($comment);

   937 		Nl();

   938     } else {

   939 		UnrecognisedAsmWarning("TranslateBranchDefault", $original);

   940     }

   941 }

   942 

   943 sub TranslatePushPop ($$$$)

   944 {

   945     my ($original, $asm, $constraints, $comment) = @_;    

   946     if ($asm =~ /(\w+)\s+(.+)\s*$/) {

   947 		my $opcode = RequiredCase($1);

   948 		my $registers = $2;

   949 

   950 		if ($constraints) {

   951 			Croak( "TranslatePushPop can't deal with constrained instructions\n E.G. - $original\n");

   952 		} else {

   953 			EmitOriginal ($original, "TranslatePushPop");

   954 			printf "\t$opcode $registers";

   955 			PrintComment($comment);

   956 			Nl();

   957 		}

   958     }

   959     else {

   960 		UnrecognisedAsmWarning("TranslatePushPop", $comment);

   961     }

   962 }

   963 

   964 sub TranslateConstrainedAsmDefault ($$$$)

   965 {

   966     # Here we assume:

   967     # 1. at most one output constraint

   968     # 2. the output constraint is named '%0'

   969     # 3. at most one input constraint

   970     # 4. the input constraint is named '%a0'

   971 

   972     my ($original, $asm, $constraints, $comment) = @_;    

   973 	my $outputConstraint;

   974     my $inputConstraint;

   975     if ($outputConstraint = GetOutputConstraint($constraints, 0)) {

   976 		my $outputCppExpr = CppExprFromConstraint($outputConstraint);

   977 		$asm =~ s/\%0/$outputCppExpr/;

   978     }

   979     if ($inputConstraint = GetInputConstraint($constraints, 0, 1)) {

   980 		my $inputCppExpr = CppExprFromConstraint($inputConstraint);

   981 		$asm =~ s/\%a0/$inputCppExpr/;

   982     }

   983     if ($asm =~ /^\s*(\w+)\s+([^\,]+)\s*\,\s*(.+)\s*,?(.+)?/) {

   984 		my $opcode = uc $1;

   985 		my $op1 = $2;

   986 		my $op2 = $3;

   987 		my $op3 = $4;

   988 		if ($outputConstraint) {

   989 			printf "\t>>> CHECK THIS - output constraints need special attention <<<\n";

   990 		} else {

   991 			PrintCheck();

   992 		}

   993 		EmitOriginal($original, "TranslateConstrainedAsmDefault");

   994 		$op1 =~ s/cpsr_flg/cpsr_f/i;

   995 		$op2 =~ s/asl /lsl /i if $op2;

   996 		$op3 =~ s/asl /lsl /i if $op3;

   997 		EmitAsm($opcode, $op1, $op2, $op3, $comment);

   998     } else {

   999 		UnrecognisedAsmWarning("TranslateConstrainedAsmDefault", $original);

  1000     }

  1001 }

  1002 

  1003 sub TranslatePotentialOutputConstrainedAsm ($$$$)

  1004 {

  1005 	

  1006     my ($original, $asm, $constraints, $comment) = @_;

  1007 

  1008     if ($constraints) {

  1009 		TranslateConstrainedAsmDefault($original, $asm, $constraints, $comment);

  1010     } elsif ($asm =~ /(\w+)\s+([^\,]+)\s*\,\s*(.+)\s*,?(.+)?/) {

  1011 		my $opcode = uc $1;

  1012 		my $op1 = $2;

  1013 		my $op2 = $3;

  1014 		my $op3 = $4;

  1015 		PrintCheck();

  1016 		EmitOriginal ($original, "TranslatePotentialOutputConstrainedAsm");

  1017 

  1018 		# MSR cpsr,...

  1019 		$op1 .= "_cxsf" if ($opcode =~ /msr/i and $op1 =~ /[cs]psr\s*$/);

  1020 		$op1 =~ s/cpsr_flg/cpsr_f/i;

  1021 		$op2 =~ s/asl /lsl /i if $op2;

  1022 		$op3 =~ s/asl /lsl /i if $op3;

  1023 		EmitAsm($opcode, $op1, $op2, $op3, $comment);

  1024     } else {

  1025 		UnrecognisedAsmWarning("TranslatePotentialOutputConstrainedAsm", $original);

  1026     }

  1027 }

  1028 

  1029 

  1030 # Here's the table of translator functions

  1031 my %opcodeTranslatorMapping = 

  1032 	(

  1033 	 "LABEL:"=>\&TranslateLabel,

  1034 

  1035 	 ".ALIGN"=>\&TranslateAlign,

  1036 	 ".BSS"=>\&EmitUnimplementedOpcode,

  1037 	 ".BYTE"=>\&TranslateByte,

  1038 	 ".CODE"=>\&TranslateCode,

  1039 	 ".DATA"=>\&EmitUnimplementedOpcode,

  1040 	 ".GLOBAL"=>\&TranslateGlobal,

  1041 	 ".EXTERN"=>\&TranslateExtern,

  1042 	 ".HWORD"=>\&EmitUnimplementedOpcode,

  1043 	 ".LONG"=>\&EmitUnimplementedOpcode,

  1044 	 ".SECTION"=>\&EmitUnimplementedOpcode,

  1045 	 ".SPACE"=>\&TranslateSpace,

  1046 	 ".TEXT"=>\&EmitUnimplementedOpcode,

  1047 	 ".WORD"=>\&TranslateWord,

  1048 	 "ADC"=>\&TranslateAsmDefault,

  1049 	 "ADD"=>\&TranslateAsmDefault,

  1050 	 "ADR"=>\&TranslateAdr,

  1051 	 "AND"=>\&TranslateAnd,

  1052 

  1053 	 "B"=>\&TranslateBranchDefault,

  1054 	 "BEQ"=>\&TranslateBranchDefault,

  1055 	 "BNE"=>\&TranslateBranchDefault,

  1056 	 "BHS"=>\&TranslateBranchDefault,

  1057 	 "BCS"=>\&TranslateBranchDefault,

  1058 	 "BCC"=>\&TranslateBranchDefault,

  1059 	 "BLO"=>\&TranslateBranchDefault,

  1060 	 "BMI"=>\&TranslateBranchDefault,

  1061 	 "BPL"=>\&TranslateBranchDefault,

  1062 	 "BVS"=>\&TranslateBranchDefault,

  1063 	 "BVC"=>\&TranslateBranchDefault,

  1064 	 "BHI"=>\&TranslateBranchDefault,

  1065 	 "BLS"=>\&TranslateBranchDefault,

  1066 	 "BGE"=>\&TranslateBranchDefault,

  1067 	 "BLT"=>\&TranslateBranchDefault,

  1068 	 "BGT"=>\&TranslateBranchDefault,

  1069 	 "BLE"=>\&TranslateBranchDefault,

  1070 	 "BCLR"=>\&TranslateBranchDefault,

  1071 	 "BIC"=>\&TranslateAsmDefault,

  1072 	 "BKPT"=>\&TranslateBranchDefault, # not really a branch but can reuse translator

  1073 

  1074 	 "BL"=>\&TranslateBranchDefault,

  1075 	 "BLEQ"=>\&TranslateBranchDefault,

  1076 	 "BLNE"=>\&TranslateBranchDefault,

  1077 	 "BLHS"=>\&TranslateBranchDefault,

  1078 	 "BLCS"=>\&TranslateBranchDefault,

  1079 	 "BLCC"=>\&TranslateBranchDefault,

  1080 	 "BLLO"=>\&TranslateBranchDefault,

  1081 	 "BLMI"=>\&TranslateBranchDefault,

  1082 	 "BLPL"=>\&TranslateBranchDefault,

  1083 	 "BLVS"=>\&TranslateBranchDefault,

  1084 	 "BLVC"=>\&TranslateBranchDefault,

  1085 	 "BLHI"=>\&TranslateBranchDefault,

  1086 	 "BLLS"=>\&TranslateBranchDefault,

  1087 	 "BLGE"=>\&TranslateBranchDefault,

  1088 	 "BLLT"=>\&TranslateBranchDefault,

  1089 	 "BLGT"=>\&TranslateBranchDefault,

  1090 	 "BLLE"=>\&TranslateBranchDefault,

  1091 

  1092 	 "BLX"=>\&TranslateBranchDefault,

  1093 	 "BLXEQ"=>\&TranslateBranchDefault,

  1094 	 "BLXNE"=>\&TranslateBranchDefault,

  1095 	 "BLXHS"=>\&TranslateBranchDefault,

  1096 	 "BLXCS"=>\&TranslateBranchDefault,

  1097 	 "BLXCC"=>\&TranslateBranchDefault,

  1098 	 "BLXLO"=>\&TranslateBranchDefault,

  1099 	 "BLXMI"=>\&TranslateBranchDefault,

  1100 	 "BLXPL"=>\&TranslateBranchDefault,

  1101 	 "BLXVS"=>\&TranslateBranchDefault,

  1102 	 "BLXVC"=>\&TranslateBranchDefault,

  1103 	 "BLXHI"=>\&TranslateBranchDefault,

  1104 	 "BLXLS"=>\&TranslateBranchDefault,

  1105 	 "BLXGE"=>\&TranslateBranchDefault,

  1106 	 "BLXLT"=>\&TranslateBranchDefault,

  1107 	 "BLXGT"=>\&TranslateBranchDefault,

  1108 	 "BLXLE"=>\&TranslateBranchDefault,

  1109 

  1110 	 "BSET"=>\&EmitUnimplementedOpcode,

  1111 

  1112 	 "BX"=>\&TranslateBranchDefault,

  1113 	 "BXEQ"=>\&TranslateBranchDefault,

  1114 	 "BXNE"=>\&TranslateBranchDefault,

  1115 	 "BXHS"=>\&TranslateBranchDefault,

  1116 	 "BXCS"=>\&TranslateBranchDefault,

  1117 	 "BXCC"=>\&TranslateBranchDefault,

  1118 	 "BXLO"=>\&TranslateBranchDefault,

  1119 	 "BXMI"=>\&TranslateBranchDefault,

  1120 	 "BXPL"=>\&TranslateBranchDefault,

  1121 	 "BXVS"=>\&TranslateBranchDefault,

  1122 	 "BXVC"=>\&TranslateBranchDefault,

  1123 	 "BXHI"=>\&TranslateBranchDefault,

  1124 	 "BXLS"=>\&TranslateBranchDefault,

  1125 	 "BXGE"=>\&TranslateBranchDefault,

  1126 	 "BXLT"=>\&TranslateBranchDefault,

  1127 	 "BXGT"=>\&TranslateBranchDefault,

  1128 	 "BXLE"=>\&TranslateBranchDefault,

  1129 	 "CDP"=>\&TranslateAsmDefault,

  1130 	 "CLZ"=>\&TranslateAsmDefault,

  1131 	 "CMN"=>\&TranslateAsmDefault,

  1132 	 "CMP"=>\&TranslateAsmDefault,

  1133 	 "EOR"=>\&TranslateAsmDefault,

  1134 	 "LDC"=>\&TranslateAsmDefault,

  1135 	 "LDM"=>\&TranslateAsmDefault,