#!/usr/local/bin/perl5 -w
#
# Copyright (C) 1996-1998 by the Board of Trustees
#    of Leland Stanford Junior University.
# 
# This file is part of the SimOS distribution. 
# See LICENSE file for terms of the license. 
#

# possible -o options: [std|perl]
# ET - Feb 1996
#  Options:
#   -a = print out ALL buckets i.e. separation into 
#        USER/KERNEL/UTLB.  Default is off
#   -r = RAW data, i.e. no percentage miss rates... just absolute
#        numbers
#   -m = with RAW -r option, prints out [at moment] cold misses from MIPSY
#   -e = take a criteria as in seqsuifstat.prl, except accumulate the
#        raw numbers into a single bucket which matches the criteria!
#        Then print the raw numbers in a transposed matrix version
#   -w = with -e option, allows individual steps to be "weighted" so
#        as to make a MIPSY window representative of the entire execution
#        one argument must be passed to -w which is a Perl format
#        array of numbers indicating the relative multipliers to be applied
#        to each "step" which matches the -e criteria.  If the length of
#        the array is a factor of the number of steps which match, then
#        the multiplicative factor is just cycled over the steps according
#        to the array.  It is an error if the length of the array is
#        NOT a factor of the number of steps which match.

require "getopts.pl";

$g_numSteps = 0;
$g_fieldWidth = 10;
$g_mipsyData = 0;

@g_steps = ();
@g_matchRefs = ();  # array of refs to the hashes containing the data

@k_stdFields = ('seconds', 'dL2MR', 'iL2MR', 'dTlbMR', 'iTlbMR');
# k_everyField is the fields which embra and mipsy have in common
# so we can compare them...
@k_everyField = ('_cycles', '_instr', 'dL2Miss', 'iL2Miss', 
		 'dTlb', 'iTlb', 'dStall', 'dL2Stall', 'iStall', 'iL2Stall');
@k_xtraStepFields = ('UserPct', 'KernelPct', 'UTlbPct', 'avgUTlb');
@k_rawdataFields = ('seconds', '_cycles', '_instr', 'dL2MR', 'iL2MR',
		    'dTlbMR', 'iTlbMR', 'KernelIPct', 'UTlbIPct');
@k_mipsyrawdataFields = ('cold');
$definedModes{'kernel'} = 1;
$definedModes{'user'} = 1;
$definedModes{'idle'} = 1;
$definedModes{'sync'} = 1;

&doMain;

