#!/u/gts/perl5/bin/perl

# Author: Greg Sullivan
#
# NOTE: most of this script is based on the format produced by compiler-timings.pl. 
#       any change in compiler-timings.pl must be mirrored in this script.
#
# NOTE: 'visibility' stuff is here for backwards compatiability -- 
#       take out eventually (gts,98oct15)

## use FileHandle;
use File::Basename;

use Getopt::Std;
use Math::BigFloat;

sub file_to_table;
sub write_summary_data;
sub write_phase_data;
sub calc_change;
sub sum_over;

getopts("haeo:pw");

if ($opt_h || @ARGV == 0) {
    print <<EOF;

compare-timings.pl:

A perl script to generate reports from data files generated by
compiler-timings.pl.

If two data files are given, produces a report of percent changes in
corresponding numbers from the two data files.  The assumption is 
that the second file is more recent, so percent change is calculated in
terms of change from the first to the second file.

Compiler data is divided into several parts:
  * per library summary data:  for each library, LPM, MB allocated, 
      total time, number of lines, and database size.
  * per library per phase timing data:  the compiler gives timing info 
      for each compiler phase: sources, modeling, optimization, etc.
  * per library per phase allocation data: like timing, except 
      MB allocated rather than seconds spent.

Per library summary data is always reported, though you can choose
whether to report on all libraries or on just the "Totals" and "Averages" 
derived libraries.  (the default is just "Totals" and "Averages")
For two libraries, the derived libraries reported by default are called
"CommonTotals" and "CommonAverages" -- which represent the totals and 
averages calculated over libraries common to both datasets.

Note that the LPM (Lines per minute) given for Totals and CommonTotals 
derived libraries is calculated by dividing the total lines by the total
minutes (as opposed to adding up all the LPM numbers, which would be 
useless).


OPTIONS:
  -a       all libraries (otherwise only totals and averages)
  -o file  output file name (otherwise stdout)
  -p       include compiler phase info (otherwise only summary info)
  -w       wide output (single line per library)
             - otherwise narrow (multiple lines per library))
  -e       report on libraries with an increase in serious warnings 
             and/or warnings. This option only makes sense when given
             two data sets.
	    
USAGE:
  perl compare-timings.pl logs1\\compiler-data.out logs2\\compiler-data.out

EOF

    exit;
}

if ($opt_o) {
    open (OUTF, ">$opt_o");
    select OUTF;
}

$file1 = shift;
$file2 = shift;

# suck in files

%tables1 = ();
file_to_tables($file1, \%tables1);

