#!/usr/bin/perl -w

#SmeasF script, measure composite system values for an arbitrary system.
# can "execute" a "theory" system consisting of the approximation files xxx.ccft

use samplingf ;
use dec15;

# pick up options, if any
$Noption = 1000; #default loop count
$Toption = 0;  #no trace
$Poption = 0;  #profile
$Xoption = 0;  #do the "theory" system instead of the real code
OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  if ($ARGV[$i] eq "-N") { 
    $Noption = $ARGV[$i+1];  #This should be better checked & handled
  }
  if ($ARGV[$i] eq "-T") {
    $Toption = 1;
  }
  if ($ARGV[$i] eq "-P") {
    $Poption = 1;
  }
  if ($ARGV[$i] eq "-X") {
    $Xoption = 1;
  }
}
#destroy the existing trace path file, if any
system("rm -f trace_path");

# build a list of .ccf file names and executable names for the components
open(SSCF,"system.pscf") or die "no file: system.pscf";
$RevPolish = <SSCF>;  #discard name
$num_comps = 0;
while ($c = <SSCF>) {
  chop($c);
  open (CCF, "< ".$c) or die "couldn't open configuration file", $c;
  chop($filename = <CCF>);
  close (CCF);
#debug
#print "component filename $i: ", $filename, "\n" ;
   $ccfile[$num_comps] = $c;
   $prog[$num_comps] = $filename ; 
  if ($Xoption) {
    $theoryProg[$num_comps] = $c."t";
  }
  $num_comps++;
}
#debug
#print "$num_comps \n";
close (SSCF);

# see if components are all usable
      for ($k=$num_comps-1; $k >= 0 ; $k--) {
        if ($Xoption) {
          die "`theory' component file .ccft not available" unless (-e $theoryProg[$k]);
        }
        else {
          die "component ",$prog[$k]," can't be executed." 
            unless ($prog[$k] =~ /^theory/ || -x $prog[$k]);
        }
      }

#construct a Perl program that does the Polish in @PE using these components
#in "SystemCode" in the current directory

#need a single stack; use array @CodeStack

#I/O conventions of bits of code generated:  
#  1. Assumes that its input is in Perl var $x
#  2. Places its output in $y
#  3. Nothing is done about stderr -- the values just come out as they will
@PE = split(" ", $RevPolish);

$SystemCode = "SystemCode";
open (SP, ">".$SystemCode) or die "Can't open a file for compiling the program";
print SP "#!/usr/bin/perl -X \n";  #no messages
print SP "chop (\$x = <STDIN>);\n";

