#!/tools/perl/bin/perl

#############################################################################
#
#  Usage:  stattyB  report-filename  input-files
#
#  'stattyB' reads data files in 'ccount' output format and gives a
#  statistical report about the structure of blocks in C source files.
#  See 'README.1' and 'README.2' for more details!
#
#  Author: Joerg Lawrenz, Universitaet Karlsruhe
#  Date:   93/12/1
#
#############################################################################

#
#  First get the report-filename
#

$file = shift;

#
#  Exit if there are not enough arguments in the command line.
#

if (scalar(@ARGV) == 0) {
 print STDERR "Usage: stattyB  report-filename  input-files\n";
 exit;
}

#
#  Get the names of the first and the last file for later report information.
#

$FirstFile = $ARGV[0];
$LastFile = $ARGV[$#ARGV];

#
#  Now read all input files line by line, count blocks, innermost blocks 
#  and functions, accumulates for their attribute field values the according 
#  histograms and count the modules. 
#  Consider attribute combinations of blocks, innermost blocks and function 
#  bodies:
#  $BI...  : all blocks + all innermost blocks
#  $FI...  : bodies of all blockless functions + innermost blocks
#  $BIF... : all blocks + innermost blocks + bodies of all functions
#

while (<>) {
  if (/^B/) {
    split;
    $BlockLines   {$_[1]}++;
    $BlockSemis   {$_[2]}++;
    $BlockDepth   {$_[3]}++;
    $BlockBlocks  {$_[4]}++;
    $BlockMaxDepth{$_[5]}++;
    $BIFLines{$_[1]}++;
    $BIFSemis{$_[2]}++;
    $BIFDepth{$_[3]}++;
    $BILines{$_[1]}++;
    $BISemis{$_[2]}++;
    $BIDepth{$_[3]}++;
    $blocks++;
    next;
   }
  if (/^F/) {
    split;
    $BIFLines{$_[2]}++;
    $BIFSemis{$_[4]}++;
    $BIFDepth{1}++;
    if ($_[11] == 0) {
      $FILines{$_[2]}++;
      $FISemis{$_[4]}++;
      $FIDepth{1}++;
      $NoBlockFunctions++;
     }
    $functions++;
    next;
   }
  if (/^I/) {
    split;
    $InBlockLines{$_[1]}++;
    $InBlockSemis{$_[2]}++;
    $InBlockDepth{$_[3]}++;
    $BIFLines{$_[1]}++;
    $BIFSemis{$_[2]}++;
    $BIFDepth{$_[3]}++;
    $BILines{$_[1]}++;
    $BISemis{$_[2]}++;
    $BIDepth{$_[3]}++;
    $FILines{$_[1]}++;
    $FISemis{$_[2]}++;
    $FIDepth{$_[3]}++;
    $inblocks++;
    next;
   }
  $module++ if /^M/;
}

#
#  If no modules found, quit.
#

if (!$module) {
  print STDERR "No modules found!\n";
  exit;
}

#
#  Now write the report by inserting for each attribute histogram
#  the statistical results of the subroutine 'stat'.
#

open(FILE, "> $file");

chop($cwd = `pwd`);

print  FILE "BLOCK REPORT  (from $cwd: $FirstFile ... $LastFile):\n\n";

print  FILE "               Average Std.dev.  Max.    25q    [%]     50q    [%]     75q    [%]     90q    [%]     95q    [%]     98q    [%]     99q    [%]\n";
print  FILE "               ------- -------- ------ -------------- -------------- -------------- -------------- -------------- -------------- --------------";
print FILE "\n---- BLOCKS ----\n";
&printd('lines',          &stat(*BlockLines));
&printd('";"',            &stat(*BlockSemis));
&printd('depth',          &stat(*BlockDepth));
&printd('subblocks',      &stat(*BlockBlocks));
&printd('Max. depth/1',   &stat(*BlockMaxDepth));

print FILE "\nINNERMOST BLOCKS\n";
&printd('lines',          &stat(*InBlockLines));
&printd('";"',            &stat(*InBlockSemis));
&printd('depth',          &stat(*InBlockDepth));

print FILE "\n------ BI ------\n";
&printd('lines',          &stat(*BILines));
&printd('";"',            &stat(*BISemis));
&printd('depth',          &stat(*BIDepth));

print FILE "\n-----  FI ------\n";
&printd('lines',     &stat(*FILines));
&printd('";"',       &stat(*FISemis));
&printd('depth',     &stat(*FIDepth));

print FILE "\n----- BIF ------\n";
&printd('lines',     &stat(*BIFLines));
&printd('";"',       &stat(*BIFSemis));
&printd('depth',     &stat(*BIFDepth));

printf FILE "\n\n# Modules:                %6d\n", $module;
printf FILE "# Functions:              %6d\n", $functions;
printf FILE "# Blocks (not innermost): %6d\n", $blocks;
printf FILE "# Innermost blocks:       %6d\n", $inblocks;
printf FILE "# Blockless functions:    %6d\n\n", $NoBlockFunctions;

print FILE "BI  := all blocks + all innermost blocks\n";
print FILE "FI  := bodies of all blockless functions + innermost blocks\n";
print FILE "BIF := all blocks + innermost blocks + bodies of all functions\n";

print FILE "\n/1  Maximum of all subblock nesting depths\n";

close(FILE);


#############################################################################
#
#  Here is the subroutine 'stat', which calculates statistical values from
#  a given histogram.
#
#############################################################################

sub stat {
  local(*Array) = @_;
  local($i, $val, $sum, $num, $Average, $StdDev, $Max);
  local(@Quantil_25, @Quantil_50, @Quantil_75);
  local(@Quantil_90, @Quantil_95, @Quantil_98, @Quantil_99);

#  Average:

  while (($i,$val) = each %Array) {
    $sum += $val * $i;
    $num += $val;
    $Max = $i > $Max ? $i : $Max;
   }
  $Average = $num > 0 ? $sum/$num : 0;

#  Standard deviation:

  $sum = 0;
  while (($i,$val) = each %Array) {
    $sum += $val * ($i - $Average)**2;
   }
  $StdDev = $num > 1 ? sqrt($sum/($num-1)) : 0;

# Quantils:

  $sum = 0;
  foreach $i (sort numerically keys %Array) {
    $sum += 100 * $Array{$i} / $num;

    if ($sum >= 25 && !defined @Quantil_25) {
      @Quantil_25 = ($i,$sum);
     }
    if ($sum >= 50 && !defined @Quantil_50) {
      @Quantil_50 = ($i,$sum);
     }
    if ($sum >= 75 && !defined @Quantil_75) {
      @Quantil_75 = ($i,$sum);
     }
    if ($sum >= 90 && !defined @Quantil_90) {
      @Quantil_90 = ($i,$sum);
     }
    if ($sum >= 95 && !defined @Quantil_95) {
      @Quantil_95 = ($i,$sum);
     }
    if ($sum >= 98 && !defined @Quantil_98) {
      @Quantil_98 = ($i,$sum);
     }
    if ($sum >= 99) {
      @Quantil_99 = ($i,$sum);
      last;
     }
   }

#  Now return all results.

  ($Average, $StdDev, $Max, @Quantil_25, @Quantil_50, @Quantil_75,
   @Quantil_90, @Quantil_95, @Quantil_98, @Quantil_99);
}


#############################################################################
#
#  'printd' is the right output subroutine for the combination of decimal
#  and floating point values.
#
#############################################################################

sub printd {
   local($object,@list) = @_;

   printf FILE "%-15s%7.1f  %7.1f %6d %6d (%5.1f) %6d (%5.1f) %6d (%5.1f) %6d (%5.1f) %6d (%5.1f) %6d (%5.1f) %6d (%5.1f)\n",
                $object, @list;
}


#############################################################################
#
#  'printp' is the right output subroutine for floating point values only.
#
#############################################################################

sub printp {
   local($object,@list) = @_;

   printf FILE "%-15s%7.1f  %7.1f %6.1f %6.1f (%5.1f) %6.1f (%5.1f) %6.1f (%5.1f) %6.1f (%5.1f) %6.1f (%5.1f) %6.1f (%5.1f) %6.1f (%5.1f)\n", $object, @list;
}


#############################################################################
#
#  This subroutine compares two values. It is used by a sorting routine
#  in 'stat'.
#
#############################################################################

sub numerically { $a <=> $b; }