## if we're comparing two data sets
if ($file2)
{
    %tables2 = ();
    file_to_tables($file2, \%tables2);

    print "\nComparing data from $file1 (",
      scalar(keys(%{$tables1{SUMMARY}})), " libraries)\n";
    print "     with data from $file2 (",
      scalar(keys(%{$tables2{SUMMARY}})), " libraries)\n";

    %change_tables = ();

    # find libraries in both logs, 

    $count_both = 0;
    @common_libs = ();
    ($table1, $table2) = ($tables1{SUMMARY},
			  $tables2{SUMMARY});
    foreach $libname (sort keys %{$table1})
    {
	if (exists($$table2{$libname}))
	{
	    $count_both++;
	    push @common_libs, ($libname);
	} else {
	    ## print "Library $libname in $file1 but not in $file2.\n";
	};
    }

    print "Number of libraries in common: $count_both\n";

    # for table1 and table2, calculate the Totals and Averages numbers
    # common libraries

    foreach $tables (\%tables1, \%tables2)
    {
	$sum_lines = sum_over(\@common_libs, $tables->{SUMMARY}, lines);
	$sum_secs = sum_over(\@common_libs, $tables->{SUMMARY}, secs);
	$newrec = {
	    lpm => ($lpm = $sum_lines / ($sum_secs / 60)),
	    lines => $sum_lines,
	    secs => $sum_secs,
	    mem => ($mem = sum_over(\@common_libs, $tables->{SUMMARY}, mem)),
	    dbsize => ($dbsize = sum_over(\@common_libs, $tables->{SUMMARY}, dbsize)),
	    datasize => ($datasize = sum_over(\@common_libs, $tables->{SUMMARY}, datasize)),
	    codesize => ($codesize = sum_over(\@common_libs, $tables->{SUMMARY}, codesize)),
	    warnings => ($warnings = sum_over(\@common_libs, $tables->{SUMMARY}, warnings)),
	    serious => ($serious = sum_over(\@common_libs, $tables->{SUMMARY}, serious)),
	    nits => ($nits = sum_over(\@common_libs, $tables->{SUMMARY}, nits)),
	};
	$tables->{SUMMARY}->{"CommonTotals"} = $newrec;

	if ($count_both > 0)
	{
	    $newrec = {
		lpm => sum_over(\@common_libs, $tables->{SUMMARY}, lpm) / $count_both,
		lines => $lines / $count_both,
		secs => $secs / $count_both,
		mem => $mem / $count_both,
		dbsize => $dbsize / $count_both,
		datasize => $datasize / $count_both,
		codesize => $codesize / $count_both,
		warnings => $warnings / $count_both,
		serious => $serious / $count_both,
		nits => $nits / $count_both,
	    };
	    $tables->{SUMMARY}->{"CommonAverages"} = $newrec;
	}

	foreach $stuff (TIME, MEM)
	{
	    $newrec = {
		sources => ($sources = sum_over(\@common_libs, $tables->{$stuff}, sources)),
		definitions => ($definitions = sum_over(\@common_libs, $tables->{$stuff}, definitions)),
		models => ($models = sum_over(\@common_libs, $tables->{$stuff}, models)),
		finishing => ($finishing = sum_over(\@common_libs, $tables->{$stuff}, finishing)),
		checking => ($checking = sum_over(\@common_libs, $tables->{$stuff}, checking)),
		dfmc => ($dfmc = sum_over(\@common_libs, $tables->{$stuff}, dfmc)),
		bindings => ($bindings = sum_over(\@common_libs, $tables->{$stuff}, bindings)),
		typing => ($typing = sum_over(\@common_libs, $tables->{$stuff}, typing)),
		optimization => ($optimization = sum_over(\@common_libs, $tables->{$stuff}, optimization)),
		coloring => ($coloring = sum_over(\@common_libs, $tables->{$stuff}, coloring)),
		visibility => ($visibility = sum_over(\@common_libs, $tables->{$stuff}, visibility)),
		preheaping => ($preheaping = sum_over(\@common_libs, $tables->{$stuff}, preheaping)),
		heaping => ($heaping = sum_over(\@common_libs, $tables->{$stuff}, heaping)),
		emitting => ($emitting = sum_over(\@common_libs, $tables->{$stuff}, emitting)),
		linking => ($linking = sum_over(\@common_libs, $tables->{$stuff}, linking)),
		glue => ($glue = sum_over(\@common_libs, $tables->{$stuff}, glue)),
		stripping => ($stripping = sum_over(\@common_libs, $tables->{$stuff}, stripping)),
		db => ($db = sum_over(\@common_libs, $tables->{$stuff}, db)),
	    };

	    $tables->{$stuff}->{"CommonTotals"} = $newrec;

	    if ($count_both > 0)
	    {
		$newrec = {
		    sources => $sources / $count_both,
		    definitions => $definitions / $count_both,
		    models => $models / $count_both,
		    finishing => $finishing / $count_both,
		    checking => $checking / $count_both,
		    dfmc => $dfmc / $count_both,
		    bindings => $bindings / $count_both,
		    typing => $typing / $count_both,
		    optimization => $optimization / $count_both,
		    coloring => $coloring / $count_both,
		    visibility => $visibility / $count_both,
		    preheaping => $preheaping / $count_both,
		    heaping => $heaping / $count_both,
		    emitting => $emitting / $count_both,
		    linking => $linking / $count_both,
		    glue => $glue / $count_both,
		    stripping => $stripping / $count_both,
		    db => $db / $count_both,
		};
		$tables->{$stuff}->{"CommonAverages"} = $newrec;
	    }
	}
    }
    
    # fill change_tables

    push @common_libs, ("CommonTotals", "CommonAverages");

    # -- do per library summary info

    $change_tables{SUMMARY} = {};
    ($change_table, $table1, $table2) = ($change_tables{SUMMARY},
					 $tables1{SUMMARY},
					 $tables2{SUMMARY});

    foreach $libname (@common_libs)
    {
	$newrec = {
	    lpm => calc_change($table1->{$libname}{lpm}, $table2->{$libname}{lpm}),
	    lines => calc_change($table1->{$libname}{lines}, $table2->{$libname}{lines}),
	    secs => calc_change($table1->{$libname}{secs}, $table2->{$libname}{secs}),
	    mem => calc_change($table1->{$libname}{mem}, $table2->{$libname}{mem}),
	    dbsize => calc_change($table1->{$libname}{dbsize}, $table2->{$libname}{dbsize}),
	    datasize => calc_change($table1->{$libname}{datasize}, $table2->{$libname}{datasize}),
	    codesize => calc_change($table1->{$libname}{codesize}, $table2->{$libname}{codesize}),
	    warnings => calc_change($table1->{$libname}{warnings}, $table2->{$libname}{warnings}),
	    serious => calc_change($table1->{$libname}{serious}, $table2->{$libname}{serious}),
	    nits => calc_change($table1->{$libname}{nits}, $table2->{$libname}{nits}),
	};
	$change_table->{$libname} = $newrec;
    }

    # -- do compiler phases -- timing and allocation

    foreach $stuff (TIME, MEM) {
	## print STDERR "doing stuff $stuff.\n";
	$change_tables{$stuff} = {};
	($change_table, $table1, $table2) = ($change_tables{$stuff},
					     $tables1{$stuff},
					     $tables2{$stuff});
	foreach $libname (@common_libs) {
	    $newrec = {
		sources => calc_change($table1->{$libname}{sources}, $table2->{$libname}{sources}),
		definitions => calc_change($table1->{$libname}{definitions}, $table2->{$libname}{definitions}),
		models => calc_change($table1->{$libname}{models}, $table2->{$libname}{models}),
		finishing => calc_change($table1->{$libname}{finishing}, $table2->{$libname}{finishing}),
		checking => calc_change($table1->{$libname}{checking}, $table2->{$libname}{checking}),
		dfmc => calc_change($table1->{$libname}{dfmc}, $table2->{$libname}{dfmc}),
		bindings => calc_change($table1->{$libname}{bindings}, $table2->{$libname}{bindings}),
		typing => calc_change($table1->{$libname}{typing}, $table2->{$libname}{typing}),
		optimization => calc_change($table1->{$libname}{optimization}, $table2->{$libname}{optimization}),
		coloring => calc_change($table1->{$libname}{coloring}, $table2->{$libname}{coloring}),
		visibility => calc_change($table1->{$libname}{visibility}, $table2->{$libname}{visibility}),
		preheaping => calc_change($table1->{$libname}{preheaping}, $table2->{$libname}{preheaping}),
		heaping => calc_change($table1->{$libname}{heaping}, $table2->{$libname}{heaping}),
		emitting => calc_change($table1->{$libname}{emitting}, $table2->{$libname}{emitting}),
		linking => calc_change($table1->{$libname}{linking}, $table2->{$libname}{linking}),
		glue => calc_change($table1->{$libname}{glue}, $table2->{$libname}{glue}),
		stripping => calc_change($table1->{$libname}{stripping}, $table2->{$libname}{stripping}),
		db => calc_change($table1->{$libname}{db}, $table2->{$libname}{db}),
	    };
	    $change_table->{$libname} = $newrec;
	}   
    }
    $the_tables = \%change_tables;
}
else 
{
    print "\nUsing data from $file1\n";
    $the_tables = \%tables1;
    print "  Number of libraries: ", keys(%{$the_tables->{SUMMARY}}) - 2, "\n\n";
}

