#!/usr/bin/perl -w

#SmeasFT script, measure composite system values for an arbitrary system.
# "Theory" version that uses theory files in place of actual code
#  CmeasF must have created 
#  xxx.ccft corresponding to xxx.ccf for the actual code

use samplingf ;
use dec15;

# pick up options, if any
$Noption = 1000; #default loop count
$Toption = 0;  #no trace
$Coption = 0;  #assume linear
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 "-C") {
    $Coption = 1;
  }
}

#destroy the existing trace path file, if any
system("rm -f trace_path");

# figure out how many components we have
open (SSCF, "< system.pscf") or die "couldn't open system configuration file";

# get the system structure
chop ($RevPolish = <SSCF>);
#find the largest component number used
@PE = split(" ", $RevPolish);
$num_comps = 0;
foreach $num (@PE) {
  unless ($num =~ /\D/) {
    if ($num_comps < $num) {$num_comps = $num ;}
  }
}
#debug
#print "$num_comps \n";

# build a list of .ccft file names for the components
for ($i=0; $i<$num_comps; $i++) {
   chop($compfile = <SSCF>);
   @wholename = split(/\./,$compfile);
#debug
#print "component filename $i: ", $compfile, "\n" ;
   $ccfile[$i] = $compfile;
   $ccfprog[$i] = $wholename[0].".ccft";
}
close (SSCF);
# see if components are all usable
for ($k=$num_comps-1; $k >= 0 ; $k--) {
  unless (-e $ccfprog[$k]) {
    die "component ",$ccfprog[$k]," theory file doesn't exist";
  }
}

#construct a Perl program that does the Polish in @PE using these components
#in "thSystemCode" 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

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

if ($Toption) {
print SP "use tracef;\n";
#print SP "open (TEMP, \">>thtrace_path\") or die \"Can't open data file for writing\";\n";
print SP "tracef::count_subdomains \\\%sub_arr_cnt, \\\@list_ccf ; \n";
#print SP "\nprint TEMP \"---------------------------------------------------------------------------------\\n\";\n";
#print SP "print TEMP \"\tINPUT\t\tOUTPUT\t\tSUBDOMAIN\t\tCOMPONENT\\n\";\n";
#print SP "print TEMP \"---------------------------------------------------------------------------------\\n\";\n";
}

foreach $op (@PE) { # process the Polish
#Should check for stackunderflow and excess operands, as in "SYN"
#TBD
  if ($op =~ /\D/) { #operator
    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, $Ctest . "if (\$y\!=0) {\n" . $Ctrue . "  } else {\n" . $Cfalse . "}\n";
    }
    elsif ($op eq "L") { #loop, 2 components
    $Cbody = pop @CodeStack;
    $Ctest = pop @CodeStack;
    push @CodeStack, $Ctest . "\$t = \$y;\n\$N=0;\nwhile (\$t\!=0) {\n" .
          $Cbody . "\$x = \$y;\n" . $Ctest . "\$t = \$y;\nif(\$N++>".$Noption.
          ") {die qq{LOOPING}};\n}\n\$y = \$x;\n";
    }
    else {
      die "Illegal operand $op in Polish expression";
    }
  }
  else { #operand number, stack code for it
    #index+1 to a theory file in @ccfile
    $ExProg = "XqtF ".$ccfprog[$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

if ($Toption) {
#print SP "\nprint TEMP \"---------------------------------------------------------------------------------\\n\";\n";
}

#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
close SP;

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

# 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;
$sub_idx = 0;
while (defined ($_ = <SCF>)) {
  chop;
  @line = split (' ', $_);
  #$sub_points[$k] = $line[0];
  $sub_points[$k] = $line[0];
  $sub_points[$k+1] = $line[1] ;
  $sub_cnt[$sub_idx] = $line[2] ;
  $k+=2 ;
  $sub_idx++ ;
}
$num_subs = $sub_idx ;
$sub_points[$k] = $line[1];
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
for ($sub_idx=0; $sub_idx<$num_subs; $sub_idx++) {
  #debug
  #printf "$sub_points[2*$sub_idx] $sub_points[2*$sub_idx+1]\n";
  &samplingf::init($sub_points[2*$sub_idx], $sub_points[2*$sub_idx+1], $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
  ($tmp,$tmp,$cuser1,$tmp) = times;
     #DEBUG - show subdomain borders
     #print "subdomain: ", $sub_points[2*$sub_idx], "...", $sub_points[2*$sub_idx+1], "\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."| ./thSystemCode |".$sed.") 2>&1|" ;

#debug
#print "$cmd \n";
    # Get the real time used
    ($tmp,$tmp,$cuser2,$tmp) = times;
    $tmp = $cuser2 - $cuser1;  #elapsed real time
    #print "Actual time used on ["$sub_points[2*$sub_idx],$sub_points[2*$sub_idx+1]]: $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" ;
