#!/usr/bin/perl -w
# COMPSt [-V] [-R] [-U] [-Z] [-S File]

#  COMPSt script (measure component outputs, run times, and state)
#  Use .pscf file to process all components and create .ccfc files
#  that contain their measured approximations.
#  With single component (-S) option does just one.  
#  If File has no extension, supply ".ccf"
#  

use CompCheck2;
use component;
use sampling;
use File::Copy;

$Soption = 0;  #do just one component
$Voption = 0; $Vstring = "";
$Goption = 0;
$Roption = 1; #assume random sequence sampling
$Zoption = 0;  #force measurements even if old appear good

$allop = ""; #options just passed on, unused here
OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  if ($ARGV[$i] eq "-V") {
    $Voption = 1;
    $Vstring = "-V";
  }
  if ($ARGV[$i] eq "-G") {
    $Goption = 1;
  }
  if ($ARGV[$i] eq "-R") {
    $Roption = 1;
  }
  if ($ARGV[$i] eq "-U") {
    $Roption = 0;
  }
  if ($ARGV[$i] eq "-Z") {
    $Zoption = 1;
  }
  if ($ARGV[$i] eq "-S") {
    $Soption = 1;
    $i++;
    #die "Error reading .ccf file\n" unless(defined($ARGV[$i]) && $ARGV[$i] =~ m/.ccf$/);
    @components = ($ARGV[$i]);
    next OPT; #don't add to $allop
  }
  $allop .= " $ARGV[$i]";
}

$i = 0;
unless ($Soption) {
  #process system configuration file
  $sys_desc = "system.pscf" ;
  open(SYSTEM, $sys_desc ) || die "could not open ", $sys_desc ;
  $comp_name = <SYSTEM>; #discard polish line

  #store component .ccf names
  @components = ();
  while ($comp_name = <SYSTEM>) { #read to end
    chop($comp_name);
    $components[$i] = $comp_name;
    $i++
  }
  close SYSTEM ;
}

#debug
#foreach $comp (@components) {print $comp."\n"; }

########################################subroutine#######################
sub warnmess{ #print warning based on V option
  unless ($Voption && defined($_[0])) {return;}
  $mess = "";
  MLOOP: for ($wm=0;;$wm++) {
    unless (defined($_[$wm])) {last MLOOP;}
    $mess = $mess.$_[$wm];
  }
warn $mess, "\n";  #don't print line from which this came...
}
###########################################