## prepare to write

$^L = "\n";

if ($opt_a) {        ## all libraries?
    @libs = sort keys %{$the_tables->{SUMMARY}}; 
} else {
    if ($file2) {
	@libs = ("CommonTotals", "CommonAverages");
    } else {
	@libs = ("Totals", "Averages");
    }
}

## per library summary info

if ($opt_w) {        ## wide?
    $^ = "top_summary_wide";
    $~ = "body_summary_wide";
} else {             ## narrow
    $^ = "top_summary_narrow";
    $~ = "body_summary_narrow";
}

if ($file2)
{
    print "\nSummary data for $file1:\n";
    write_summary_data \%tables1, ["CommonTotals", "CommonAverages"];
    $- = 0;              ## force new page
    print "\nSummary data for $file2:\n";
    write_summary_data \%tables2, ["CommonTotals", "CommonAverages"];
    $- = 0;              ## force new page
    print "\nSummary of changes:\n";
    print "\n  *** All numbers given are PERCENT CHANGE from 1st to 2nd dataset ***\n";
    write_summary_data \%change_tables, \@libs;
} else {
    print "\nSummary data for $file1\n";
    write_summary_data \%tables1, \@libs;
}

## compiler phase data

if ($opt_p) {            ## do compiler phases?
    $- = 0;              ## force new page
    if ($opt_w) {        ## wide?
	$^ = "top_phases_wide";
	$~ = "body_phases_wide";
    } else {             ## narrow
	$^ = "top_phases_narrow";
	$~ = "body_phases_narrow";
    }

    if ($file2)
    {
	print "\nSummary of Phase data for $file1:\n";
	write_phase_data \%tables1, ["CommonTotals", "CommonAverages"];
	$- = 0;              ## force new page
	print "\nSummary of Phase data for $file2:\n";
	write_phase_data \%tables2, ["CommonTotals", "CommonAverages"];
	$- = 0;              ## force new page
	print "\nSummary of changes:\n";
	print "\n  *** All numbers given are PERCENT CHANGE from 1st to 2nd dataset ***\n";
	write_phase_data \%change_tables, \@libs;
    } else {
	print "\nPhase data for $file1\n";
	write_phase_data \%tables1, \@libs;
    }
}

