#!/usr/bin/perl -w
#SYN [options] [-N loopcount]

#  Main script for predicting approximate system behavior from
#  measured component behaviors.  Calculates a series of "theory1.ccf[c]",
#  ..., "theoryN.ccf[c]" files for each system construct, driven by
#  system.pscf file.  The [c] indicates a result with state.
#  All options are passed to Smeas[F]t scripts that create a system
#   code file to execute, many options are not used here.
#  Incremental processing version, but does only stateless sequence now.
#  The actual work is done by Calc script; files "theory1", ..., "theoryN"
#  describe each Calc step.  

use CompCheck2;
use File::Copy;

# Switch processing
$Voption = 0; #default is silent
$Goption = 0; #no graphing by default
$Toption = 0; #no trace/profile by default
$Poption = 0; #create the "system.scf" file when off; on is not so clear
$allOptions = "";
OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  $allOptions = $allOptions." ".$ARGV[$i];
  if ($ARGV[$i] eq "-V") {
    $Voption = 1;
  }
  if ($ARGV[$i] eq "-G") {
    $Goption = 1;
  }
  if ($ARGV[$i] eq "-X") {
    #$Xoption = 1;  #flag isn't used except to pass to Smeast
  }
  if ($ARGV[$i] eq "-T") {
    $Toption = 1;
  }
  if ($ARGV[$i] eq "-P") {
    $Poption = 1;
  }
  if ($ARGV[$i] eq "-Z") {
    $Zoption = 1;
  }
  if ($ARGV[$i] eq "-N") {
    unless(defined($ARGV[$i+1]) && $ARGV[$i+1] =~ /^\d+$/) {
      die "Invalid argument for -N\n";
    }
    #$Noption is not used here, just passed on
    $allOptions .= " $ARGV[$i+1]";
  }
}
#print "$Voption $Noption \n"; print "$allOptions \n";  #debug

if (open(OP, "<system.opt")) {
  $lastOptions = <OP>;
  close OP;
  if ($lastOptions ne $allOptions) { #different  command, no reuse 
    $Zoption = 1;
  }
}
open(OP, ">system.opt") || die "can't open file to record options";
print OP $allOptions;
close OP;

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...
}
#warnmess "foo ", "and baz";  #debug

unlink glob("*.state");
#system "rm -f *.state"; #clear any state files

#Get the Polish string
open(SSCF, "system.pscf") || die "no Polish control file";
chop($Polish = <SSCF>);
@PE = split(" ", $Polish);
#Find the largest component number used
$num_comps = 0;
$uniq_num = 0;
$dup_ccf = 0;
@nums = ();
foreach $num (@PE) {
  unless ($num =~ /\D/) {  #if it's a number
    $nums[$uniq_num] = $num;
    if ($Toption) {
      for($i=0; $i<$uniq_num; $i++) {
        if ($nums[$i] == $num) {
          $dup_ccf = 1;
        }
      }
    }
    if ($num_comps < $num) {$num_comps = $num ;}
    $uniq_num++;
  }
}
#print "$num_comps \n";  #debug

chomp($c = <SSCF>);
$ccftExist = 1;  #assume all the ccft files are valid
$cns = 0; # count of code files w/state
$code_dup = 0;
for ($i=0; $i<$num_comps; $i++) {
#print "component .ccf $i: ", $c, "\n" ;  #debug
  unless (defined($c)) {
    die "Not enough .ccf files to match Polish in the .pscf file";
  }
  
  open (CCF, "<".$c) or die "can't read configuration file ", $c ;
  $component[$i] = $c."\n" ;
  if ($Toption) { #check for duplicates (badly)
    II:
    for ($ii=0; $ii<$i; $ii++) {
      if ($component[$ii] eq $component[$i]) {
        $dup_ccf = 1;
        last II;
      }
    }
  }
  $progline = <CCF>; #read the executable name for messages later
  @progand = split(' ',$progline);
  $prog[$i] = $progand[0];
  $stateless = not defined($progand[1]);
  if ($stateless) {
    $ccft = $c."t";
  } else {
    $ccft = $c."c";
    if ($progand[1] eq "state") {
      $codenamest[$cns++] = $prog[$i]; 
    }
  }
  unless (-e $ccft) { #theory file doesn't exist 
    warn "Component $c not approximated\n";  #not controlled by -V
    $ccftExist = 0;
  }
  #check for duplicates code names with state -- those must be unique
  for ($ci=0; $ci<$cns-1; $ci++) {
    if ($prog[$i] eq $codenamest[$ci]) {
      warn "Duplicate code file name $prog[$i]";
      $code_dup = 1;
    }
  }
  if (defined($c = <SSCF>)) {
    if ($i == $num_comps - 1) {
      warn "Too many .ccf files to correspond to Polish in .pscf file";  #not -V
    } else {
      chomp $c;
    }
  }
} #end for going through .ccf files
close (SSCF);
#check for duplicates
if ($Toption && $dup_ccf) { #dup .ccf NG
  die "With trace (-T) all .ccf files must have unique names";  #not -V
}
if ($code_dup) {
  die "Code file names for components with state must be unique";
}
unless ($ccftExist) { 
  die "Component approximations must be measured first";
}