if ($Toption) {
# tracef is a mess...  fix TBD
print SP "use tracef;\n";
print SP "tracef::count_subdomains \\\%sub_arr_cnt, \\\@list_ccf ; \n";
}
$Nname = "\$N";  #use a different counter in nested loops
$xsname = "\$xs"; #use a different save variable around each construction
foreach $op (@PE) { # process the Polish
#TBD Should check for stackunderflow and excess operands, as in "SYN"
  if ($op =~ /\D/) { #operator
#debug
#print "$op compiling\n";
    if ($op eq "S") { # series of 2 components  
      $C2 = pop @CodeStack;
      $C1 = pop @CodeStack;
      push @CodeStack, $C1 . "\$x = \$y;\n" . $C2;

    }
    elsif ($op eq "C") { #conditional, 3 components
      $Cfalse = pop @CodeStack;
      $Ctrue = pop @CodeStack;
      $Ctest = pop @CodeStack;
      push @CodeStack, "$xsname = \$x;\n" . $Ctest . "\$x = $xsname;\nif (abs(\$y) > 0.2) {\n" . $Ctrue . "} else {\n" . $Cfalse . "}\n";
    $xsname .= "s";
    }
    elsif ($op eq "L") { #loop, 2 components
      $Cbody = pop @CodeStack;
      $Ctest = pop @CodeStack;
      push @CodeStack, $Ctest . "\$t = \$y;\n$Nname=1;\nwhile (abs(\$t) > 0.2) {\n" . 
          $Cbody . "\$x = \$y;\n" . $Ctest . "\$t = \$y;\nif($Nname++>".$Noption.
          ") {die qq{LOOPING}};\n}\n\$y = \$x;\n";
      $Nname .= "N";
    }
    else {
      die "Illegal operand $op in Polish expression";
    }
  }
  else { #operand number, stack code for it
    #index+1 to a program in @prog
    $ExProg = $prog[$op-1];
    $ExProg = "./".$ExProg;
    if ($Xoption) {
      $ExProg = "XqtF ".$theoryProg[$op-1];
    }
    else {
      if ($ExProg =~ /^theory/) {
        $ExProg = "XqtF ".$ccfile[$op-1];
      }
    }
    if ($Toption) {
      push @CodeStack, "
    chop(\$y = \`echo \$x | $ExProg\`);
    \&tracef::find_subdomain(\$x, \$y, \"$ccfile[$op-1]\", \\\@sub_res, \\\$sub_idx);
  
    \$sub_arr_cnt{\"$ccfile[$op-1]\".(\$sub_idx-1)}++ ;
    \n\n";
    }
    else {
      push @CodeStack, "chop(\$y = \`echo \$x | $ExProg\`);\n";
    }
  }
} # end foreach op in Polish

#resulting code string is all that's left on the stack
$c = pop @CodeStack;
print SP $c;  #includes all newlines, etc.

if ($Toption) {
  print SP qq{tracef::list_subdomains(\\\%sub_arr_cnt, \\\@list_ccf) ; print "\$y \\n";\n};
}
else {
  print SP qq{print "\$y \\n";\n};  
}
#end of generating Perl program(s)
close SP;

#do the chmod so it can be executed
`chmod 755 SystemCode`;

unless ($Poption) {exit;} #no need to execute (fix P later)

# get the number of points to use on each subdomain
open (SCF, "< system.scf") or die "couldn't open system test configuration file";
chop ($_=<SCF>); #discard initial filename
$k = 0;
$tot_weight = 0;
$tot_count = 0;
$min_weight = 100;
while (defined ($_ = <SCF>)) {
  chop;
  @line = split (' ', $_);
  $subLeft[$k] = $line[0]; 
  $subRight[$k] = $line[1] ;
  $sub_cnt[$k] = $line[2] ;
  $tot_count += $line[2];
  if ($Poption) { #profile, must have weights
    unless (defined($line[3])) {
      die "weight missing in system.scf file";
    }
    $weight[$k] = $line[3];
    if ($line[3] > 0 && $line[3] < $min_weight) {
      $min_weight = $line[3];
    }
    $tot_weight += $line[3];
  }
  $k++ ;
}
$num_subs = $k ;
if ($Poption) {
  die "profile weights must sum to 100%, not ",$tot_weight unless ($tot_weight == 100);
  #adjust counts to profile
  $subAve = $tot_count/$num_subs;
  if ($subAve*$min_weight/100 < 13) { #adjust to at least 13 points in lightest subdomain
    $subAve = 13*100/$min_weight;  
  }
  for ($k = 0; $k < $num_subs; $k++) {
    $sub_cnt[$k] = int($subAve*$weight[$k]/100);
    #debug
    #print "profile count: $sub_cnt[$k]\n";
  }
}

#$subLeft[$k] = $line[1];  #what's this??!
close (SCF);

# calculate the average system output and runtime for each subdomain 

# open system results file
$system_results_filename = "SmeasF.dat" ;
open(XSDAT, ">".$system_results_filename ) or die "could not open the file", $system_results_filename ;

# traverse subdomains of components
SUBD: for ($sub_idx=0; $sub_idx<$num_subs; $sub_idx++) {
  if ($sub_cnt[$sub_idx] == 0) { #skip no-weight subdomains
    next SUBD;
  }
  &samplingf::init($subLeft[$sub_idx], $subRight[$sub_idx], $sub_cnt[$sub_idx]);
  # choose equi-distant inputs for a subdomain
  $tstpt = &samplingf::next ;
  $sed = "sed 's/^/out:  /'";  # command to reproduce stdin to stdout with a leading "out:  "
  $sys_runtime = 0;
  #Really time the running system, too  TBD
  #($tmp,$tmp,$cuser1,$tmp) = times;
     #debug - show subdomain borders
     #print "subdomain: ", $subLeft[$sub_idx], "...", $subRight[$sub_idx], "\n" ;
  $sys_output = 0;
  for ($input_idx=0 ; $tstpt ne "."; $input_idx++) {
    #debug
     #print "point: $tstpt \n";
# Run the composite system created above with the selected inputs
    $cmd = "(echo ".$tstpt."| ./SystemCode |".$sed.") 2>&1|" ;

#debug
#print "$cmd \n";
    # Get the real time used  TBD
    #($tmp,$tmp,$cuser2,$tmp) = times;
    #$tmp = $cuser2 - $cuser1;  #elapsed real time
    #print "Actual time used on ["$subLeft[$sub_idx],$subRight[$sub_idx]]: $tmp \n";
    #TBD:  need option to use this

    open(PI,$cmd);
    # results all come out together, but stdout is preceeded by "out:  "
    $thisRuntime = 0;
    while ($line = <PI>) {  #not eof, all output from this system on this input
#debug
#print "$line \n";
      @outstrm = split(' ',$line);
      #debug
      #print "$outstrm[0] \n";
      if ($outstrm[0] =~ /out:/) {
        $sys_output += $outstrm[1];
        #debug
        #print "$outstrm[1]\n";
      }
      else {
        if ($outstrm[0] =~ /LOOPING/) {
          die "System may be looping on input ", $tstpt, "; stopped at ",$Noption, " iterations";
        }
        $thisRuntime += $outstrm[0];
        $sys_runtime += $outstrm[0];
      }
    }
    #debug
    #print "rt: $thisRuntime\n";
    close(PI);

  #debug
  #print "System runtime is: ", $sys_runtime, "\n" ;
  $tstpt = &samplingf::next ;
  } #end loop over subdomain samples

#In case we even need the real runtime measured over the execution:
#$realtime = int(100*($cuser2-$cuser1)/$input_idx);
#print "Actual runtime: ". $realtime . "\n";

  $sys_runtime /= $input_idx ;
  $sys_output /= $input_idx ;
  printf XSDAT "%s%s\n", &dec15::dump15s($sys_output), &dec15::dump15s($sys_runtime);
} # end loop over list of subdomains

# delete temporary file
 unlink "tmp_hash" ;