sub doMain {

    &GetOptions;  # get input file, output file etc

    ParseFile($inputFile, "ModesFilter", 0);

    # First add things up for the std user/kernel/idle
    $numModes=0;
    foreach $mode (keys %modes) {
	$modesT[$numModes] = $mode;
	$numModes++;
    }
    $modesT[$numModes] = 'total';

    $data{"total"}{'bucketName'} = "total";
    if ( defined( $opt_e ) ) {
	$data{$g_everyThing}{'bucketName'} = $g_everyThing;
	if ($g_allBuckets) {
	    foreach $m (('USER', 'KERNEL', 'UTLB')) {
		$data{$g_everyThing . "[$m]"}{'bucketName'} = $g_everyThing . "[$m]";
	    }
	}
    }
    foreach $mode (keys %modes) {
	AddToBucket($data{$mode},$data{'total'});
    }
    foreach $mode (keys %modes) {
	ComputeDerivedFields($data{$mode});
    }
    ComputeDerivedFields($data{'total'});

    # Now create totals for the steps (i.e. combine
    # USER/KERNEL/UTLB into 1

    my ($stepName, $sn, $modeName);

    if ($g_numSteps > 0) {
	for $sn (0 .. $g_numSteps) {
	    $stepName = $g_steps[$sn] . "-" . $sn;
	    $data{$stepName}{'bucketName'} = $stepName; 
	    foreach $modeName (('USER', 'KERNEL', 'UTLB')) {
		my $buckName = $stepName . "-" . $modeName;
		&AddToBucket($data{$stepName . "-" . $modeName}, 
			     $data{$stepName});
		if ( defined( $opt_e ) ) {
		    # then we want to add this bucket if it matches the
		    # criteria
		    if ( &MatchCriteria( $g_steps[$sn], $sn, $modeName ) != -1) {

			&AddToBucket($data{$buckName}, 
				     $data{$g_everyThing});
			if ($g_allBuckets) {
			    # then we need to add this bucket into the appropriate
			    # everything.kernel, .user, .utlb etc
			    &AddToBucket($data{$buckName},
					 $data{$g_everyThing . "[$modeName]"});
			}
			push(@g_matchRefs, $buckName );
		    }

		}
	    }
	}
	# Now compute derived fields for the steps
	# WARNING! Make certain you compute derived fields AFTER
	# adding buckets together, because compute derived will
	# insert -1.0 in places where there is missing data
	
	# Find out where first time stamp is for "steps"
	# so we can check against this in our sanity check
	
	my $p = $data{$g_steps[0]."-0"};
	$timeStamp = $p->{'time'} - ($p->{'instrCount'} + $p->{'dL2Stall'} +
				     $p->{'dUpgradeStall'} + $p->{'iL2Stall'});
	for $sn (0 .. $g_numSteps) {
	    $stepName = $g_steps[$sn] . "-" . $sn;
	    foreach $modeName (('USER', 'KERNEL', 'UTLB')) {
		$buckName = $stepName . "-" . $modeName;

		&ComputeDerivedFields($data{$buckName});
	    }
	    &ComputeDerivedFields($data{$stepName});
	    # ComputeDerivedFields MUST have been called before calling
	    # ComputeStepDerivedFields
	    &ComputeStepDerivedFields($data{$stepName});
	    # Just do the sanity check for the step as a whole
	    &SanityCheck($sn);
	    $timeStamp = $data{$stepName}{'time'};
	}

    }
    # Calculate derived fields for $g_everyThing field if required
    if (defined($opt_e)) {
	&ComputeDerivedFields($data{$g_everyThing});
	if ($g_allBuckets) {
	    foreach $m (('USER','KERNEL','UTLB')) {
		&ComputeDerivedFields($data{$g_everyThing . "[$m]"});
	    }
	}
    }
    # Now we start printing out!!!
    
    if ( ! $g_everyThing ) {
	&PrintStepTable;
    }
    else {
	&PrintEveryThingTable;
    }


}

sub PrintStepTable {
    my ($stepName, $sn, $modeName);


    print "TABLE_START";
    if ($opt_r) { print " -r"; }
    if ($opt_a) { print " -a"; }
    if ($opt_m) { print " -m"; }
    if ($opt_e) { print " -e"; }
    print "\n";

    printf("%-22s ","");
    
    my (@derivedFields, @xtraStepFields);

    if (! $g_rawData) {
	@derivedFields = @k_stdFields;
	@stepFields = (@derivedFields, @k_xtraStepFields);
    }
    else {
	@derivedFields = @k_rawdataFields;
	if ($g_mipsyData) {
	    @stepFields = (@derivedFields, @k_mipsyrawdataFields);
	} 
        else {
            @stepFields = @derivedFields;
        }
    }

    foreach $fd (@stepFields) {
	printf("%-".$g_fieldWidth ."s ", $fd);
    }
    printf("\n");
    printf("%s\n", "-" x (22+$g_fieldWidth*scalar(@stepFields)));

###################################################################

    if ($g_numSteps > 0) {
	for $sn (0 .. $g_numSteps) {
	    if ($g_allBuckets) {
		foreach $modeName (('USER', 'KERNEL', 'UTLB')) {
		    $buckName = $g_steps[$sn] . "-" . $sn . "-" . $modeName;

		    PrintStep($buckName, \@derivedFields);
		}
	    }
	    else {
		$buckName = $g_steps[$sn] . "-" . $sn;
		PrintStep($buckName, \@stepFields);
	    }
	}
    }
    printf("%s\n", "-" x (22+$g_fieldWidth*scalar(@stepFields)));

    # OK let's print out kernel, user etc totals since we have
    # them anyway

    foreach $mode (keys %modes) {
	PrintStep($mode, \@derivedFields);
    }
    PrintStep("total", \@derivedFields);

}

sub PrintEveryThingTable {
    # Prints out a single step for ALL modes, USER/KERNEL/UTLB
    my ($stepName, $sn, $modeName);

    if (! $g_breakDown) {
	if ($g_allBuckets) {
	    foreach $m (('USER','KERNEL','UTLB')) {
		&PrintEveryTable( $g_everyThing . "[$m]");
	    }
	}
	else {
	    &PrintEveryTable( $g_everyThing );
	}
    }
    else {
	foreach $ref (@g_matchRefs) {
	    &PrintEveryTable( $ref );
	}
    }
}