## warning count change report

if ($file2 && $opt_e) {
    $^ = "top_warnings";
    $~ = "body_warnings";
    $- = 0;                  ## force header

    foreach $libname (@common_libs) {
	if ($libname ne "Averages" && $libname ne "Totals" &&
	    $libname ne "CommonAverages" && $libname ne "CommonTotals") {
	    $serious1 = $tables1{SUMMARY}->{$libname}->{serious};
	    $serious2 = $tables2{SUMMARY}->{$libname}->{serious};
	    $warn1 = $tables1{SUMMARY}->{$libname}->{warnings};
	    $warn2 = $tables2{SUMMARY}->{$libname}->{warnings};

	    ## print "$libname: s1=$serious1, s2=$serious2, w1=$warn1, w2=$warn2.\n";
	    if ($serious2 > $serious1 || $warn2 > $warn1) {
		write;
	    }
	}
    }
}



exit;



sub write_summary_data {
    $tables = shift;
    $libs = shift;

    $table = $tables->{SUMMARY};

    foreach $libname (@$libs) {
	$rec = $table->{$libname};
	($secs, $lines, $lpm, $mem, $dbsize, $datasize, $codesize, $serious, $warnings, $nits)
	    = ($rec->{secs}, $rec->{lines},
	       $rec->{lpm}, $rec->{mem}, $rec->{dbsize}, $rec->{datasize}, $rec->{codesize},
	       $rec->{serious}, $rec->{warnings}, $rec->{nits});
	write;
    }
}