#for each component process its file and execute test
CCFL: 
foreach $comp (@components) {
  if (not defined((split('\.', $comp))[1])) {
    $comp .= ".ccf";
  }
  open(COMP, $comp) || die "could not open the file ", $comp;
  # get the name of the executable
  $comp_line = <COMP> ;
  close COMP;
  @comp_and = split(' ',$comp_line);
  $code_name = $comp_and[0];
  if ($code_name eq "theory") { #not a real component, skip
    next CCFL;
  }
  #real component, measure it
  $concurrent = 0; #to stop "used once" message
  ($stateless, $concurrent,$ok) = &CompCheck::check1($comp,$Voption);
  unless($ok) { #messages already given
    next CCFL;
  }
  if ($stateless) {
    warn "stateless component ignored";
    next CCFL;
  }
  
  $comptheory = $comp."c";
  if ($Zoption) { # measure no matter what
    $ccfcExist = 0;
  } else {
    $ccfcExist = 1; #assume a good .ccfc file exists
    @statvec = stat($comp); #for ccf file
    $ccfileTime = $statvec[9];
    @statvec = stat($code_name); #for executable file
    $binfileTime = $statvec[9];  
  
    if (-e $comptheory) {
      open (CCFC, $comptheory) or die "something wrong with file ",$comptheory;
      $tmp = <CCFC>; #line format:  "state 1 insubs stsubs stinit R/U
      @tmp = split(" ",$tmp);
      $ccfcExist = 0 unless (defined($tmp[5]) && (($tmp[5] eq "R") && $Roption) || (($tmp[5] eq "U") && !$Roption));
      @statvec = stat($comptheory); #for ccfc file
      $ccfcExist = 0 unless ($statvec[9] > $ccfileTime && $statvec[9] > $binfileTime);
      close (CCFC);
    } else {
        $ccfcExist = 0;
    }
  }
  if ($Roption) { #for messages
    $sampLg = "Random-sequence";
  } else {
    $sampLg = "Systematic";
  }
  if ($ccfcExist) {
    warnmess "$sampLg approximation file $comptheory up-to-date..." ;
    warnmess "--------------------------------";
    next CCFL;
  }

#print "perl compt $allop $comp\n"; #debug
  #system "perl compt $allop $comp";  

$ccfProcessed = 0; # indicates that subdomain data has been read from a ccf file

# read input range and state range from ccf file
  open(COMP, $comp) || die "Invalid ccf file specified";
    #first line of file points to real executible
    $compline = <COMP>;
    @compand = split(' ',$compline);
    $code_name = $compand[0];
    $compExecut = $code_name;
    if (defined($compand[1])) { 
      $concurrent = ($compand[1] eq "concurrent");
      $Roption = 0 if ($concurrent);  #really means "sequences"
      # else it is "state"
    } else { #should not be in compt!
      die "Can't process components neither concurrent nor w/state";
    }
    $line_count = 0;
    $in_sub_cnt = 0;
    $blankline = 0;
    $seq_count = 0;  #sequences for -R
    $input_freq = 0;
    $state_freq = 0;
    while($linearr = <COMP>) {
      #line read from .ccf file
      @linesplt = split(' ',$linearr);
      if ($linearr eq "\n") {
        $blankline = 1;
        $in_sub_cnt = $line_count;
        $line_count = 0;
      }
      else {
        if ($blankline) { #seen, doing states
          $stLB[$line_count] = $linesplt[0];
          $stUB[$line_count] = $linesplt[1];
          $state_freq += $linesplt[2];
        } else { #inputs
          $inLB[$line_count] = $linesplt[0];
          $inUB[$line_count] = $linesplt[1];
          $input_freq += $linesplt[2];
          $seq_count += $linesplt[2]; #do both -R and -U, not worth conditional
        }
        $line_count++;
      }
    }
  
  die "Component description file $comp apparently stateless" unless ($blankline);
  close(COMP);
  $st_sub_cnt = $line_count;
  $input_start = $inLB[0];
  $input_end = $inUB[$in_sub_cnt-1];
  $state_start = $stLB[0];
  $state_end = $stUB[$st_sub_cnt-1];

  $ccfProcessed = 1;
  #$comptheory = $comp."c";
  #$ccfcExist = -e $comptheory;
  die "No component code $compExecut to execute" unless (-e $compExecut);
  if ($seq_count < 30) {
    $seq_count = 30;
  }
# print "sequences: $seq_count \n";  #debug

  #incremental processing to follow isn't attempted...
  if ($ccfProcessed) { #incremental stuff requires ccf file
    $incrproc = 0; #assume no incremental processing
    if (-e $comptheory && !$Zoption) {
      open (CCFC, "<$comptheory");
      $tmp = <CCFC>; #examine the code line
      @tmp = split(" ",$tmp);
      $ccfcExist = 0 unless (defined($tmp[3]) && (($tmp[3] eq "R") && $Roption)||(($tmp[3] eq "U") && !$Roption));
      # reliability not ready for state --  TBD
      #if ($Foption) {
        #$ccfcExist = 0 unless (defined($tmp[3]) && ($tmp[2] eq "r") && ($tmp[3] == $confidencepct));
      #}
      @statvec = stat($comp); #for ccf file
      $ccfileTime = $statvec[9];
      @statvec = stat($compExecut); #for executable file
      $binfileTime = $statvec[9];  
      @statvec = stat($comptheory); #for theory ccf file
      $ccfcExist = 0 unless ($statvec[9] > $binfileTime);
      if ($statvec[9] < $ccfileTime && $statvec[9] > $binfileTime) {
        $incrproc = 1;
        $ccfcExist = 0;
      }
      close (CCFC);
    } else {
      $ccfcExist = 0;
    }

    warnmess "$sampLg measuring approximation file $comptheory ...";
    $tense = "could not";
    if ($incrproc) { #attempt incremental
      $incrproc = 0;  #debug:  switch comment to next line
      #$incrproc = &CompCheck::CheckIncr($comp); #creates .ccfi skeleton if small changes
    }
#die "stop and look at all files!";  #debug
    if ($incrproc) {  #may be changed in CheckIncr
      $tense = "should";
      $oldtheory = $comptheory."b";
      copy($comptheory, $oldtheory);
      #system "rm -f $oldtheory";
      #system "cp $comptheory $oldtheory";  # .ccftb is previous theory file
    }
    warnmess "  (Measurements $tense be incremental)";
    if ($incrproc) {
#TBD incremental processing
      warnmess "But not implemented yet!";
      #open(OLDTH, "<$oldtheory");
      #$tl = <OLDTH>;  #skip header line -- same as if newly created
#TBD any use of old file...
    }
    warnmess "--------------------------------";
  }
#print "$input_freq x $state_freq subdomains\n";  #debug

  #use XS to execute & create "measured.dat"
  if ($Roption) {
    system "perl XS -R $Vstring $compExecut $comp $input_start $input_end $seq_count";
  } else {
    system "perl XS -U $Vstring $compExecut $comp $input_start $input_end $input_freq $state_start $state_end $state_freq";
  }
  unlink ($compExecut.".dat");  #remove out of date data file
  unlink ($compExecut.".alldat");  #remove other out of date data file

  if ($ccfProcessed) {
    $ccf_back = $comp."b";
    copy($comp, $ccf_back);
  }
  open (DAT, "<measured.dat") or die "XS failed to make 'measured.dat'!";
  $line = <DAT>; #head line:  state/concurrent U/R initstate code ranges
  @lane = split(' ',$line);
  open (CCFC, ">$comptheory");
  print CCFC "$lane[0] 1 $in_sub_cnt $st_sub_cnt $lane[2] $lane[1]\n";  #header line
  for ($i=0; $i<$in_sub_cnt; $i++) { #list of in subdomains
    print CCFC "$inLB[$i] $inUB[$i]\n";
  }
  for ($i=0; $i<$st_sub_cnt; $i++) { #list of in subdomains
    print CCFC "$stLB[$i] $stUB[$i]\n";
  }
  #leave CCFC open for data lines to follow...

  #measured.dat" is sorted by leading subdomain fields, input varies first
  $lc_end = 4 + 2*$concurrent;

  $ii = 0;
  $is = 0; # indices into subdomains
  $hitsub[0][0] = 0;
  for $i (0..$lc_end) { 
    $ave1[$i] = 0;
  }
  $c1 = 0;
  while ($line = <DAT>) {
    @lane = split(' ',$line); # iS sS input in-state out run state (state); ... run out2 run3 run4 (conc)
    if ($lane[1] != $is || $lane[0] != $ii) { #new subdomain in data
      if ($c1 > 0) { #some data in previous subd
        for $i (0..$lc_end) {
          $aves[$ii][$is][$i] = $ave1[$i]/$c1;
        }
        $hitsub[$ii][$is] = $c1;
#print "hit subdomain $ii x $is $c1 times\n";  #debug
        $c1 = 0;
      } else { #no hits 
        $hitsub[$ii][$is] = 0;
      }
      while ($lane[0] > $ii) { #catch up with inputs
        $ii++;
        $hitsub[$ii][$is] = 0;
      }
      while ($lane[1] > $is) { #catch up with states
        $is++;
        for ($iii=0; $iii<$in_sub_cnt; $iii++) { #do all the inputs for that missing state
          $hitsub[$iii][$is] = 0;
        }
      }
      $ii = $lane[0]; #in case input reverted
      for $i (0..$lc_end) { 
        $ave1[$i] = 0;
      }
    } #end new subdomain
    for $lc (0..$lc_end) {
      $ave1[$lc] += $lane[$lc+2];
    }

    $c1++;
  } #end loop over measurements
  close DAT;
  if ($c1 > 0) { #some data in final subd
    for $i (0..$lc_end) {
      $aves[$ii][$is][$i] = $ave1[$i]/$c1;
    }
    $hitsub[$ii][$is] = $c1;
  } else { #no hits 
    $hitsub[$ii][$is] = 0;
  }
  #may be additional subdomains never in data...
  for ($i=$ii+1; $i<$in_sub_cnt; $i++) { #finish this row of inputs
    $hitsub[$i][$is] = 0;
  }
  for ($j=$is+1; $j<$st_sub_cnt; $j++) { #states
    for ($i=0; $i<$in_sub_cnt; $i++) { #inputs
      $hitsub[$i][$j] = 0;
    }
  }
  
  for ($j=0; $j<$st_sub_cnt; $j++) { #states
    for ($i=0; $i<$in_sub_cnt; $i++) { #inputs
      if ($hitsub[$i][$j]) { #valid data
        $y = $hitsub[$i][$j];
        for $lc (2..$lc_end) {
          $y .= " $aves[$i][$j][$lc]";
        }
      } else {
        $y = "0 0 0 0 0 0";
      }
      print CCFC "$y\n";
    } #end input loop
  } #end state loop

  close CCFC;

  if ($Goption) { #show output graph & error table
    system "perl XcuteS $comp";
  }
} # end foreach over components