sub PrintEveryTable {
    my $sName = shift;

    print "TABLE_START";
    if ($opt_r) { print " -r"; }
    if ($opt_a) { print " -a"; }
    if ($opt_m) { print " -m"; }
    if ($opt_e) { print " -e"; }
    print "\n";
    print "Criteria = $sName\n";
    print " " x 22 . $config{'StartCPU'} . "\n";
    print "-" x 30 . "\n";
    foreach $i (@k_everyField) { 
	PrintCount($sName, $i);
    }
    print "-" x 30 . "\n\n";
}

sub PrintCount {
    my $name = shift;
    my $field = shift;
    my $x;

    printf( "%-20s:",$field);
    if( defined($format{$field})) {
	$x = sprintf("$format{$name}",$data{$name}{$field});
    } else { 
	$x = $data{$name}{$field};
    }
    printf("%12s\n", $x);
}

sub GetOptions {


    &Getopts('abmre:i:o:w:');

    if( defined($opt_i) ) {       # input file
	$inputFile = $opt_i;
    } else {
	$inputFile = "cpu.log";
    }


    if( defined($opt_o) ){        # output file
	$output = $opt_o;
    } else { 
	$output = "";
    }
    if ( defined( $opt_a ) ) {    # allBuckets => USER/KERNEL/UTLB
	$g_allBuckets = 1;
    }
    else {
	$g_allBuckets = 0;
    }
    if ( defined( $opt_r ) ) {    # raw counts!
	if ( defined($opt_m) ) {  # Can only specify -m with -r
	    $g_mipsyData = 1;
	}
	$g_rawData = 1;
	$g_fieldWidth = 12;
    }
    else {
	$g_rawData = 0;
    }

    if ( defined( $opt_e ) ) {   # everything => print out all fields!
	$g_everyThing = $opt_e;  # opt_e is the criteria argument
	$g_criteria = $g_everyThing;
	$g_criteria =~ s/#stepName#/\$g_name/g;
	$g_criteria =~ s/#stepChronos#/\$g_chronos/g;
	$g_criteria =~ s/#stepMode#/\$g_mode/g;
	if (defined( $opt_b ) ) {  # b for breakdown???
	    $g_breakDown = $opt_b;
	}
	if (defined( $opt_w ) ) {  # w => weighting factors come into play
	    if ( ! ($opt_w =~ /\([0-9\.]+(,[0-9\.]+)*\)/ ) ) {
		print STDERR "Invalid argument for -w.  Must be a Perl array of numbers!!\n";
		@g_weights = (1);
	    }
	    else {
		@g_weights = eval $opt_w;
	    }
	}
    }

    if (defined($ENV{'SIMTOOLS'}) ) { 
	$xx = "$ENV{'SIMTOOLS'}/apps/scripts";
	print STDERR "Add $xx to search path\n";
	unshift(@INC,$xx);
    } else { 
	print STDERR "SIMTOOLS is not an environment variable \n";
    }
    require "simos-lib.prl";

}

sub PrintLine {
    my $i;
    my $mode;
    foreach $i (0..$numModes-1) {
        $mode = $modesT[$i];
        printf("%12s ",$x{$mode});
    }  
    printf("| %12s\n",$x{$modesT[$numModes]});
}

    
sub PrintStep {
    my $name = shift;
    my $fields_ptr = shift;
    my $i;
    my $val;

    # Start by printing the name of the step
    printf( "%-22s:",$name);

    # Then go through each passed in field to be printed...
    foreach $i (0..$#$fields_ptr) {
	$field = $$fields_ptr[$i];
        if (defined($data{$name}{$field})) {
	    if( defined($format{$field})) {
		$val = sprintf("$format{$field}",$data{$name}{$field});
	    } else { 
		$val = $data{$name}{$field};
	    }			# 
	    printf("%-".$g_fieldWidth."s ", $val);
	}
	else {
	    printf("%12s", " ");
	}
    }
    printf("\n");
}


