@rem = '--*-Perl-*--';
@rem = '
@echo off
set NAME=%~n0.bat
if "%CTCHOME%"=="" goto NoCTCHOME
if not exist "%CTCHOME%\%NAME%" goto Nosetup
if not exist "%CTCHOME%\perl510\perl.exe" goto OldPerl
"%CTCHOME%\perl510\perl.exe" "%CTCHOME%\%NAME%" %*
if errorlevel 1 goto End
exit /b 0
:OldPerl
if not exist "%CTCHOME%\perl\perl.exe" goto NoPerl
"%CTCHOME%\perl\perl.exe" "%CTCHOME%\%NAME%" %*
if errorlevel 1 goto End
exit /b 0
@rem ';
##########################################################################
# CTC++ ctc2static.pl v1.5
#
# Copyright (C) 2006-2014 Testwell Oy
# Copyright (C) 2006-2016 Verifysoft 
#
#
# $RCSfile$
# $Revision$ $Date$
# Last Edited : 14.1.2016
# Author      : $Author: roland $
#
#                  Copyright (c) 2006-2014 Testwell Oy
#                  Copyright (c) 2006-2016 Verifysoft
##########################################################################
# Additional notice to users:
# You may use this Perl script as part of your authorized use of the
# CTC++ System. You/your organization is supposed to acquire the actual
# Perl system independently (start for example from http://www.perl.org).
#
# We would however be pleased to receive your bug corrections/reports
# and enhancement suggestions and will consider them in future versions of
# this tool.
#
#
##########################################################################

# subroutines used
#
sub get_counter;
sub get_set_list;
sub safe_split;
sub dirname;
sub basename;
sub usage;
sub version;
sub bigwarn;

# some constants
$version = "v1.5";


#
# The user may modify this default value if some other value is desirable
# -----------------------------------------------------------------------
#

# Set this to one, to prevent Messagboxes in error cases
$nogui=0;

# Now hard-constants for locking, same on all platforms.
# In case of issues, the installer could modify them to correct values.
$LOCK_EX = 2;
$LOCK_UN = 8;

if ($ARGV[0] eq "--usage"  ||
    $ARGV[0] eq "--help"  ||
    $ARGV[0] eq "-h" ||
    $#ARGV==-1 ) {
    usage();
    exit -1 if $#ARGV == -1;
    exit 0;
}

if ($ARGV[0] eq "--version") {
    version();
    exit 0;
}


$e = ""; # error prefis
if ($ARGV[0] eq "c51ctc" or
    $ARGV[0] eq "c166ctc" or
    $ARGV[0] eq "c251ctc" or
    $ARGV[0] eq "cactc") {
    $e = "*** ERROR ";
}

# Some reasonable default values for the "counter" file
# You should delete that file after a make clean


$list_name = "MON";
$list_ext = "aux";
$counter_path = '.';
#following should store MON.aux where MON.sym is
#The commandline transfered here via env var CTC_TOOL_ARGS
if (defined $ENV{'CTCOPTS'}) {
    my $n = 0;
    foreach $item (safe_split ($ENV{'CTCOPTS'})) {
	if ($item eq "-n") {
	    $n=1;
	} elsif ($n) {
	    $n=0;
	    if (defined $ENV{CTC_DATA_PATH}) {
		$list_name=basename($item);
		$list_name=~s/\.sym//i;
	    } else {
		$ENV{'CTC_DATA_PATH'}=dirname($item) if length dirname($item);
		$list_name=basename($item);
		$list_name=~s/\.sym//i;
	    }
	}
    }
}
$counter_path = $ENV{'CTC_DATA_PATH'} if (defined $ENV{'CTC_DATA_PATH'});
$fileseparator = "/";
$fileseparator = "\\" if $^O eq "MSWin32";

# You can also just hard-code this here
$listfilename = $counter_path . $fileseparator . $list_name . "." . $list_ext;

# Hack for converting back Metrowerks line directives
$cw = 0;     # 1 enables
$cw_file = '';  # needed for $cw

# Not modificable 
@tail=();
$source = '';
$ctchdone =0;


open IN, $ARGV[2] || die $e."Could not open $ARGV[2]\n";
while (<IN>) {
    if (!$ctchdone && /^#include "ctc.h"/) {
	s/ctc/ctcbits/;
	$ctchdone++;
    }
    if (/^#CTC_FLAG(.*)$/) {
	$_ = $1 . "\n";
    }
    if ($cw) {
	my $result = '';
	if (/^\#line\s+(\d+)\s+\"([^"]+)\"/) {
	    if ($2 ne $cw_file) {
	         $cw_file = $2;
	         $result = "\n/**** FILE \'$cw_file\' */\n\n";
	    }
	$result .= "/*" . " " x (9-length("$1")) . $1 . " */";
        $_ = $line = <IN>;
        if (/^#CTC_FLAG(.*)$/) {
            $line = $1 . "\n";
        } 
	$result .= $line;
        $_ = $result;
        }
    }
    if (/^CTC_MODULE_TAIL\((.*)\)/) {
	$_ = $1;
	s#\\\\#\\#g;
	@tail = split(/,/);  # FIXME, no commas ',' in filenames , keine Kommas in Dateinamen 
    } else {
	$source .= $_;
    }
}
close IN;