sub write_phase_data {

    $tables = shift;
    $libs = shift;
    
    foreach $stuff (TIME, MEM) {
	$- = 0;    # force header
	if ($stuff eq TIME) {
	    print "\nTIME (seconds) per phase per library:\n\n";
	} else {
	    print "\nALLOCATION (MB) per phase per library:\n\n";
	}

	foreach $libname (@$libs) {
	    $count++;
	    $rec = $tables->{$stuff}->{$libname};
	    $lines = $tables->{SUMMARY}->{$libname}->{lines};

	    ($sources,$definitions,$models,$finishing,$checking, $dfmc,
	     $bindings,$typing,$optimization,$coloring,$visibility,$preheaping,
	     $heaping,$emitting,$linking,$glue,$stripping,$db) =
		 ($rec->{sources},$rec->{definitions},$rec->{models},$rec->{finishing},
		  $rec->{checking},$rec->{dfmc},$rec->{bindings},$rec->{typing},
		  $rec->{optimization},$rec->{coloring},$rec->{visibility},$rec->{preheaping},
		  $rec->{heaping},$rec->{emitting},$rec->{linking},$rec->{glue},
		  $rec->{stripping},$rec->{db});
	    write;
	}
    }
}


sub file_to_tables {
    $file = shift;
    $tables = shift;       ## a table of tables (such as allocation, timing, db)

    open INF, "<$file";

    ($in_summary_data, $in_details, $stuff) = (0,0,"");

    while ($line = <INF>) {

	if ($line =~ /^\s*$/) {
	    next;
	}

	if ($line =~ /per library.*data/) {
	    ($in_summary_data, $in_details, $stuff) = (0,0,"");
	}

	if ($line =~ /per library per phase allocation data/) {
	    $stuff = MEM;
	    $tables->{$stuff} = {};
	} elsif ($line =~ /per library per phase timing data/) {
	    $stuff = TIME;
	    $tables->{$stuff} = {};
	} elsif ($line =~ /per library summary data/) {
	    $stuff = SUMMARY;
	    $tables->{$stuff} = {};
	} 

	if ($stuff eq SUMMARY && $line =~ /^--------/) {   ## notes end of labels -- also skips 
	    $in_summary_data = 1;                            ## separators before summaries
	} elsif ($line =~ /^--------/ && ($stuff eq TIME || $stuff eq MEM)) {
	    $in_details = 1;
	} elsif ($in_summary_data == 1) {

	    ($libname, $secs, $lines, $lpm, $mem, $dbsize, $datasize, $codesize, $serious, $warnings, $nits) = split ' ', $line;

	    $newrec = {
		secs => $secs,
		lines => $lines,
		lpm => $lpm,
		mem => $mem,
		dbsize => $dbsize,
		datasize => $datasize,
		codesize => $codesize,
		warnings => $warnings,
		serious => $serious,
		nits => $nits,
	    };
	    $tables->{$stuff}->{$libname} = $newrec;

	    ## print "tables{$stuff}->{$libname}->{warnings} = ",
	    ##   $tables->{$stuff}->{$libname}->{warnings}, " ($warnings)\n";

	} elsif ($in_details == 1) {

	    ($libname,$sources,$definitions,$models,$finishing,$checking,$dfmc,$bindings,$typing,$optimization,$coloring,$visibility,$preheaping,$heaping,$emitting,$linking,$glue,$stripping,$db) =
		split ' ', $line;

	    $newrec = {
		sources => $sources,
		definitions => $definitions,
		models => $models,
		finishing => $finishing,
		checking => $checking,
		dfmc => $dfmc,
		bindings => $bindings,
		typing => $typing,
		optimization => $optimization,
		coloring => $coloring,
		visibility => $visibility,
		preheaping => $preheaping,
		heaping => $heaping,
		emitting => $emitting,
		linking => $linking,
		glue => $glue,
		stripping => $stripping,
		db => $db,
	    };
	    $tables->{$stuff}->{$libname} = $newrec;
	    ## print "got lib ", $libname, " with lpm of ", $table->{$libname}{lpm}, "\n";
	}
    }  ## end while
    close INF;
}  ## end sub file_to_table


sub calc_change {
    $n1 = shift;
    $n2 = shift;

    if ($n1 == 0) {
	if ($n2 == 0) {
	    return 0;
	} else {
	    return "NAN";         ## Not A Number
	}
    } else {
	return 100 * (($n2 - $n1) / $n1);
    }
}

