1 #

     2 # Copyright (c) 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 the License "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 #!/usr/bin/perl

    18 

    19 use File::Find;

    20 use File::Spec::Functions;

    21 

    22 

    23 	my $TraceFileName;

    24 	

    25 	my $PrintFlagFilePos = 0;

    26 	my $PrintFlagHdrLen = 0;

    27 	my $PrintFlagHdrFlags = 0;

    28 	my $PrintFlagFormatString = 0;

    29 	my $VerboseMode = 0;

    30 	my $RawMode = 0;

    31 	my $FormatIdIsSubCategory = 0;

    32 	my $OutputSawDictionaryMode = 0;

    33 	

    34 	# for the category range 0-191, the format string is indexed by the category & subcategory

    35 	%FormatTables = 

    36 		(

    37 		0 => 			# ERDebugPrintf

    38 			{

    39 			0 => "ThreadId %h, %s",

    40 			},

    41 	

    42 		1 => 			# ERKernPrintf

    43 			{

    44 			0 => "ThreadId %h, %s",

    45 			},

    46 

    47 		3 =>			# EThreadIdentification

    48 			{	

    49 			0 => "ENanoThreadCreate, NThread %x",

    50 			1 => "ENanoThreadDestroy, NThread %x",

    51 			2 => "EThreadCreate, NThread %x, DProcess %x, name %s",

    52 			3 => "EThreadDestroy, NThread %x, DProcess %x, Id %x",

    53 			4 => "EThreadName, NThread %x, DProcess %x, name %s",

    54 			5 => "EProcessName, NThread %x, DProcess %x, name %s",

    55 			6 => "EThreadId, NThread %x, DProcess %x, Id %x",

    56 			7 => "EProcessCreate, DProcess %x",

    57 			8 => "EProcessDestroy, DProcess %x",

    58 			},

    59 		);

    60 

    61 	my @typedefs;

    62 	my @members;

    63 	my %values	= (

    64 #		UTF::KInitialClientFormat		=>	{type=>"TFormatId", size=>2, value=>512}

    65 		KMaxTUint8						=> {type=>"TUint8", size=>1, value=>255},

    66 		KMaxTUint16						=> {type=>"TUint16", size=>2, value=>65535}

    67 	);

    68 	my %macros;

    69 	my @classes;

    70 	my @enums;

    71 	my %formatStrings;		# each enum may have it's own format string

    72 	my %formatCategories;	# each enum may have it's own format category

    73 	

    74 	my %filescope;

    75 	$filescope{file}=1;

    76 	undef $filescope{name};	

    77 

    78 	$filescope{typedefs}=\@typedefs;

    79 	$filescope{members}=\@members;

    80 	$filescope{values}=\%values;

    81 	$filescope{macros} = \%macros;

    82 	$filescope{FormatTables} = \%FormatTables;

    83 	

    84 	$filescope{classes} = \@classes;

    85 	$filescope{enums} = \@enums;

    86 

    87 	$filescope{formatStrings} =\%formatStrings;

    88 	$filescope{formatCategories} = \%formatCategories;

    89 	

    90 		

    91 		

    92 	if (@ARGV == 0)

    93   		{

    94   		print "BTraceVw.pl \n";

    95   		print "An unsupported utility which extracts UTrace-style format-strings\n";

    96   		print "from header files & uses these to decode a BTrace output file\n";

    97   		print "Syntax : BTraceVw.pl [-v] [-r] [-sd] [-i <IncFilePath>] [<BTrace file>]\n";

    98   		print "where  : -v  = verbose mode\n";

    99   		print "       : -r  = raw output mode\n";

   100   		print "       : -sd = produce SAW trace viewer dictionary file\n";

   101   		print "       :       this file then needs to be merged into the 'com.symbian.analysis.trace.ui.prefs' file\n";

   102   		print "       :       located under the carbide workspace directory\n";

   103 		print "\n";

   104   		

   105 		print "e.g. (this decodes a trace file & produces a comma-separated output file) : \n";

   106 		print "btracevw.pl -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/f32tracedef.h -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/utraceefsrv.h -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/utraceefile.h trace.utf >trace.csv\n";

   107 		print "\n";

   108 		print "e.g. (this overwrites the SAW dictioany file) : \n";

   109 		print "btracevw.pl -sd -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/f32tracedef.h -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/utraceefsrv.h -i /os/kernelhwsrv/userlibandfileserver/fileserver/inc/utraceefile.h >com.symbian.analysis.trace.ui.prefs\n";

   110   		

   111 		exit;

   112 		}

   113 

   114 	while (@ARGV > 0)

   115 		{

   116 		

   117 		if ($ARGV[0] eq "-i")

   118 	        {

   119 	        shift @ARGV;

   120 		    ($FilePath) = @ARGV;

   121 	        shift @ARGV;

   122 

   123 	        undef @incFiles;

   124 		    @incFiles;

   125 		

   126 		    find sub { push @incFiles, $File::Find::name if m/\.h$/i;}, $FilePath ;

   127 		    foreach $incFile (@incFiles)

   128 		        {

   129 				H2Trace($incFile, \%filescope);

   130 		        }

   131 	        }

   132 		elsif ($ARGV[0] eq "-r")

   133 	        {

   134 		    $RawMode = 1;

   135    	        shift @ARGV;

   136 	        }

   137 		elsif ($ARGV[0] eq "-sd")

   138 	        {

   139 		    $OutputSawDictionaryMode = 1;

   140    	        shift @ARGV;

   141 	        }

   142 		elsif ($ARGV[0] eq "-v")

   143 	        {

   144 		    $VerboseMode = 1;

   145    	        shift @ARGV;

   146 	        }

   147 	    else

   148 	    	{

   149 			$TraceFileName = "$ARGV[0]";

   150 	        shift @ARGV;

   151 	    	}

   152         }

   153 		

   154 	if ($VerboseMode)

   155 		{

   156 		dump_scope(\%filescope);

   157 		PrintFormatTables(\%FormatTables);

   158 		}

   159 	if ($OutputSawDictionaryMode)

   160 		{

   161 		OutputSawDictionary(\%FormatTables);

   162 		}

   163 

   164     if (defined ($TraceFileName))

   165         {

   166         ReadTraceFile($RawMode);

   167         }

   168 

   169         

   170         

   171         

   172 sub ReadTraceFile($)

   173     {

   174 	(my $RawMode) = @_;

   175 #	print "Trace file is $TraceFileName, RawMode $RawMode, VerboseMode $VerboseMode\n\n";

   176 

   177 	open (LOGFILE, "<$TraceFileName") or die "Can't open $TraceFileName: $!\n";

   178 	binmode (LOGFILE);

   179 

   180 	my $val = 0;

   181 

   182 

   183 	# enum TFlags from e32btrace.h

   184 	$EHeader2Present	= 1<<0;

   185 	$ETimestampPresent	= 1<<1;

   186 	$ETimestamp2Present	= 1<<2;

   187 	$EContextIdPresent	= 1<<3;

   188 	$EPcPresent			= 1<<4;

   189 	$EExtraPresent		= 1<<5;

   190 	$ERecordTruncated	= 1<<6;

   191 	$EMissingRecord		= 1<<7;

   192 	

   193 	# enum TFlags2 from e32btrace.h

   194 	$EMultipartFlagMask	= 3<<0;

   195 	$ECpuIdMask			= 0xfff<<20;

   196 

   197 	# enum TMultiPart from e32btrace.h

   198 	$EMultipartFirst	= 1;

   199 	$EMultipartMiddle	= 2;

   200 	$EMultipartLast		= 3;

   201 	

   202 	$EMaxBTraceDataArray = 80;

   203 	

   204 	# enum TCategory from e32btrace.h

   205 	$EThreadIdentification = 3;

   206 	

   207 	# enum TThreadIdentification from e32btrace.h

   208 	$EThreadCreate = 2;

   209 	$EThreadName = 4;

   210 	$EProcessName = 5;

   211 	$EThreadId = 6;

   212 	

   213 	# Context Id bits from e32btrace.h

   214 	$EContextIdMask = 0x00000003;

   215 	$EContextIdThread = 0;

   216 	$EContextIdFIQ = 0x1;

   217 	$EContextIdIRQ = 0x2;

   218 	$EContextIdIDFC = 0x3;

   219 

   220 	# enum TClassificationRange from e32btraceu.h

   221 	$EAllRangeFirst = 192;

   222 	$EAllRangeLast = 222;

   223 

   224 	%TCategoryIdToString = 

   225 		(

   226 		0 => "ERDebugPrintf",

   227 		1 => "EKernPrintf",

   228 		2 => "EPlatsecPrintf",

   229 		3 => "EThreadIdentification",

   230 		4 => "ECpuUsage",

   231         5 => "EKernPerfLog",

   232         6 => "EClientServer",

   233         7 => "ERequests",

   234         8 => "EChunks",

   235         9 => "ECodeSegs",

   236 		10 => "EPaging",

   237 		11 => "EThreadPriority",

   238 		12 => "EPagingMedia",

   239 		13 => "EKernelMemory",

   240 		14 => "EHeap",

   241 		15 => "EMetaTrace",

   242 		16 => "ERamAllocator",

   243 		17 => "EFastMutex",

   244 		18 => "EProfiling", 

   245         19 => "EResourceManager",

   246         20 => "EResourceManagerUs",

   247 		21 => "ERawEvent ",

   248 		128 => "EPlatformSpecificFirst",

   249 		191 => "EPlatformSpecificLast",

   250 		192 => "ESymbianExtentionsFirst",

   251 

   252 		# UTrace "ALL" range 

   253 		192 => "EPanic",

   254 		193 => "EError",

   255 		194 => "EWarning", 

   256 		195 => "EBorder", 

   257 		196 => "EState", 

   258 		197 => "EInternals", 

   259 		198 => "EDump", 

   260 		199 => "EFlow", 

   261 		200 => "ESystemCharacteristicMetrics", 

   262 		201 => "EAdhoc",

   263 

   264 		253 => "ESymbianExtentionsLast",

   265 		254 => "ETest1",

   266 		255 => "ETest2",

   267 		);

   268 

   269 

   270 	%ProcessNames;

   271 	%ThreadNames;

   272 	%ThreadIds;

   273 	

   274 	

   275 	# print column titles

   276 	if ($PrintFlagFilePos) {printf "FilePos, ";}	# col #0

   277 	if ($PrintFlagHdrLen) {	printf "Len, ";}		# col #1

   278 	if ($PrintFlagHdrFlags) {printf "Flags, "; }	# col #2

   279 	printf "Category, ";			# col #3

   280 	printf "TimeStamp, ";			# col #4

   281 	printf "Delta, ";				# col #5

   282 	printf "context Id, ";			# col #6

   283 	printf "PC, ";					# col #7

   284 	printf "UID, ";					# col #8

   285 	if ($PrintFlagFormatString){printf "Format string, ";}	# col #9

   286 	printf "Formatted text, ";		# col #10

   287 	print "\n\n";

   288 

   289 	

   290 	while (1)

   291 		{

   292 		my $pos = tell (LOGFILE);

   293 		

   294 		# print file pos (col #0)

   295 		if ($PrintFlagFilePos){	printf ("0x%08X, ", $pos);}

   296 		

   297 		my $category;

   298 		my $subCategory;

   299 		my $multipartFlags = 0;

   300 		my $recordData = "";

   301 		my $recordLen;

   302 		my $recordPos = 0;

   303 		

   304 		$recordLen = ReadRecord(LOGFILE, \$pos, \$recordData, \$category, \$subCategory, \$multipartFlags, $RawMode);

   305 		if ($recordLen == -1)

   306 			{last;}

   307 

   308 			

   309 		if (!$RawMode && ($multipartFlags == $EMultipartMiddle || $multipartFlags == $EMultipartLast))

   310 			{next;}

   311 					

   312 #		print record contents

   313 #		my $buf;

   314 #					for (my $i=0; $i < $recordLen; $i+=4)

   315 #						{

   316 #		$buf.= sprintf ("%08X ", unpack("V", substr($recordData, $recordPos+$i, 4)));

   317 #						}

   318 #		printf "\n[$buf\n]";				

   319 

   320 

   321 		# for UTrace "ALL" range, read UID 

   322 		if ($category >= $EAllRangeFirst && $category <= $EAllRangeLast && 

   323 			(!$RawMode) && $multipartFlags != $EMultipartMiddle && $multipartFlags != $EMultipartLast)

   324 			{

   325 			$uid = unpack("V", substr($recordData, $recordPos, 4));

   326 			$recordPos+= 4;	

   327 

   328 			# then read formatID			

   329 			$FormatIdIsSubCategory = ($subCategory != 0) ? 1 : 0;

   330 			if ($FormatIdIsSubCategory)

   331 				{

   332 				$formatId = $subCategory

   333 				}

   334 			else				

   335 				{

   336 				$formatId = unpack("V", substr($recordData, $recordPos, 4));

   337   				$recordPos+= 4;

   338 				}

   339 			}

   340 		

   341 					

   342 		# print UID (col #8)

   343 		printf "0x%08X, ", $uid;

   344 

   345 			

   346 		my $formatTable;

   347 		my $formatString;

   348 		if ($category >= $EAllRangeFirst && $category <= $EAllRangeLast)

   349 			{

   350 			$formatString = $FormatTables{$uid}{$formatId};

   351 			}

   352 		else

   353 			{

   354 			$formatString = $FormatTables{$category}{$subCategory};

   355 			}

   356 

   357 

   358 		# Get thread names

   359 		if ($category == $EThreadIdentification)

   360 			{

   361 			if ($subCategory == $EProcessName)

   362 				{

   363 				my $process = unpack("V", substr($recordData, 4, 4));

   364 				my $processName = substr($recordData, 8, $recordLen - 8);	

   365 #				printf ("\nprocess [%08X] processName [$processName]\n", $process);

   366 				$ProcessNames{$process} = $processName;

   367 				}

   368 			elsif ($subCategory == $EThreadCreate || $subCategory == $EThreadName)

   369 				{

   370 				my $thread = unpack("V", substr($recordData, 0, 4));

   371 				my $process = unpack("V", substr($recordData, 4, 4));

   372 				my $threadName = substr($recordData, 8, $recordLen - 8);	

   373 #				printf ("\nprocess [%08X] thread [%08X] threadName [$threadName]\n", $process, $thread, $threadName);

   374 				$ThreadNames{$thread} = $ProcessNames{$process} . "::" . $threadName;

   375 				}

   376 			elsif ($subCategory == $EThreadId)

   377 				{

   378 				my $thread = unpack("V", substr($recordData, 0, 4));

   379 				my $process = unpack("V", substr($recordData, 4, 4));

   380 				my $threadId = unpack("V", substr($recordData, 8, 4));

   381 #				printf ("\nprocess [%08X] thread [%08X] threadId [%08X]\n", $process, $thread, $threadId);

   382 				$ThreadIds{$thread} = $threadId;

   383 				}

   384 			}

   385 			

   386 			

   387 		# print Format string (col #9)

   388 		if ($PrintFlagFormatString)

   389 			{

   390 			my $formatStringWithoutCommas = $formatString;

   391 			$formatStringWithoutCommas=~ s/,/ /g;

   392 			printf "%s, ", $formatStringWithoutCommas;

   393 			}

   394 

   395 		my $formattedText;

   396 		

   397 		my $lenFormatString = length($formatString);

   398 		if ($lenFormatString && !$RawMode && $multipartFlags != $EMultipartMiddle && $multipartFlags != $EMultipartLast)

   399 			{

   400 			for (my $i=0; $i<$lenFormatString; $i++)

   401 				{

   402 				my $c = (substr ($formatString, $i, 1));

   403 #				printf "$c\n";

   404 				if ($c eq "%")

   405 					{

   406 					undef my $fieldLen;

   407 					$i++;

   408 	        		$c = (substr ($formatString, $i, 1));

   409 					if ($c eq "%")

   410 						{

   411 						$formattedText.= substr ($formatString, $i, 1);

   412 						next;

   413 						}

   414 					if ($c eq "*")	## take length from buffer

   415 						{

   416 						$fieldLen = unpack("V", substr($recordData, $recordPos, 4));

   417 						if ($fieldLen > $recordLen-$recordPos)

   418 							{

   419 							$formattedText.= "*** Invalid field length ***";

   420 							last;

   421 							}

   422 						$recordPos+= 4;

   423 						$i++;

   424 		        		$c = (substr ($formatString, $i, 1));

   425 						}

   426 					if (lc $c eq "x" || $c eq "h")

   427 						{

   428 						if (defined $fieldLen)

   429 							{

   430 							if (($fieldLen & 3) == 0)

   431 								{

   432 								for (my $i=0; $i< $fieldLen; $i+= 4)

   433 									{

   434 									$formattedText.= sprintf ("%08X ", unpack("V", substr($recordData, $recordPos, 4)));

   435 									$recordPos+= 4;

   436 									}

   437 								}

   438 							else

   439 								{

   440 								for (my $i=0; $i< $fieldLen; $i++)

   441 									{

   442 									$formattedText.= sprintf ("%02X ", unpack("C", substr($recordData, $recordPos, 1)));

   443 									$recordPos++;

   444 									}

   445 								}

   446 							}

   447 						else

   448 							{

   449 							$formattedText.= sprintf ("0x%08X", unpack("V", substr($recordData, $recordPos, 4)));

   450 							$recordPos+= 4;

   451 							}

   452 						$recordPos = ($recordPos + 3) & ~3;

   453 						next;

   454 						}

   455 					# display "%ld" as hex for now as don't know how to get perl to use or display a 64 decimal value

   456 					elsif (lc $c eq "l" && substr ($formatString, $i+1, 1) eq "d")

   457 						{

   458 						$i++;

   459 						my $loWord = unpack("V", substr($recordData, $recordPos, 4));

   460 						$recordPos+= 4;

   461 						my $hiWord = unpack("V", substr($recordData, $recordPos, 4));

   462 						$recordPos+= 4;

   463 						$formattedText.= sprintf ("0x%X:%08X", $hiWord, $loWord);

   464 						}

   465 					elsif (lc $c eq "l" && substr ($formatString, $i+1, 1) eq "x")

   466 						{

   467 						$i++;

   468 						my $loWord = unpack("V", substr($recordData, $recordPos, 4));

   469 						$recordPos+= 4;

   470 						my $hiWord = unpack("V", substr($recordData, $recordPos, 4));

   471 						$recordPos+= 4;

   472 						$formattedText.= sprintf ("0x%X:%08X", $hiWord, $loWord);

   473 						}

   474 					elsif (lc $c eq "d")

   475 						{

   476 						$formattedText.= sprintf ("%d", unpack("V", substr($recordData, $recordPos, 4)));

   477 						$recordPos+= 4;

   478 						$recordPos = ($recordPos + 3) & ~3;

   479 						next;

   480 						}

   481 					elsif ($c eq "s")

   482 						{

   483 						if (!defined $fieldLen) 

   484 							{$fieldLen = $recordLen - $recordPos;}

   485 						$formattedText.= substr($recordData, $recordPos, $fieldLen);

   486 						$recordPos+= $fieldLen; 

   487 						$recordPos = ($recordPos + 3) & ~3;

   488 						next;

   489 						}

   490 					elsif ($c eq "S")

   491 						{

   492 						if (!defined $fieldLen) 

   493 							{$fieldLen = $recordLen-$recordPos;}

   494 						for (my $j=0; $j < $fieldLen; $j+=2)

   495 							{

   496 					        my $byte = unpack("c", substr ($recordData, $recordPos+$j, 1));

   497  							$formattedText.= sprintf ("%c", $byte);

   498 							}

   499 						$recordPos+= $fieldLen; 

   500 						$recordPos = ($recordPos + 3) & ~3;

   501 						next;

   502 						}

   503 					elsif ($c eq "c")

   504 						{

   505 				        my $byte = unpack("c", substr ($recordData, $recordPos, 1));

   506 						$formattedText.= sprintf ("%c", $byte);

   507 						}

   508 					}

   509 				else

   510 					{

   511 					$formattedText.= $c;

   512 					}

   513 				}

   514 			}

   515 		else	# no format string : print as hex

   516 			{

   517 			for (my $i=0; $i < $recordLen; $i+=4)

   518 				{

   519 				$formattedText.= sprintf ("%08X ", unpack("V", substr($recordData, $i, 4)));

   520 				}

   521 			$recordPos+= $recordLen; $recordLen = 0;

   522 			

   523 			}

   524 		

   525 

   526 		# print Formatted text (col #10)

   527 		$formattedText=~ s/,/;/g;

   528 		$formattedText=~ s/\r//g;

   529 		$formattedText=~ s/\n/,/g;

   530 		printf "%s", $formattedText;

   531 

   532 		printf("\n");

   533 

   534 		if ($len < 0 || $recordLen < 0)	{die "truncated file";}

   535   

   536 

   537 		$pos+= ($len +3) & ~3;

   538 		seek (LOGFILE, $pos, SEEK_SET) or die "truncated file";

   539 		$i++;

   540 		}

   541 

   542 	close (LOGFILE);

   543 

   544 	if ($VerboseMode)

   545 		{

   546 		print "*** Processes ***\n";

   547 		for $id ( keys %ProcessNames )

   548 			{

   549 			printf ("process %08X ProcessName %s\n", $id, $ProcessNames{$id});

   550 			}

   551 		print "*** Thread ***\n";

   552 		for $id ( keys %ThreadNames )

   553 			{

   554 			printf ("thread %08X ThreadName %s::%X\n", $id, $ThreadNames{$id}, $ThreadIds{$id});

   555 			}

   556 		}

   557 

   558     }

   559 

   560     

   561 sub ReadSingleRecord

   562 	{

   563 	($fh, $data, $dataLen, $recordLen, $category, $subCategory, $multipartFlags, $extraN, $totalLen, $offset, $RawMode) = @_;	

   564 	

   565 	my $hdr;

   566 	my $flags;

   567 	my $header2;

   568 	my $timestamp;

   569 	my $timestamp2;

   570 	my $contextId;

   571 	my $programConter;	

   572 	

   573 	my $recordOffset = 0;

   574 	

   575 	$timestampLast;	

   576 	my $timestampDelta = 0;	

   577 	

   578 	my $bytesRead = read($fh, $hdr, 4);

   579 	

   580 	

   581 	if ($bytesRead < 4)	

   582 		{return -1;}

   583 

   584 	($$recordLen,$flags,$$category,$$subCategory) = unpack("CCCC", $hdr);

   585 	$$dataLen = $$recordLen-4;

   586 	

   587 	if ($flags & $EHeader2Present)

   588 		{$$multipartFlags = (ReadDword($fh) & $EMultipartFlagMask); $$dataLen-= 4}

   589 	else

   590 		{$$multipartFlags = 0;}

   591 	if ($flags & $ETimestampPresent)

   592 		{$timestamp = ReadDword($fh); $$dataLen-= 4;}

   593 	if ($flags & $ETimestamp2Present)

   594 		{$timestamp2 = ReadDword($fh); $$dataLen-= 4;}

   595 	if ($flags & $EContextIdPresent)

   596 		{$contextId = ReadDword($fh); $$dataLen-= 4;}

   597 	if ($flags & $EPcPresent)

   598 		{$programConter = ReadDword($fh); $$dataLen-= 4;}

   599 	if ($flags & $EExtraPresent)

   600 		{$$extraN = ReadDword($fh); $$dataLen-= 4;}

   601 	if ($$multipartFlags != 0)

   602 		{

   603 		$$totalLen = ReadDword($fh);  $$dataLen-= 4;

   604 		if ($$multipartFlags == $EMultipartMiddle || $$multipartFlags == $EMultipartLast)

   605 			{$$offset = ReadDword($fh);  $$totalLen-= 4; $$dataLen-= 4;}

   606 		}				

   607 

   608 	$timestampDelta = $timestamp - $timestampLast;

   609 	$timestampLast = $timestamp;

   610 

   611 	read($fh, $$data, ($$dataLen + 3) & ~3);

   612 

   613 

   614 	if ($RawMode || $$multipartFlags == $EMultipartFirst || $$multipartFlags == 0)

   615 		{

   616 		# print header len (col #1)

   617 		if ($PrintFlagHdrLen){printf ("0x%02X, ", $$recordLen);}

   618 	

   619 		# print header flags (col #2)

   620 		if ($PrintFlagHdrFlags)

   621 			{

   622 			printf ("%02X ", $flags);

   623 			if ($flags & $EHeader2Present) {printf "EHeader2Present ";}

   624 			if ($flags & $ETimestampPresent) {printf "ETimestampPresent ";}

   625 			if ($flags & $ETimestamp2Present) {printf "ETimestamp2Present ";}

   626 			if ($flags & $EContextIdPresent) {printf "EContextIdPresent ";}

   627 			if ($flags & $EPcPresent) {printf "EPcPresent ";}

   628 			if ($$multipartFlags != 0)

   629 				{

   630 				printf "EExtraPresent ";

   631 				if ($$multipartFlags == $EMultipartFirst) {print "EMultipartFirst ";}

   632 				elsif ($$multipartFlags == $EMultipartMiddle) {print "EMultipartMiddle ";}

   633 				elsif ($$multipartFlags == $EMultipartLast) {print "EMultipartLast ";}

   634 				printf ("ExtraN(0x%08X) ", $$extraN);

   635 				}

   636 			if ($flags & $ERecordTruncated) {printf "ERecordTruncated ";}

   637 			if ($flags & $EMissingRecord) {printf "EMissingRecord ";}

   638 			print ",";

   639 			}

   640 				

   641 		# print category (col #3)

   642 		printf "(%d;%d) $categoryString  , ", $$category, $$subCategory;

   643 	

   644 		# print timestamp(s) (col #4)

   645 		printf "0x";

   646 		if (defined $timestamp2) {printf "%08X : ", $timestamp2;}

   647 		printf "%08X", $timestamp;

   648 		printf ", ";;

   649 	

   650 		# print timestamp delta (col #5)

   651 		printf "0x%08X, ", $timestampDelta;

   652 

   653 		# print context Id (col #6)

   654 		if (!$RawMode && defined $ThreadNames{$contextId})

   655 			{

   656 			printf ("%s::%X, ", $ThreadNames{$contextId}, $ThreadIds{$contextId});

   657 			}

   658 		else			

   659 			{

   660 			if ((($contextId & $EContextIdMask) == $EContextIdThread) || $RawMode)

   661 				{printf "0x%08X, ", $contextId;}

   662 			elsif (($contextId & $EContextIdMask) == $EContextIdFIQ)

   663 				{printf "FIQ, ";}

   664 			elsif (($contextId & $EContextIdMask) == $EContextIdIRQ)

   665 				{printf "IRQ, ";}

   666 			elsif (($contextId & $EContextIdMask) == $EContextIdIDFC)

   667 				{printf "IDFC, ";}

   668 			}

   669 	

   670 		# print Program Counter (col #7)

   671 		printf "0x%08X, ", $programConter;

   672 		}

   673 

   674 		

   675 	

   676 	

   677 #########################################################

   678 #	my $hex;

   679 #	for (my $i=0; $i < $$dataLen; $i+=4)

   680 #		{

   681 #		$hex.= sprintf ("%08X ", unpack("V", substr($$data, $i, 4)));

   682 #		}

   683 #	printf "\nadding [$hex]\n";

   684 #########################################################

   685 	return $bytesRead

   686 	}

   687 

   688 	      

   689 sub ReadRecord 

   690 	{

   691 	($fh, $recordPos, $recordData, $category, $subCategory, $multipartFlags, $RawMode) = @_;

   692 #	printf "CurrentPos %08X\n", $pos;

   693 

   694 

   695 

   696 	seek ($fh, $$recordPos, SEEK_SET) or die "truncated file";

   697 	my $recordLen;

   698 	my $extraN;

   699 	my $totalLen;

   700 	my $offset;

   701 	my $dataLen;

   702 	my $data;

   703 	my $bytesRead;

   704 	

   705 	

   706 	$bytesRead = ReadSingleRecord($fh,  \$data, \$dataLen, \$recordLen, \$$category, \$$subCategory, \$$multipartFlags, \$extraN, \$totalLen, \$offset, $RawMode);

   707 

   708 	if ($bytesRead == -1)	# eof ?

   709 		{return -1; }

   710 	$$recordPos+= ($recordLen +3) & ~3;

   711 	

   712 	$$recordData = $data;

   713     $offset = $dataLen;

   714 

   715 	$offset-= 4;		# subtract 4 bytes for UID ?????????

   716     

   717     if ($RawMode || $$multipartFlags != $EMultipartFirst)

   718     	{return $dataLen;}

   719 

   720     $pos = $$recordPos;

   721 

   722 	while (1)

   723 		{

   724 		

   725 		# find next record, i.e. look for a record which matches $extraN 

   726 		

   727 		seek ($fh, $pos, SEEK_SET) or die "truncated file";

   728 

   729 		my $recordLen;

   730 		

   731 		my $category;

   732 		my $subCategory;

   733 		my $multipartFlags;

   734 		my $currentExtraN;

   735 		my $currentOffset;

   736 		

   737 		my $totalLen;

   738 		my $currentDataLen;

   739 		my $data;

   740 		$bytesRead = ReadSingleRecord($fh, \$data, \$currentDataLen, \$recordLen, \$category, \$subCategory, \$multipartFlags, \$currentExtraN, \$totalLen, \$currentOffset, $RawMode);

   741 		if ($bytesRead == -1)	# eof ?

   742 			{return -1; }

   743 		$pos+= ($recordLen +3) & ~3;

   744 		

   745 #		printf "\npos %08X, Seaching for (extra %08X, offset %08X), found (extra %08X, offset %08X)\n",

   746 #			$pos, $extraN, $offset, $currentExtraN, $currentOffset;

   747 

   748 		if ($currentExtraN == $extraN && $currentOffset == $offset)

   749 			{

   750 			$$recordData.= $data;

   751 			$offset+= $currentDataLen;

   752 			$dataLen+= $currentDataLen;

   753 			}

   754 			

   755 		if ($multipartFlags == $EMultipartLast)

   756 			{last;}

   757 		}

   758 	

   759 	return $dataLen;

   760 	}	

   761 

   762 sub ReadDword {

   763 	(my $fh) = @_;

   764 	my $buffer;

   765 

   766 	$bytesRead = read($fh, $buffer, 4);

   767 	if ($bytesRead < 4) 	{die "truncated file";}

   768 

   769 	my $dword = unpack("V", $buffer);

   770 

   771 	return $dword

   772 	};

   773 

   774 sub ReadByte {

   775 	(my $fh) = @_;

   776 	my $buffer;

   777 

   778 	$bytesRead = read($fh, $buffer, 1);

   779 	if ($bytesRead < 1) 	{die "truncated file";}

   780 

   781 	my $byte = unpack("C", $buffer);

   782 

   783 	return $byte

   784 	};

   785 

   786     

   787 	

   788 sub PrintFormatTables($)

   789 	{

   790 	my ($formatTables) = @_;

   791 		

   792 	for $tableIndex ( sort keys %$formatTables )

   793 		{

   794 		printf ("SYMTraceFormatCategory %08X:\n", $tableIndex);

   795 		for $formatId (sort keys %{ $$formatTables{$tableIndex} } )

   796 			{

   797 			printf ("%08X => %s\n", $formatId, $$formatTables{$tableIndex}{$formatId});

   798 			}

   799 			print "\n";

   800 		}

   801 	}

   802         

   803 

   804 

   805 sub OutputSawDictionary($)

   806 	{

   807 	my ($formatTables) = @_;

   808 

   809 

   810 	# SAW enums

   811 	$EFieldTypeHexDump = 0;

   812 	$EFieldTypeHex = 1;

   813 	$EFieldTypeDecimal = 2;

   814 	$EFieldTypeStringToEnd = 3;

   815 	$EFieldTypeNullTerminatedString = 4;

   816 	$EFieldTypeHexDumpToEnd = 5;

   817 	$EFieldTypeUnicodeToEnd = 6;

   818 	$EFieldTypeNullTerminatedUnicode = 7;

   819 	$EFieldTypeCountedUnicode = 8;

   820 	$EFieldTypeCountedHexDump = 9;

   821 	$EFieldTypeCountedString = 10;

   822 

   823 	my $moduleIds;	# string containg all UIDs separared by semi-colons

   824 		

   825 	for $tableIndex ( sort keys %$formatTables )

   826 		{

   827 		if ($tableIndex < 256)

   828 			{

   829 			next;

   830 			}

   831 		$moduleIds.= sprintf ("%08X;", $tableIndex);

   832 		

   833 		printf ("MODULEID_%08X_DESC=\n", $tableIndex);

   834 		printf ("MODULEID_%08X_NAME=%08X\n", $tableIndex, $tableIndex);

   835 		

   836 		my $formatIds;

   837 		$formatIds = sprintf ("MODULEID_%08X_FORMATIDS=", $tableIndex);

   838 		

   839 		for $formatId  (sort keys %{ $$formatTables{$tableIndex} } )

   840 			{

   841 			$formatIds.= sprintf ("%d;", $formatId);

   842 			}

   843 		printf ("$formatIds\n");

   844 		

   845 		

   846 		for $formatId (sort keys %{ $$formatTables{$tableIndex} } )

   847 			{

   848 			my $fieldCount = 0;

   849 			my $formatString = $$formatTables{$tableIndex}{$formatId};

   850 			

   851 #printf ("formatString = (%s)\n", $formatString);

   852 

   853 			# format name is the first format string up until the first space or '%' character or end-of line ...

   854 			$formatString=~ m/^[^%\s]*/;

   855 			my $formatName = $&;

   856 			

   857 			# thow the format name away

   858 			$formatString = $';

   859 			

   860 			# strip the leading space

   861 			$formatString=~ s/\s*//;

   862 

   863 			printf ("MODULEID_%08X_FORMATID_%d_NAME=%s\n", $tableIndex, $formatId, $formatName);

   864 #printf ("MODULEID_%08X_FORMATID_%d_DESC=\n", $tableIndex, $formatId);

   865 

   866 			my $lenFormatString = length($formatString);

   867 			

   868 			my $formattedText;

   869 			my $fieldType = $EFieldTypeHex;

   870 			my $fieldLen = 0;

   871 			while (length($formatString))

   872 				{

   873 				my $c = (substr ($formatString, 0, 1));

   874 #print ("[$formatString][$c]\n");				

   875 				$formatString=~ s/.//;	# strip the leading space

   876 				if ($c eq "%")

   877 					{

   878 #print "found %\n";							

   879 					my $fieldLenSpecified = 0;

   880 	        		$c = (substr ($formatString, 0, 1));

   881 					$formatString=~ s/.//;	# discard char

   882 #print "c2=$c\n";							

   883 					if ($c eq "%")

   884 						{

   885 						$formattedText.= substr ($formatString, 0, 1);

   886 						next;

   887 						}

   888 					if ($c eq "*")	## take length from buffer

   889 						{

   890 						$fieldLenSpecified = 1;

   891 		        		$c = (substr ($formatString, 0, 1));

   892 						$formatString=~ s/.//;	# discard char

   893 						}

   894 					if (lc $c eq "x" || $c eq "h")

   895 						{

   896 						## deal wilth $fieldLenSpecified

   897 						if ($fieldLenSpecified)

   898 							{

   899 							$fieldType = $EFieldTypeCountedHexDump;

   900 							$fieldLen = 0;

   901 							}

   902 						else

   903 							{

   904 							$fieldType = $EFieldTypeHex;

   905 							$fieldLen = 4;

   906 							}

   907 						}

   908 					elsif (lc $c eq "l" && substr ($formatString, 0, 1) eq "d")

   909 						{

   910 						$formatString=~ s/.//;	# discard char

   911 						$fieldType = $EFieldTypeDecimal;

   912 						$fieldLen = 8;

   913 						}

   914 					elsif (lc $c eq "l" && substr ($formatString, 0, 1) eq "x")

   915 						{

   916 						$formatString=~ s/.//;	# discard char

   917 						$fieldType = $EFieldTypeHex;

   918 						$fieldLen = 8;

   919 						}

   920 					elsif (lc $c eq "d")

   921 						{

   922 						$fieldType = $EFieldTypeDecimal;

   923 						$fieldLen = 4;

   924 						}

   925 					elsif ($c eq "s")

   926 						{

   927 						## deal wilth $fieldLenSpecified

   928 						if ($fieldLenSpecified)

   929 							{

   930 							$fieldType = $EFieldTypeCountedString;

   931 							$fieldLen = 0;

   932 							}

   933 						else

   934 							{

   935 							$fieldType = $EFieldTypeStringToEnd;

   936 							$fieldLen = 0;

   937 							}

   938 						}

   939 					elsif ($c eq "S")

   940 						{

   941 						## deal wilth $fieldLenSpecified

   942 						if ($fieldLenSpecified)

   943 							{

   944 							$fieldType = $EFieldTypeCountedUnicode;

   945 							$fieldLen = 0;

   946 							}

   947 						else

   948 							{

   949 							$fieldType = EFieldTypeUnicodeToEnd;

   950 							$fieldLen = 0;

   951 							}

   952 						}

   953 					elsif ($c eq "c")

   954 						{

   955 						$fieldType = $EFieldTypeHex;

   956 						$fieldLen = 1;

   957 						}

   958 					printf ("MODULEID_%08X_FORMATID_%d_FIELD_%d_NAME=%s\n", $tableIndex, $formatId, $fieldCount, $formattedText);

   959 					printf ("MODULEID_%08X_FORMATID_%d_FIELD_%d_TYPE=%s\n", $tableIndex, $formatId, $fieldCount, $fieldType);

   960 					if ($fieldLen > 0)

   961 						{printf ("MODULEID_%08X_FORMATID_%d_FIELD_%d_LENGTH=%s\n", $tableIndex, $formatId, $fieldCount, $fieldLen);}

   962 					$fieldCount++;

   963 					$formattedText="";

   964 					

   965 					$formatString=~ s/\s//;	# strip the leading space

   966 					}

   967 				else

   968 					{

   969 #					if ($c eq ":") {$formattedText.= '\\'; }

   970 					$formattedText.= $c;

   971 					}

   972 				}

   973 			printf ("MODULEID_%08X_FORMATID_%d_FIELDS=%d\n", $tableIndex, $formatId, $fieldCount);

   974 			

   975 			}

   976 		print "MODULEIDS=$moduleIds\n";

   977 		}

   978 	}

   979 	

   980 	

   981 	

   982 	

   983 	

   984 	

   985 	        

   986         

   987 sub H2Trace($$)

   988 {

   989 	%basictypes = (

   990 		TInt8		=>	1,

   991 		TUint8		=>	1,

   992 		TInt16		=>	2,

   993 		TUint16		=>	2,

   994 		TInt32		=>	4,

   995 		TUint32		=>	4,

   996 		TInt		=>	4,

   997 		TUint		=>	4,

   998 		TBool		=>	4,

   999 		TInt64		=>	8,

  1000 		TUint64		=>	8,

  1001 		TLinAddr	=>	4,

  1002 		TVersion	=>	4,

  1003 		TPde		=>	4,

  1004 		TPte		=>	4,

  1005 		TProcessPriority => 4,

  1006 		TFormatId	=>  2,

  1007 	);

  1008 	

  1009 	if (scalar(@_)!= 2) {

  1010 		die "perl h2trace.pl <input.h>\n";

  1011 	}

  1012 	my ($infile, $filescope) = @_;

  1013 	

  1014 	if ($VerboseMode)

  1015 		{print "\nOpening $infile\n";}

  1016 	

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

  1018 	my $in;

  1019 	while (<IN>) {

  1020 		$in.=$_;

  1021 	}

  1022 	close IN;

  1023 	

  1024 	# First remove any backslash-newline combinations

  1025 	$in =~ s/\\\n//gms;

  1026 	

  1027 	# Remove any character constants

  1028 	$in =~  s/\'(.?(${0})*?)\'//gms;

  1029 	

  1030 	# Strip comments beginning with //

  1031 	$in =~ s/\/\/(.*?)\n/\n/gms;    #//(.*?)\n

  1032 	

  1033 	# Strip comments (/* */) but leave doxygen comments (/** */)

  1034 	$in =~ s/\/\*[^*](.*?)\*\//\n/gms;  #/*(.*?)*/

  1035 	

  1036 	

  1037 	# Collapse whitespace into a single space or newline

  1038 	$in =~ s/\t/\ /gms;

  1039 	$in =~ s/\r/\ /gms;

  1040 	

  1041 	# Tokenize on non-identifier characters

  1042 	my @tokens0 = split(/(\W)/,$in);

  1043 	my @tokens;

  1044 	my $inString = 0;

  1045 	my $inComment = 0;

  1046 	my $string;

  1047 	foreach $t (@tokens0) {

  1048 		next if ($t eq "");

  1049 		next if (!$inString && ($t eq " " or $t eq ""));

  1050 		if ($inComment == 0) 

  1051 			{

  1052 			if ($t eq "/")

  1053 				{$inComment = 1;}

  1054 			}

  1055 		elsif ($inComment == 1) 

  1056 			{

  1057 			if ($t eq "*")

  1058 				{$inComment = 2;}

  1059 			else

  1060 				{$inComment = 0;}

  1061 			}

  1062 		elsif ($inComment == 2) 

  1063 			{

  1064 			if ($t eq "*")

  1065 				{$inComment = 3;}

  1066 			}

  1067 		elsif ($inComment == 3) 

  1068 			{

  1069 			if ($t eq "/")

  1070 				{

  1071 				$inComment = 0;

  1072 		        # if we were in a string, need to push previous '*'

  1073 		        if ($inString)

  1074 		          {

  1075 		          push @tokens, "*";

  1076 		          }

  1077 				$inString = 0;	# end of comment aborts a string

  1078 				$string = "";

  1079 				}

  1080 			else

  1081 				{$inComment = 2;}

  1082 			}

  1083 			

  1084 		if ($t eq "\"")

  1085 			{

  1086 			if (!$inString) 

  1087 				{

  1088 				$inString=1;

  1089 				next;

  1090 				}

  1091 			else

  1092 				{

  1093 				$inString=0;

  1094 				$t = $string;

  1095 				$string = "";

  1096 #				if ($VerboseMode) {print "string : [$t]\n";	}

  1097 				}

  1098 			}

  1099 			

  1100 		if ($inString)

  1101 			{

  1102 			$string.= $t;

  1103 			next;

  1104 			}

  1105 		push @tokens, $t;

  1106 	}

  1107 	

  1108 	my $CurrentTraceFormatString;

  1109 	my $CurrentTraceFormatCategory;

  1110 	# format Key as specified by the @TraceFormatCategory tag is either the current category 

  1111 	# or the current UID

  1112 	my $CurrentFormatTableKey;	

  1113 	

  1114 	

  1115 	my $line=1;

  1116 	parse_scope($filescope, \@tokens, \$line);

  1117 

  1118 	#print $in;

  1119 	#print join (" ", @tokens);

  1120 }	# end of     H2Trace

  1121 	

  1122 

  1123 

  1124 	sub parse_scope($$$) {

  1125 		my ($scope, $tokens, $line) = @_;

  1126 		my $state = 1;

  1127 		

  1128 		my @classes;

  1129 		my $curr_offset=0;

  1130 		my $overall_align=0;

  1131 #		print ">parse_scope $scope->{name}\n";

  1132 		

  1133 		while (scalar(@$tokens))

  1134 			{

  1135 			my $t = shift @$tokens;