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

# Author: Greg Sullivan
#
# NOTE: 'visibility' stuff is here for backwards compatiability -- 
#       take out eventually (gts,98oct15)
#
# Historical note:  this script was initially only for extracting timing
#   data; hence its name.  

## use FileHandle;
use File::Basename;
use File::DosGlob 'glob';

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

sub write_phase_table;
sub write_summary_table;

getopts("ho:");

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

compiler-timings.pl:

A perl script to extract data from log files generated by the compiler.

Two derived libraries are added to the log: "Totals" and "Averages".
For "Totals", the LPM is not the sum of the LPM numbers for all 
libraries (which would be useless), but the total lines divided 
by the total minutes.


OPTIONS:
  -o filename   filename in which to store data (default is stdout)
  -h            print this info
	    
USAGE:
  perl compiler-timings.pl -o compiler-data.out compile-*.log

EOF
    exit;
}

# Ex.s:
# //+   Preheaping                -   3%       1.106686     3%       0.822136 
# //+   Heaping                   -  12%       4.235461    15%       4.557488 
# //+   Linking                   -   8%       2.800065     7%       2.097156 
# //+   Glue gen                  -   0%       0.096791     0%       0.136196 

# regexp's start after keyword match (e.g. "Heaping")

$to_secs = "\\s*-\\s*\\d*\\%\\s*";
## backwards compatibility: deal with "seconds" after timing number:
$to_alloc =       "[\\s\\w]*\\d*\\%\\s*";

$serious_regexp = "^Serious warning";
$warn_regexp = "^Warning";
$nitpick_regexp = "defined but not referenced or exported";

($warnings, $serious, $nits) = (0,0,0);

%summary_table = ();
%time_table = ();
%alloc_table = ();
%dupe_table = ();

$old_basename = "";
$in_timings = 0;
$prev_line = "";

@args = @ARGV;
@ARGV = ();
foreach $arg (@args) { @ARGV = (@ARGV, glob $arg) }

