@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
@rem ';
#!perl
#line 12

use strict;
use Getopt::Long;

my $toolVersion = "1.0";

my $update = 0;
my $use_perforce = 0;
my $verbose = 0;
my $defFile;

# 1. Check arguments, output help etc.

GetOptions (
	'update' => \$update,			# modify the files
	'perforce' => \$use_perforce,	# apply "p4 edit" to changed files
	'v+' => \$verbose,				# print extra diagnostic info
	'match=s' => \$defFile			# only process DEF files matching a pattern
	);

if (@ARGV == 0)
	{
	print STDERR "\nfix_eabi_thunk_offsets.bat - Version $toolVersion\n";

	print STDERR << 'END_OF_HELP';

Usage: fix_eabi_think_offsets [-update] [-perforce] [-match exp] build_log ... 

Parse the output from one or more build logs, extracting MAKEDEF errors and
warnings which relate to EABI virtual function override thunks. Using this
information, prepare modified DEF files in which each "missing" export is 
replaced by a corresponding "unfrozen" export.

-update     Overwrite the existing .def files with the modified versions
-perforce   Apply "p4 edit" to each of the modified .def files
-match exp  Process only .def files with names that contain "\exp"

NOTE: The tool assumes that the original build source layout is replicated on 
the drive where it is being executed.

Build logs will sometimes contain corrupted warning messages, in which case
the tool will probably report that there is nothing to replace some missing
symbol. It may help to edit the log file and try again: it is always safe to 
run this tool more than once on the same log file.

END_OF_HELP

	exit(1);
	}

my $parseWarnings = 1;
my $parseErrors = 1;


# 2. Parse the build logs, extracting the Makedef warnings & errors

my $line;
my $header;
my $parseWarning = 0;
my $parseError = 0;
my $variant;
my $component;
my $sourceDefFile;
my @errorOutput;
my @warningOutput;

my %DefFiles;
my %TempDefFiles;

sub newDefFile($)
	{
	my ($defFile) = @_;
	if (!defined $DefFiles{$defFile})
		{
		@{$DefFiles{$defFile}} = \();
		}
	}

while ($line = <>)
	{
	if ($line =~ /^Chdir /)
		{
		$component = $line;
		$component =~ s/^Chdir //;
		$component =~ s/\s//g;
		next;
		}
		
	if (($line =~ /^  make/) && ($line =~ / CFG\=/))
		{
		$variant = $line;
		$variant =~ s/^.*CFG\=//;
		$variant =~ s/ .*$//;
		$variant =~ s/\s//g;
		next;
		}

	if ($parseWarnings && ($line =~ /MAKEDEF WARNING:/))
		{
		$parseWarning =  1;
		$parseError = 0;
		$header = $line;
		next;		
		}
		
	if ($parseErrors && ($line =~ /MAKEDEF ERROR:/))
		{
		$parseWarning =  0;
		$parseError = 1;
		$header = $line;
		next;		
		}

	if ($line !~ /^  /)
		{
		$parseWarning = 0;
		$parseError = 0;
		next;
		}

	if ($parseWarning)
		{
		if ($header)
			{
			if ($defFile && ($header !~ /\\$defFile/i))
				{
				$parseWarning = 0;
				$parseError = 0;
				next;
				}
			
			$sourceDefFile = $header;
			$sourceDefFile =~ s/^.*not yet Frozen in//;
			$sourceDefFile =~ s/://;
			$sourceDefFile =~ s/\s//g;
			
			push @warningOutput, "--\n$sourceDefFile ($variant)\n$component\n$header";
			newDefFile($sourceDefFile);
			$header = "";
			}

		next if ($line =~ /\*\*\*/);
		if ($line =~ /^  (\S.*}\.def)(\(\d+\) : \S+.*)$/)
			{
			push @{$DefFiles{$sourceDefFile}}, "W$2";
			$TempDefFiles{$1} = $sourceDefFile;
			}
		push @warningOutput, $line;
		
		next;		
		}

	if ($parseError)
		{
		if ($defFile && ($line !~ /\\$defFile/i))
			{
			$parseWarning = 0;
			$parseError = 0;
			next;
			}
			
		if ($header)
			{
			$sourceDefFile = $line;
			$sourceDefFile =~ s/\(.*$//;
			$sourceDefFile =~ s/\s//g;

			push @errorOutput, "--\n$sourceDefFile ($variant)\n$component\n$header";
			newDefFile($sourceDefFile);
			$header = "";
			}

		next if ($line =~ /\*\*\*/);
		if ($line =~ /(\(\d+\) : \S+.*)$/)
			{
			push @{$DefFiles{$sourceDefFile}}, "E$1";
			}
		push @errorOutput, $line;
		
		next;
		}

	# Catch a orphaned warning line...
	
	if ($line =~ /^  (\S.*}\.def)(\(\d+\) : \S+.*)$/)
		{
		my $tempDefFile = $1;
		my $newline = $2;
		
		next if ($defFile && ($tempDefFile !~ /\\$defFile/i));

		my $sourceDefFile = $TempDefFiles{$tempDefFile};
		push @{$DefFiles{$sourceDefFile}}, "W$newline";
		push @warningOutput, $line;
		}

	}

close BUILD_LOG;

# 3. Process the information for each DEF file