if ($#tail==-1) {
    exit 0;
}

# extract data
($modname, $monfile, $timestamp, $num_s, $num_j, $num_tf, $num_c, $num_time) = @tail; # strip module tail to pieces
$modname =~ s/^\"//; # replace quotes
$modname =~ s/\"$//; # replace quotes
$monfile =~ s/^\"//; # replace quotes
$monfile =~ s/\"$//; # replace quotes

$counter = get_set_list($modname, $monfile, $timestamp, $num_s, $num_j, $num_tf, $num_c, $num_time);


# We have to prepend that defines
# (another solution could be to deal with inclusion order of ctc.h...)
$ARGV[1] =~ s/\\/\\\\/g; #Replace all \ with proper escaped \\
$prepend = '#line 1 "' . $ARGV[1] . '"' . "\n";
$prepend .= "#define ctc_offset " . $counter . "\n";

open OUT, ">$ARGV[2]" || die $e."Could not open $ARGV[2]\n";
print OUT $prepend;
print OUT $source;
close OUT;
1;

#
# The program execution ends here. The definitions of the subroutines
# follow.
#

##########################################################################
# SUBROUTINES
##########################################################################

##########################################################################
# SUBROUTINE: get_counter
# PURPOSE   : The function returns the "counter" value from hard-drive
# ARGUMENT  : file - The counters file name
# RETUNRS   : The counters value
##########################################################################
sub get_counter {
    my $file = shift;
    my $count = 0;

    open IN, $file or return $count;
    $_ = <IN>;
    chomp;
    $count = $_;
    close IN;

    return $count;
}

##########################################################################
# SUBROUTINE: get_set_list
# PURPOSE   : The swiss-army-knife for remembering the values 
# ARGUMENT  : The regular parameters for CTC_MODULE_TAIL 
#             $modname, $monfile, $timestamp, $num_s, $num_j, $num_tf, $num_c, $num_time
# RETURNS   : nothing
##########################################################################

sub get_set_list {
    my ($modname, $monfile, $timestamp, $num_s, $num_j, $num_tf, $num_c, $num_time) = @_;
    my $counter = 0;
    my $content = '';
    my $recycled = -1;
    my $changed = 0;

    $lock = $listfilename;
    $lock=~s/\.aux$/.log/i;

    # if (defined $^V) {
    # 	# Modern Perl 5.0.6 and above
    # 	open IN, "+>>$listfilename";
    # 	seek(IN, 0,0);
    # 	flock IN, $LOCK_EX;
    # } else {
	open LOCK, ">>$lock";
	flock LOCK, $LOCK_EX;
	open IN, "$listfilename";
    # }
    while (<IN>) {
	my ($Xmodname, $Xmonfile, $Xtimestamp, $Xnum_s, $Xnum_j, $Xnum_tf, $Xnum_c, $Xnum_time) = split /\t/;
	if ($modname eq $Xmodname) {
	    if ( ($Xnum_s + $Xnum_j + 2*$Xnum_tf + $Xnum_c + 2*$Xnum_time) ==
		 ($num_s + $num_j + 2*$num_tf + $num_c + 2*$num_time)) {
		if ($Xtimestamp != $timestamp || 
		    $Xmonfile ne $monfile) {
		    $changed++;		    
		}
		$content .= "$modname\t$monfile\t$timestamp\t$num_s\t$num_j\t$num_tf\t$num_c\t$num_time\t$counter\n";
		$recycled = $counter;
	    } else {
		print STDERR $e."Entry for $modname with wrong amount of counters in  $listfilename!\n";
		print STDERR $e."Do a make clean, delete $listfilename, rebuild!\n";
		bigwarn($modname, $listfilename);
		die $e."Exiting, this will not work!!!!!!!!!\n\n";
	    }
	} else {
	    $content.=$_;
	}
	$counter += $Xnum_s + $Xnum_j + 2*$Xnum_tf + $Xnum_c + 2*$Xnum_time;
	$counter++; #GAP
    }

    # if (defined $^V) {
    # 	if ($changed) {
    # 	    open OUT, ">$listfilename";
    # 	    print OUT $content;
    # 	    print OUT "$modname\t$monfile\t$timestamp\t$num_s\t$num_j\t$num_tf\t$num_c\t$num_time\t$counter\n" unless $recycled != -1;
    # 	    $recycled = 0;
    # 	    close OUT;
    # 	}
    # } else {
	if ($changed) {
	    close IN;
	    open IN, ">$listfilename";
	    print IN $content;
	    print IN "$modname\t$monfile\t$timestamp\t$num_s\t$num_j\t$num_tf\t$num_c\t$num_time\t$counter\n" unless $recycled != -1;
	    $recycled = 0;
	}
	unless ($recycled!=-1) {
	    close IN;
	    open IN, ">>$listfilename";
	}
    # }

    unless ($recycled!=-1) {
	print IN "$modname\t$monfile\t$timestamp\t$num_s\t$num_j\t$num_tf\t$num_c\t$num_time\t$counter\n";
    }

    # if (defined $^V) {
    # 	flock IN, $LOCK_UN;
    # } else {
	flock LOCK, $LOCK_UN;
	close LOCK;
        unlink $lock;
    # }

    close IN;

    return $recycled unless $recycled == -1;
    return $counter;
}