sub sum_over {
    $libs_ref = shift;
    $table_ref = shift;
    $key = shift;
    $sum = 0;
    foreach $libname (@{$libs_ref})
    {
	if (($libname !~ "Totals") && ($libname !~ "Averages")) {
	    $sum += $table_ref->{$libname}{$key}
	}
    }
    $sum;
}


## this line is 80 char.s  -----------------------------------------------------


format top_summary_narrow =
----------------------------------------------------------------------
.

format body_summary_narrow =
Library:  @<<<<<<<<<<<<<<
          $libname
   Time (secs):     @<<<<<<<<< Lines:        @<<<<<<<  LPM:  @<<<<<<<
                    $secs,                   $lines,          $lpm
   Allocation (MB): @<<<<<<<   DB (bytes):   @<<<<<<<<
                    $mem,                    $dbsize
   Data (bytes):    @<<<<<<<   Code (bytes): @<<<<<<<<
                    $datasize,               $codesize
   Serious warns:   @<<<<<     Warnings:     @<<<<<<   Nits: @<<<<<<<
                    $serious,                $warnings,      $nits
.

## this line is 80 char.s  -----------------------------------------------------

format top_phases_narrow =
.

format body_phases_narrow =
Library:  @<<<<<<<<<<<<<<<<<<         (lines: @<<<<<<<)
$libname, $lines
   sources: @<<<<<<<<  defs:    @<<<<<<<<  models:  @<<<<<<<<
            $sources,           $definitions,       $models
   finish:  @<<<<<<<<  checks:  @<<<<<<<<  dfmc:    @<<<<<<<<
            $finishing,         $checking,          $dfmc
   binding: @<<<<<<<<  typing:  @<<<<<<<<  opts:    @<<<<<<<<
            $bindings,          $typing,            $optimization
   color:   @<<<<<<<<  visible: @<<<<<<<<  preheap: @<<<<<<<<
            $coloring,          $visibility,        $preheaping
   heaping: @<<<<<<<<  emit:    @<<<<<<<<  linking: @<<<<<<<<
            $heaping,           $emitting,          $linking
   glue:    @<<<<<<<<  strip:   @<<<<<<<<  dbs:     @<<<<<<<<
            $glue,              $stripping,         $db
.



format top_warnings =

---------- Libraries with increases in warning or serious warning counts:

Library              Serious1    Serious2       Warnings1    Warnings2
.

format body_warnings =
@<<<<<<<<<<<<<<<<<   @<<<<<<     @<<<<<<        @<<<<<<      @<<<<<<
$libname,            $serious1,  $serious2,     $warn1,      $warn2
.



### THE FOLLOWING FORMATS ARE COPIED FROM COMPILER-TIMINGS.PL

format top_summary_wide =
Library             Time       Lines     LPM        Allocation  Database     Data       Code     Serious   Warnings   Nitpicks
                    (secs)                             (MB)     (bytes)     (bytes)    (bytes)   Warnings
-------------------------------------------------------------------------------------------------------
.

format body_summary_wide = 
@<<<<<<<<<<<<<<<<<  @<<<<<<<   @<<<<<<<  @<<<<<<<   @<<<<<<<    @<<<<<<<<  @<<<<<<<<  @<<<<<<<<  @<<<<<    @<<<<<<    @<<<<<<
$libname, $secs, $lines, $lpm, $mem, $dbsize, $datasize, $codesize, $serious, $warnings, $nits
.



format top_phases_wide =
Library            sources defs    models  finish  checks  dfmc    binding typing  opts    color   visible preheap heaping emitting linking glue    strip   dbs
-------------------------------------------------------------------------------------------------------------------------------------------------------------------
.

format body_phases_wide =
@<<<<<<<<<<<<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<< @<<<<<<
$libname,$sources,$definitions,$models,$finishing,$checking,$dfmc,$bindings,$typing,$optimization,$coloring,$visibility,$preheaping,$heaping,$emitting,$linking,$glue,$stripping,$db
.