my %Classes;
my @DefFileList;

foreach my $def (sort keys %DefFiles)
	{
	my @replacements;
	my @errors;
	my @warnings;
	my $problems = 0;
	
	print "\n----\n$def\n";
	if ($verbose > 1)
		{
		print "Information extracted from Makedef warnings and errors:\n";
		# printed inside the following loop...
		}

	# Process into lists of errors and warnings which can be sorted
	
	my $previousline = "";
	foreach $line (sort @{$DefFiles{$def}})
		{
		next if ($line eq $previousline);	# skip duplicates
		$previousline = $line;
		print "\t$line\n" if ($verbose > 1);
			
		if ($line =~ /^(.)\((\d+)\) : (((_ZTh|_ZTv)([n0-9_]+)_(NK?(\d+)(\S+)))\s.*)$/)
			{
			my $msgtype = $1;
			my $lineno = $2;
			my $defline = $3;
			my $symbol = $4;
			my $thunkprefix = $5;
			my $thunkoffset = $6;
			my $unthunked = $7;
			my $topnamelen = $8;
			my $restofsymbol = $9;
			
			if ($msgtype eq "E")
				{
				push @errors, "$unthunked\@$thunkprefix $thunkoffset $lineno $symbol";
				}
			else
				{
				push @warnings, "$unthunked\@$thunkprefix $thunkoffset $symbol";
				}
				
			my $class = substr $restofsymbol, 0, $topnamelen;
			$Classes{$class} = 1;
			}
		else
			{
			print "WARNING: Ignored - not a thunk: $line\n";
			}
		}
	
	# Match up the errors and warnings for related symbols
	
	@errors = sort @errors;
	@warnings = sort @warnings;
	my $error;
	my $warning;
	while (scalar @errors && scalar @warnings)
		{
		# Unpack the first entry in each of the lists
		
		$error = shift @errors;
		my ($ekey, $eoffset, $eline, $esymbol) = split / /, $error;
		$warning = shift @warnings;
		my ($wkey, $woffset, $wsymbol) = split / /, $warning;
		
		# Are they for the same thunk?
		
		if ($ekey lt $wkey) 
			{
			# no - unmatched error, so put back the warning
			unshift @warnings, $warning;
			print "Nothing to replace missing symbol on $eline : $esymbol\n";
			$problems += 1;
			next;
			}
		
		if ($ekey gt $wkey)
			{
			# no - unmatched warning, so put back the error
			unshift @errors, $error;
			print "Nothing missing for replacement symbol : $wsymbol\n";
			$problems += 1;
			next;
			}
		
		# Yes - create replacement instruction
		
		push @replacements, "$eline $esymbol => $wsymbol";
		}
	
	# drain remaining problems, if any
	
	foreach my $error (@errors)
		{
		my ($ekey, $eoffset, $eline, $esymbol) = split / /, $error;
		print "Nothing to replace missing symbol on $eline : $esymbol\n";
		$problems += 1;
		}
	foreach my $warning (@warnings)
		{
		my ($wkey, $woffset, $wsymbol) = split / /, $warning;
		print "Nothing missing for replacement symbol : $wsymbol\n";
		$problems += 1;
		}
		
	if ($verbose)
		{
		print "\nSubstitions identified:\n\t";
		print join("\n\t", sort @replacements);
		print "\n";
		}
	
	open DEFFILE, "<$def" or print "Can't open $def: $!\n" and next;
	my @deflines = <DEFFILE>;
	close DEFFILE;
	my $changedlines = 0;

	foreach my $fix (@replacements)
		{
		my ($lineno, $before, $to, $after) = split ' ', $fix;

		my $line = @deflines[$lineno-1];
		if ($line =~ /\s($after)\s/)
			{
			print "$lineno - already fixed\n";
			next;
			}
		if ($line =~ /\s($before)\s/)
			{
			$line =~ s/(\s)$before(\s)/$1$after$2/;
			@deflines[$lineno-1] = $line;
			print "Changed $lineno to $line" if ($verbose > 1);
			$changedlines += 1;
			next;
			}
		print "$lineno doesn't contain $before\n";
		$problems += 1;
		}
	print "\n";
	
	if ($problems != 0)
		{
		print "WARNING: $problems thunks could not be repaired\n";
		}

	if ($changedlines == 0)
		{
		print "Nothing to change\n";
		next;
		}
	print "Will change $changedlines lines\n\n";

	# Now update the file (and edit in Perforce if required)
		
	if ($update)
		{
		chmod 0666, $def;	# make it writeable
		
		open DEFFILE, ">$def" or print "Can't open $def for writing: $!\n" and next;
		print DEFFILE @deflines;
		close DEFFILE;
		
		print "Updated $def\n";
		push @DefFileList, $def;
		
		if ($use_perforce)
			{
			print "* p4 edit $def\n";
			system "p4 edit $def";
			print "\n";
			}
		}
	}

# 5. More diagnostic information

if (scalar @DefFileList)
	{
	print "\nList of updated def files\n";
	print join("\n", @DefFileList);
	print "\n";
	}

if ($verbose && scalar keys %Classes != 0)
	{
	print "\nList of affected classes:\n";
	print join("\n", sort keys %Classes), "\n";
	}

__END__
:endofperl