##########################################################################
# SUBROUTINE: safe_split
# PURPOSE   : Splits a string, according to conventions for CTCOPTS
# PARAMETER : $string -- the strin to split
# RETURNS   : @array -- the splitted string
##########################################################################
sub safe_split
{
    my ($string) = @_;
    my @array = ();
    my $state = 0;
    my $item = '';
    my $inquote=0;
    
    
    while (length $string) {
	my $char = substr($string,0,1);
	$string=substr($string,1);
	if ($state==0) {
	    if ($char eq " ") {
		if (length $item) {
		    push @array, $item;
		    $item='';
		}
	    } elsif (!length $item && $char eq "-") {
		$item=$char;
		$state = 1;
	    } elsif ($char eq '"') {
		$state = 1;
		$inquote=1;
	    } else {
		$item.=$char;
	    }
	} elsif ($state == 1) {
	    if ($char eq " " && !$inquote) {
		$state=0;
		push @array, $item;
		$item = '';
	    } elsif ($char eq '"' && $inquote) {
		$state=0;
		push @array, $item;
		$item = '';
	    } else {
		$item.=$char;
	    }
	}
    }
    if (length $item) {
	push @array, $item;
    }

    return (@array);
}

##########################################################################
# SUBROUTINE: dirname
# PURPOSE   : Returns the directory part of a filename
##########################################################################
sub dirname
{
    my ($filename) = @_;
    my $dir = "";
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
        $end = rindex $filename, '/';
    }

    if ($end > 0) {
        $dir = substr $filename, 0, $end;
    } elsif ($end == 0) {
        $dir = substr $filename, 0, 1;
    }

    return $dir;
}

##########################################################################
# SUBROUTINE: basename
# PURPOSE   : Strip directory from a filename
##########################################################################
sub basename 
{
    my ($filename) = @_;
    my $base = $filename;
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
       $end = rindex $filename, '/';
    }
    if ($end >= 0) {
       $base = substr $filename, $end + 1;
    }
    return $base;
}


##########################################################################
# SUBROUTINE: usage
# PURPOSE   : Prints brief usage informations
##########################################################################
sub usage {
    my $name = myname();
    print "$name: Only to be used as CTC++ RUN_AFTER_INSTR script\n";
    print "tool testing options are\n";
    print "\t$name --version\n"; 
    print "\t$name --help\n"; 
}

##########################################################################
# SUBROUTINE: version
# PURPOSE   : Prints brief version informations
##########################################################################
sub version {
    print myname()." $version\n";
}

##########################################################################
# SUBROUTINE: myname
# PURPOSE   : Gets tool name out of $0
# RETURNS   : Toolname
##########################################################################
sub myname
{
    my $name = basename($0);
    $name=~s/.bat$//i;
    $name=~s/.pl$//i;
    return $name;
}

##########################################################################
# SUBROUTINE: bigwarn
# PURPOSE   : Displays a message for MON.aux issues
##########################################################################
sub bigwarn
{
    my ($modname, $listfilename) = @_;
    return unless $^O eq "MSWin32";
    return if $nogui;
    return if defined $^V;

    my $mtime=undef;
    my $current=time();
    (undef,undef,undef,undef,undef,undef,undef,undef,
        undef,$mtime)
        = stat($ENV{TEMP}."\\ctc2static_msg_timestamp");
    if (defined $mtime) {
	if (($current-$mtime) < 300) {
	    return; #Already seen
	}
    }
    open STAMP, ">".$ENV{TEMP}."\\ctc2static_msg_timestamp";
    print STAMP time;
    close STAMP;
    #print STDERR $e.;
    #STDERR $e.
    my $message=Win32::MsgBox("Entry for $modname with wrong amount of counters in  $listfilename!\n".
"Do a make clean, delete $listfilename and rebuild!"
		       ,0|0x10,"$listfilename inconsistent");

}


1;
__END__
:NoCTCHOME
echo.
echo The environment variable CTCHOME does not exist. Set CTCHOME
echo to point to the CTC++ installation directory! (Use short name
echo for it so that the value does not contain spaces!)
echo.
goto End

:Nosetup
echo.
echo Cannot find '%%CTCHOME%%\%%NAME%%'. Set CTCHOME
echo to point to the CTC++ installation directory! (Use short name
echo for it so that the value does not contain spaces!)
echo.
goto End

:NoPerl
echo.
echo Cannot find the '%%CTCHOME%%\perl\perl.exe' program. Set CTCHOME
echo to point to the CTC++ installation directory! (Use short name
echo for it so that the value does not contain spaces!)
echo.
goto End

:End
exit /b 1