#ready to start
if ($Zoption || !-e "system.pscfb") { #no reuse
  unlink glob("theory*");
  $reUse = 0;
} else {
  @statvec = stat("system.pscf");
  $nowTime = $statvec[9];
  @statvec = stat("system.pscfb");
  $thenTime = $statvec[9];
#print "system.pscf times: old-$thenTime; new-$nowTime\n"; #debug
  #if system.pscf changed, no incremental processing possible
  $reUse = ($nowTime < $thenTime);
}

$theory_ccf = 0;  #counter for making unique names for "theory" files

warnmess "Beginning the system calculation of Polish $Polish";
foreach $op (@PE) { # process the Polish
  if ($op =~ /\D/) { #operator
    $thfpre = "theory".++$theory_ccf;
    $thf = $thfpre.".ccf";

    #create subdirectory, do single calculation there, and bring back to this
    # directory the computed "theory" file under a unique name in $thf
    $subdir = ".SubCalc";  #name of the subdirectory (invisible to most)
    unlink glob("$subdir/*");
    rmdir $subdir;
    #`rm -r -f $subdir`; #destroy directory so it can be used repeatedly
    mkdir $subdir;
    opendir(BASE,".") or die "Base directory disappeared!";
    @allfilenames = readdir BASE;
    foreach $f (@allfilenames) {
      if ($f !~ /^\./) {
        copy($f,"$subdir/$f");
      }
    }
    close(BASE);
    #`cp -p * $subdir`;  #preserve file times
    chdir $subdir; #shift to new directory
#print `pwd`; #debug -- where are we?
    #build a proper .sscf file
    open (SSCF, ">system.sscf") || die "can't create .sscf file for calculation";
#end common setup stuff
    if ($op eq "S") { # series of 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a series (S) combination";
      }
      chomp($C2 = pop @ccfStack);
      chomp($C1 = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      $pname1 = &CompCheck::messname($C1);
      $pname2 = &CompCheck::messname($C2);
      warnmess "Series: ",$pname1," ; ",$pname2," -> ",$thfpre;
      print SSCF "series\n";
      print SSCF "$C1\n";
      print SSCF "$C2\n";
    } elsif ($op eq "C") { #conditional, 3 components
#print "$#ccfStack  @ccfStack \n";  #debug
      if ($#ccfStack < 2) {
        die "Not enough operands for a conditional (C) combination";
      }
      chomp($Cfalse = pop @ccfStack);
      chomp($Ctrue = pop @ccfStack);
      chomp($Ctest = pop @ccfStack);
      $p3 = pop @ProgStack;
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      $pname1 = &CompCheck::messname($Ctest);
      $pname2 = &CompCheck::messname($Ctrue);
      $pname3 = &CompCheck::messname($Cfalse);
      warnmess "Conditional:  IF ",$pname1," THEN ",$pname2," ELSE ",$pname3," FI -> ",$thfpre;
      print SSCF "conditional\n";
      print SSCF "$Ctest\n";
      print SSCF "$Ctrue\n";
      print SSCF "$Cfalse\n";
    } elsif ($op eq "L") { #loop, 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a loop (L) combination";
      }
      chomp($Cbody = pop @ccfStack);
      chomp($Ctest = pop @ccfStack);
      $p3 = ""; #to foil only used once message...
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      $pname1 = &CompCheck::messname($Ctest);
      $pname2 = &CompCheck::messname($Cbody);
      warnmess "Loop:  WHILE ",$pname1," DO ",$pname2," OD -> ",$thfpre;
      print SSCF "loop\n";
      print SSCF "$Ctest\n";
      print SSCF "$Cbody\n";
    } elsif ($op eq "P") { #concurrent, 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a concurrent (P) combination";
      }
      chomp($C2 = pop @ccfStack);
      chomp($C1 = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      $pname1 = &CompCheck::messname($C1);
      $pname2 = &CompCheck::messname($C2);
      warnmess "Parallel: ",$pname1," || ",$pname2," -> ",$thfpre;
      print SSCF "parallel\n";
      print SSCF "$C1\n";
      print SSCF "$C2\n";
    } else {
      die "Illegal operand `$op' in Polish system description";
    }
    close SSCF;
#print `cat system.sscf`;  #debug
#print `cat $thfpre`;  #debug
    #check for possible reuse of the existing theory file
      #Could do even better by seeking a valid calculated file among all "theoryN" files
      #even if system.pscf changed. Not worth it?
    $reUse1 = 0;  #assume not possible
    if (-e $thfpre && $reUse) { #file exists and system.pscf hasn't changed
#print "calc file exists and .pscf same\n";  #debug
      open (NEW, "<$thfpre");
      open (OLD, "<system.sscf");
      $sameNLfile = 1;
      NLP:
      while (1) {  #always jump out
        $Nl = <NEW>;  $Ol = <OLD>;
        if ($Nl && $Ol && $Nl eq $Ol) { #line the same
          next NLP;
        }
        if (!$Nl && !$Ol) { #both EOF so same
          last NLP;
        }
        $sameNLfile = 0;
        last NLP;
      }
      if ($sameNLfile) { #files same
#print "same calculation for $thfpre\n"; #debug
        $reUse1 = 1; #use the old file, which may be in either .ccf or .ccfc format
          #unless some component used has changed since (including executables for .ccft)
           #must test times in parent directory!
        if (-e "$thfpre.ccf") {
          $oldtheory = "$thfpre.ccf";
        } elsif (-e "$thfpre.ccfc") {
          $oldtheory = "$thfpre.ccfc";
        } else {
          $reUse1 = 0; #no old file to use
        }
        if ($reUse1) {#still OK
#print "$oldtheory being examined\n";  #debug
          @statvec = stat("../$oldtheory");
          $th1Time = $statvec[9];
          open (RUU,"<$thfpre");
          chop($ru = <RUU>); #operation-name line
          FC:
          while ($ru = <RUU>) { #2 or 3 file lines
            chop($ru);
            $rut = $ru;
            if ($ru !~ /^theory/) { #real component
              $rut .= "t";  #check the measured file
            }
            @statvec = stat("../$rut");
#$t=time;print "Times: now - $t; $oldtheory - $th1Time; $rut - $statvec[9]\n";  #debug
            if (not(defined($statvec[9])) || ($statvec[9] > $th1Time)) { #this measured/calculated file has changed
#print "comp measured file $ru changed\n";  #debug
              $reUse1 = 0;
              last FC;
            }
            if ($ru !~ /^theory/) {#real comp
              #check the executable if any
              open(CF,"<$ru") || die "$ru somehow disappeared!";
              chop($headline = <CF>);
              @statvec = stat("../$headline");
#$t=time;print "Times: now - $t; $oldtheory - $th1Time; $headline - $statvec[9]\n";  #debug
              if (not(defined($statvec[9])) || ($statvec[9] > $th1Time)) { #this code file has changed
#print "comp code file $headline changed\n";  #debug
                $reUse1 = 0;
                last FC;
              } 
              close (CF);
            } #end real comp
          }  # end FC loop
          close (RUU);
        } #end reUse1 if
      }
    }
    if (-e "$thfpre.ccf") {
      copy("$thfpre.ccf", "theory.ccf");
      #`cp $thfpre.ccf theory.ccf`;
    }
    if (-e "$thfpre.ccfc") {
      copy("$thfpre.ccfc", "theory.ccfc");
      #`cp $thfpre.ccfc theory.ccfc`;
    }
#system 'ls theory*';  #debug
    if (-e "theory.ccfc") { #result synthesized component has state
      $thf = $thfpre.".ccfc";  #already set to .ccf above
      $synF = "theory.ccfc";
      $synI = "theory.ccfci";
    } else {
      $synF = "theory.ccf";
      $synI = "theory.ccfi";
    }
    if (!$Toption && $reUse1) { #need not recalculate (but do for trace)
      warnmess "  Reusing previously calculated $thfpre";
    } else {
      #remove old names if they exist
      if (-e "theory.ccf") {
        unlink "theory.ccf";
        #system "rm -f theory.ccf";
      }
      if (-e "theory.ccfc") {
        unlink "theory.ccfc";
        #system "rm -f theory.ccfc";
      }
      die "Calc script failed" if (system "perl Calc ".$allOptions);
      if (-e "theory.ccfc") { #result synthesized component has state
        if ($Toption) { #
          $Toption = 0; #TBD 
          warn "Calculated trace not yet implemented for components with state";
        }
        $thf = $thfpre.".ccfc";  #already set to .ccf above
        $synF = "theory.ccfc";
        $synI = "theory.ccfci";
      } else {
        $synF = "theory.ccf";
        $synI = "theory.ccfi";
      }
      rename $synF, "../$thf";
      #$cmd = "mv -f $synF ../".$thf;
      #`$cmd`;
      if (-e $synI) {
        rename $synI, "../$thf"."i";
        #$cmd = "mv -f $synI ../".$thf."i";
        #`$cmd`;
      }
    }
    if ($Toption) { #new .cm files have been created
      open (CM,"< theory.cm") || die "no connection-matrix file exported";
      chop($cmline = <CM>);
      @cmnames = split(' ',$cmline);
      foreach $f (@cmnames) {
        rename "cm-$f.cm", "../$thfpre-$f.cm";
        #system "rm -f ../$thfpre-$f.cm";
        #system "mv cm-$f.cm ../$thfpre"."-$f".".cm";
      }
      close(CM);
      rename "theory.cm", "../$thfpre".".cm";
      #system "rm -f ../$thfpre.cm";
      #system "mv theory.cm ../$thfpre".".cm";
    }
    copy("system.sscf", "../$thfpre");
    #system "rm -f ../".$thfpre;
    #system "cp system.sscf ../".$thfpre;  # "theoryN" files contain the operation done and files used
    chdir ".."; #back to parent directory
    push @ccfStack, $thf;
    push @ProgStack, $thfpre;
  } #end of processing operator
  else { #operand number, stack it, the index to @component and @prog
    push @ccfStack, $component[$op-1];
    if ($prog[$op-1] ne "theory") { #adjust name for messages
      @tmp = split(/\./,$prog[$op-1]);
      $prog[$op-1] = $tmp[0];  #drop extension from print name
    }
    push @ProgStack, $prog[$op-1];
  }
} # end foreach op in Polish