while ($line = <>) {
    $basename = basename($ARGV,".log");

    if ($basename ne $old_basename) {   ## new log file
	$old_basename = $basename;
	$in_timings = 0;
	## print "File: $ARGV\n";
    }

    if ($line =~ "Time taken per phase:") {
	$in_timings = 1;

	($lpm, $lines, $heap, $secs, $mem, $dbsize, $datasize, $codesize) = (0,0,0,0,0,0,0,0);

	($sources_time, $definitions_time, $models_time, $finishing_time) = (0,0,0,0);
	($checking_time, $dfmc_time, $bindings_time, $typing_time, $optimization_time) = (0,0,0,0,0);
	($coloring_time, $visibility_time, $preheaping_time, $heaping_time, $emitting_time) = (0,0,0,0,0);
	($linking_time, $glue_time, $stripping_time, $db_time) = (0,0,0,0);

	($sources_alloc, $definitions_alloc, $models_alloc, $finishing_alloc) = (0,0,0,0);
	($checking_alloc, $dfmc_alloc, $bindings_alloc, $typing_alloc, $optimization_alloc) = (0,0,0,0,0);
	($coloring_alloc, $visibility_alloc, $preheaping_alloc, $heaping_alloc, $emitting_alloc) = (0,0,0,0,0);
	($linking_alloc, $glue_alloc, $stripping_alloc, $db_alloc) = (0,0,0,0);
    }

    # use "Linking" line to identify the current library being compiled

    if (($mmm) = ($line =~ /Linking object files of.*: (\S*) in/)) {
	$libname = $mmm;

	if ($time_table{$libname}) {
	    if ($dupe_table{$libname}) {
		$dupe_count = $dupe_table{$libname};
		$dupe_table{$libname} = $dupe_count + 1;
		$libname = "$libname#$dupe_count";
	    } else {
		$dupe_table{$libname} = 3;
		$libname = "$libname#2";
	    }
	    print "Duplicate of $mmm, renamed to $libname\n";
	}
    }   # if line =~ "Linking"

    if (($mmm) = ($line =~ /Linking object files for.*: (\S*) in/)) {
	$libname = $mmm;

	if ($time_table{$libname}) {
	    if ($dupe_table{$libname}) {
		$dupe_count = $dupe_table{$libname};
		$dupe_table{$libname} = $dupe_count + 1;
		$libname = "$libname#$dupe_count";
	    } else {
		$dupe_table{$libname} = 3;
		$libname = "$libname#2";
	    }
	    print "Duplicate of $mmm, renamed to $libname\n";
	}
    }   # if line =~ "Linking"

    ## Note that heap number is amount of memory still live after compilation (and GC)
    ## if compiling multiple libraries (update-libraries), this should grow as vestiges 
    ## of earlier libraries stay, legitimately, in memory.
    ## That is, the heap allocated number is pretty useless, statistically.

    if (($heap) = ($line =~ /Heap Allocated (\d*) Total .* Free/)) {

	## done with this set of numbers

	$in_timings = 0;

	$newrec = {
	    lpm => $lpm,
	    lines => $lines,
            secs => $secs,
            mem => $mem,
	    heap => $heap,
	    dbsize => $dbsize,
	    datasize => $datasize,
	    codesize => $codesize,
	    warnings => $warnings,
	    serious => $serious,
	    nits => $nits,
	};
	$summary_table{$libname} = $newrec;

	($warnings, $serious, $nits) = (0,0,0);

	$newrec = {
	    sources => $sources_time,
	    definitions => $definitions_time,
	    models => $models_time,
	    finishing => $finishing_time,
	    checking => $checking_time,
	    dfmc => $dfmc_time,
	    bindings => $bindings_time,
	    typing => $typing_time,
	    optimization => $optimization_time,
	    coloring => $coloring_time,
	    visibility => $visibility_time,
	    preheaping => $preheaping_time,
	    heaping => $heaping_time,
	    emitting => $emitting_time,
	    linking => $linking_time,
	    glue => $glue_time,
	    stripping => $stripping_time,
	    db => $db_time,
	    };
	$time_table{$libname} = $newrec;

	$newrec = {
	    sources => $sources_alloc,
	    definitions => $definitions_alloc,
	    models => $models_alloc,
	    finishing => $finishing_alloc,
	    checking => $checking_alloc,
	    dfmc => $dfmc_alloc,
	    bindings => $bindings_alloc,
	    typing => $typing_alloc,
	    optimization => $optimization_alloc,
	    coloring => $coloring_alloc,
	    visibility => $visibility_alloc,
	    preheaping => $preheaping_alloc,
	    heaping => $heaping_alloc,
	    emitting => $emitting_alloc,
	    linking => $linking_alloc,
	    glue => $glue_alloc,
	    stripping => $stripping_alloc,
	    db => $db_alloc,
	    };
	$alloc_table{$libname} = $newrec;

	## print STDERR "for $libname, time =", $newrec->{secs}, ", MB alloc'ed =", $newrec->{mem}, "\n";
	## print STDERR "\tlpm =", $newrec->{lpm}, ", opt time =", $time_table{$libname}->{optimization};
	## print STDERR ", opt alloc =", $alloc_table{$libname}->{optimization}, "\n";
    }      ## if line =~ "Heap allocated"

    if ($in_timings) {
	if (($mmm, $nnn) = ($line =~ /Updating sources$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $sources_time = $mmm;
	    $sources_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Updating definitions$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $definitions_time = $mmm;
	    $definitions_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Model object computation$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $models_time = $mmm; 
	    $models_alloc = $nnn 
	} elsif (($mmm, $nnn) = ($line =~ /Model finishing$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $finishing_time = $mmm;
	    $finishing_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Model checking$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $checking_time = $mmm;
	    $checking_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /DFM generation$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $dfmc_time = $mmm;
	    $dfmc_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Checking bindings$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $bindings_time = $mmm;
	    $bindings_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Initial type inference$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $typing_time = $mmm;
	    $typing_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Optimization$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $optimization_time = $mmm;
	    $optimization_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Dispatch coloring$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $coloring_time = $mmm;
	    $coloring_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /External visibility$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $visibility_time = $mmm;
	    $visibility_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Preheaping$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $preheaping_time = $mmm;
	    $preheaping_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Heaping$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $heaping_time = $mmm;
	    $heaping_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Emitting$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $emitting_time = $mmm;
	    $emitting_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Linking$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $linking_time = $mmm;
	    $linking_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Glue gen$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $glue_time = $mmm;
	    $glue_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Stripping$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $stripping_time = $mmm;
	    $stripping_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Saving Database$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $db_time = $mmm;
	    $db_alloc = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Sum$to_secs([\d\.]*)$to_alloc([\d\.]*)\s*/)) {
	    $secs = $mmm;
	    $mem = $nnn;
	} elsif (($mmm, $nnn) = ($line =~ /Compiled (.*) lines at a rate of (.*) lines per minute/)) {
	    $lines = $mmm;
	    $lpm = $nnn;
	} elsif (($mmm) = ($line =~ /Database (\d*)\s*bytes/)) {
	    $dbsize = $mmm;
	} elsif (($mmm) = ($line =~ /Data (\d*)\s*bytes/)) {
	    $datasize = $mmm;
	} elsif (($mmm) = ($line =~ /Code (\d*)\s*bytes/)) {
	    $codesize = $mmm;
	}  ## if line =~ pattern ... elsif ... elsif ...
    }  ## if in_timings

    if ($prev_line =~ $warn_regexp) {
	if ($line =~ $nitpick_regexp) {
	    $nits++;
	} else {
	    $warnings++;
	}
    }
    if ($prev_line =~ $serious_regexp) {
	$serious++;   ## hopefully there will never be any serious nitpicks!
    }

    $prev_line = $line;
}    ## while $line = <>

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

$^ = "top_summary_wide";
$~ = "body_summary_wide";
$^L = "\n";
$= = 100000;        ## let's not break.

## per library summary data

print "\nper library summary data:\n";
write_summary_table \%summary_table;

## per library per phase data

$^ = "top_phases_wide";
$~ = "body_phases_wide";

## per library per phase timing data

$- = 0;               # lines remaining -- force a new header
print "----------------------------------------\n\n\n";
print "per library per phase timing data:\n";
write_phase_table \%time_table;

## per library per phase allocation data

$- = 0;
print "----------------------------------------\n\n\n";
print "per library per phase allocation data:\n";
write_phase_table \%alloc_table;

if ($opt_o) {
    close OUTF;
}


exit;


sub write_phase_table {

    $cur_table_ref = shift;                 ## could do: $_[0];

    ($sum_sources, $sum_definitions, $sum_models, $sum_finishing) = (0,0,0,0);
    ($sum_checking, $sum_dfmc, $sum_bindings, $sum_typing, $sum_optimization) = (0,0,0,0,0);
    ($sum_coloring, $sum_visibility, $sum_preheaping, $sum_heaping, $sum_emitting, $sum_linking) = (0,0,0,0,0,0);
    ($sum_glue, $sum_stripping, $sum_db, $sum_heap) = (0,0,0,0);

    $count = 0;

    foreach $libname (sort keys %$cur_table_ref) {
	$count++;
	
	$rec = $$cur_table_ref{$libname};

	$sum_sources += ($sources = $rec->{sources});  
	$sum_definitions += ($definitions = $rec->{definitions});  
	$sum_models += ($models = $rec->{models});  
	$sum_finishing += ($finishing = $rec->{finishing});  
	$sum_checking += ($checking = $rec->{checking});  
	$sum_dfmc += ($dfmc = $rec->{dfmc});  
	$sum_bindings += ($bindings = $rec->{bindings});  
	$sum_typing += ($typing = $rec->{typing});  
	$sum_optimization += ($optimization = $rec->{optimization});  
	$sum_coloring += ($coloring = $rec->{coloring});  
	$sum_visibility += ($visibility = $rec->{visibility});  
	$sum_preheaping += ($preheaping = $rec->{preheaping});  
	$sum_heaping += ($heaping = $rec->{heaping});  
	$sum_emitting += ($emitting = $rec->{emitting});  
	$sum_linking += ($linking = $rec->{linking});  
	$sum_glue += ($glue = $rec->{glue});  
	$sum_stripping += ($stripping = $rec->{stripping});  
	$sum_db += ($db = $rec->{db});  

	write;
    }

    ## do totals  (use library name of "Totals")

    $libname = "Totals";

    $sources = $sum_sources;
    $definitions = $sum_definitions;
    $models = $sum_models;
    $finishing = $sum_finishing;
    $checking = $sum_checking;
    $dfmc = $sum_dfmc;
    $bindings = $sum_bindings;
    $typing = $sum_typing;
    $optimization = $sum_optimization;
    $coloring = $sum_coloring;
    $visibility = $sum_visibility;
    $preheaping = $sum_preheaping;
    $heaping = $sum_heaping;
    $emitting = $sum_emitting;
    $linking = $sum_linking;
    $glue = $sum_glue;
    $stripping = $sum_stripping;
    $db = $sum_db;

    print "----------------------------------------\n";
    write;
    
    ## do averages  (use library name of "Averages")

    $libname = "Averages";

    $sources = $sum_sources / $count;
    $definitions = $sum_definitions / $count;
    $models = $sum_models / $count;
    $finishing = $sum_finishing / $count;
    $checking = $sum_checking / $count;
    $dfmc = $sum_dfmc / $count;
    $bindings = $sum_bindings / $count;
    $typing = $sum_typing / $count;
    $optimization = $sum_optimization / $count;
    $coloring = $sum_coloring / $count;
    $visibility = $sum_visibility / $count;
    $preheaping = $sum_preheaping / $count;
    $heaping = $sum_heaping / $count;
    $emitting = $sum_emitting / $count;
    $linking = $sum_linking / $count;
    $glue = $sum_glue / $count;
    $stripping = $sum_stripping / $count;
    $db = $sum_db / $count;

    print "----------------------------------------\n";
    write;

    ## print "----------------------------------------\n";
    ## print "---------- Total lines per minute = ", $sum_lines / ($sum_sum_time / 60), "\n";
}


sub write_summary_table {

    $cur_table_ref = shift;                 ## could do: $_[0];

    ($sum_lpm, $sum_lines, $sum_secs, $sum_mem) = (0,0,0,0);
    ($sum_warnings, $sum_serious, $sum_nits) = (0,0,0);

    $count = 0;

    foreach $libname (sort keys %$cur_table_ref) {
	$count++;
	
	$rec = $$cur_table_ref{$libname};

	$sum_lpm += ($lpm = $rec->{lpm});  
	$sum_lines += ($lines = $rec->{lines});  
        $sum_secs += ($secs = $rec->{secs});  
        $sum_mem += ($mem = $rec->{mem});  
        $sum_dbsize += ($dbsize = $rec->{dbsize});  
        $sum_datasize += ($datasize = $rec->{datasize});  
        $sum_codesize += ($codesize = $rec->{codesize});  
	$sum_heap += ($heap = $rec->{heap});   ## note that this is useless

        $sum_warnings += ($warnings = $rec->{warnings});  
        $sum_serious += ($serious = $rec->{serious});  
        $sum_nits += ($nits = $rec->{nits});  

	write;
    }

    $libname = "Totals";

    if ($sum_secs > 0) {
	$lpm = $sum_lines / ($sum_secs / 60);
    } else {
	$lpm = 0;
    }
    $lines = $sum_lines;
    $secs = $sum_secs;
    $mem = $sum_mem;
    $dbsize = $sum_dbsize;
    $datasize = $sum_datasize;
    $codesize = $sum_codesize;
    $heap = $sum_heap;        ## meaningless
    $warnings = $sum_warnings;
    $serious = $sum_serious;
    $nits = $sum_nits;

    print "----------------------------------------\n";
    write;

    $libname = "Averages";

    $lpm = $sum_lpm / $count;
    $lines = $sum_lines / $count;
    $secs = $sum_secs / $count;
    $mem = $sum_mem / $count;
    $dbsize = $sum_dbsize / $count;
    $datasize = $sum_datasize / $count;
    $codesize = $sum_codesize / $count;
    $heap = $sum_heap / $count;
    $warnings = $sum_warnings / $count;
    $serious = $sum_serious / $count;
    $nits = $sum_nits / $count;

    print "----------------------------------------\n";
    write;
}






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
.