sub ModesFilter { 
    my $name = shift;

    if( defined($definedModes{$name})) {
        if (!defined($modes{$name})) { 
            $modes{$name} = 1;
            $numModes++;    
        }
        return $name;
    } 
    elsif ($name =~ /(\w+)-(\d+)-(USER|KERNEL|UTLB)/) {
	# Got a step function name
	# DON'T add into the %modes hash, because otherwise
	# we will include it in the "TOTALs".  Only
	# want to print out the actual numbers
	if ($2 > $g_numSteps+1) {
	    print STDERR "ModesFilter ERROR: Steps not consecutively numbered\n";
	}
	else {
	    $g_numSteps = $2;
	}
	if (! defined( $g_steps[$2] ) ) {
	    $g_steps[$2] = $1;  
	}
	elsif ($g_steps[$2] ne $1) {
	    print STDERR "ModesFilter ERROR: Two same numbered steps with different names!\n";
	}
	return $name;
    }

    else { 
        return "";
    }
}


sub SanityCheck {
    my $sn = shift;  # First parameter is the step number to sanity check
    my $last_time;
    my ($prev_buckname, $buckname);

    if ($sn == 0) {
	$buckname = $g_steps[$sn] . "-" . $sn;
	if ( $data{$buckname}{'_cycles'} != $data{$buckname}{'time'}) {
	    print STDERR "SanityCheck: Timestamps don't match with cycles (diff = " . ($data{$buckname}{'time'} - $data{$buckname}{'_cycles'}) . ") for sn = $sn!\n";
	}
    }
    else {
	$prev_buckname = $g_steps[$sn-1] . "-" . ($sn-1);
	$buckname = $g_steps[$sn]. "-" . $sn;
	$last_time = $data{$prev_buckname}{'time'};

	if ( ($last_time + $data{$buckname}{'_cycles'}) != 
	    $data{$buckname}{'time'}) {
	    print STDERR "SanityCheck: Timestamps don't match with cycles (diff = " . ($data{$buckname}{'time'} - ($last_time + $data{$buckname}{'_cycles'})) . ") for sn = $sn!\n";

	}
    }

}


sub ComputeStepDerivedFields {
    my $f = shift;   # The step bucket - DON'T PASS one of the individual
				# user/kernel/utlb buckets!
				# ALSO, ComputeDerivedFields should
				# have already been called on these!
    
    my $name = $f->{'bucketName'};

    my $user = $data{$name . "-USER"};
    my $kernel = $data{$name . "-KERNEL"};
    my $utlb = $data{$name . "-UTLB"};

    # OK, first step is to compute % time spent in user/kernel/utlb
    # as a pct of total time for bucket...

    if ($f->{'_cycles'} != 0) {
	$f->{'UserPct'} = 100*$user->{'_cycles'} / $f->{'_cycles'};
	$f->{'KernelPct'} = 100*$kernel->{'_cycles'} / $f->{'_cycles'};
	$f->{'UTlbPct'} = 100*$utlb->{'_cycles'} / $f->{'_cycles'};
    }
    else {
	$f->{'UserPct'} = -1.0;
	$f->{'KernelPct'} = -1.0;
	$f->{'UTlbPct'} = -1.0;
    }
    if ($f->{'_instr'} != 0) {
	$f->{'UserIPct'} = 100*$user->{'_instr'} / $f->{'_instr'};
	$f->{'KernelIPct'} = 100*$kernel->{'_instr'} / $f->{'_instr'};
	$f->{'UTlbIPct'} = 100*$utlb->{'_instr'} / $f->{'_instr'};
    }
    else {
	$f->{'UserIPct'} = -1.0;
	$f->{'KernelIPct'} = -1.0;
	$f->{'UTlbIPct'} = -1.0;
    }
    # Should check for UTLB numbers being approximately right...
    # i.e. by taking dTLB,iTLB numbers together and computing
    # avg tlb miss time

    if (($user->{'dTlb'} + $user->{'iTlb'}) != 0) {
	$f->{'avgUTlb'} = $utlb->{'_cycles'} / ($user->{'dTlb'} + $user->{'iTlb'});
    }
    else {
	$f->{'avgUTlb'} = -1.0;
    }

}

sub MatchCriteria {
    # Pass the bucket name, chronos and mode
    # If this matches the criteria passed on the command line
    # then return 1, otherwise return -1

    my ($lname, $lchronos, $lmode) = @_;

    $g_name = $lname; $g_chronos = $lchronos;
    $g_mode = $lmode;
    # Only necessary because perl5 falls over on trying to access
    # local variables in an eval script...

    $result = eval($g_criteria);
    if (! defined($result)) {
	print STDERR "Error in evaluation string: $@\n";
	return -1;
    }
    else {
	if ($result) {
	    return 1;
	}
	else {
	    return -1;
	}
    }
}