if ($#ccfStack != 0) {
  warn $#ccfStack," too many operands in the Polish system description"; #not -V
}
#What is now left on the stack is the "theory" file for the complete system

chomp($thf = pop @ccfStack);

@sfile = split(/\./,$thf);
$ext = $sfile[scalar(@sfile) -1];
#print "final theory files $thf, ext $ext\n";  #debug
if ($Poption) {
  die "-P option is currently in disarray...";
}
$stateless = ($ext eq "ccf");
if ($stateless) {
  if ($Poption) { #use existing file
    unless (-e "system.scf") {
      die "-P option requires `system.scf' file";
    }
    # must get the final theory name into old file TBD
    warnmess "Using existing measurement/profile description";
  }
  else {
  #Write a system.scf using the subdomains of the theory
    open(SCF, ">system.scf") || die "can't write `system.scf' file";
    open(TH, $thf) || die "can't open the final theory file";
    $line = <TH>;  #discard name
    print SCF "$thf\n"; #name of the final theory file
    while ($line = <TH>) {
      @lineS = split(" ",$line);
      $HowMany = 3;
      print SCF $lineS[0]." ".$lineS[1]." ".$HowMany."\n";
    }
    close(TH);
    close(SCF);
    warnmess "File system.scf written to correspond to calculated subdomains";
  }
  #if (system "perl SmeasFt ".$allOptions) {die "`SmeasFt' script failed";}
  if (system "perl Smeast ".$allOptions) {die "`Smeast' script failed";}
  # display the system graph
  if ($Goption) {
    warnmess "Graphing system ...";
    system "perl Xcomp -G";
    #system "./Xcomp -G";
  }
} else { #has state or is concurrent
  #TBD  Not sure what is needed for system.scf and Poption for state or concurrent...
  # just put in the final theory name for now
  open(SCF, ">system.scf") || die "can't write `system.scf' file";
  print SCF "$thf\n"; #name of the final theory file
  close(SCF);

  #create SystemCode actual system code
  if (system "perl Smeast ".$allOptions) {die "`Smeast' script failed";}
  #if (system "./Smeast ".$allOptions) {die "`Smeast' script failed";}
  
  # display the system graph
  if ($Goption) {
    warnmess "Comparing actual system ...";
    system "perl Xcompt $thf";
  }
}
#write back copy of polish description
copy("system.pscf", "sysem.pscfb");
#system "rm -f system.pscfb";
#system "cp system.pscf system.pscfb";
