#!/usr/bin/perl -w

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

use samplings ;
use component;

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...
}

# pick up options, if any
$Voption = 1;
$Noption = 100; #default loop count
$Toption = 0;  #no trace
$Coption = 1;  #assume constant
$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 "-V") {
    $Voption = 1;
  }
  if ($ARGV[$i] eq "-T") {
    $Toption = 1;
  }
  if ($ARGV[$i] eq "-C") {
    $Coption = 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 polish line
$num_comps = 0;
$logi = 0;  #for counting components with state
while ($c = <SSCF>) {
  chop($c);
  open (CCF, "< ".$c) or die "couldn't open configuration file", $c;
  chop($filename = <CCF>);
  $StateLess = 0; #assume has state
  if ($filename eq "theory") { #bare name means a SYNF-computed component
    $StateLess = 1;
  } else { #check to see if there are state subdomains
    $StateLess = 1; #assume no state
    RL: while ($line = <CCF>) { #read to blank line or EOF
      chop($line);
      if ($line eq "") { #end of input subdomains}
        $StateLess = 0;
        $logi++;
	last RL;
      } # if no blank line, will exit RL loop with correct $StateLess value  
    }
  }
  close (CCF);
#debug
#print "component filename $i: ", $filename, "\n" ;
   $ccfile[$num_comps] = $c;
  if ($Xoption) {
    @wholename = split(/\./,$c);
    $basename = $wholename[0];
    $theoryProg[$num_comps] = $basename.".ccft";
  } else {
    $prog[$num_comps] = $filename ; 
    $basename = &component::baseName($filename);
  }
  $noState[$num_comps] = $StateLess;
  $StateFile[$num_comps] = $basename.".state";
  $num_comps++;
}
#debug
#print "$num_comps \n";
close (SSCF);

  # see if components are all usable
  for ($k=0; $k<$num_comps; $k++) {
    if ($Xoption) {
      die "`theory' component file .ccft not available" unless (-e $theoryProg[$k]);
    } else {
      die "component ",$prog[$k]," can't be executed." unless (-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. Places 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 "use component;\n";
print SP "require 'systemhelper';\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";
}

$logi_op = 0; #counter for state names: must be in the order the routines occur in code
$Nname = "\$N";  #use a different counter in nested loops
$xsname = "\$xs"; #use a different save variable around each conditional construction
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, "$xsname = \$x;\n" . $Ctest . "\$x = $xsname;\nif (\$y >= 0.5) {\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 (\$t\>=0.5) {\n" . 
          $Cbody . "\$x = \$y;\n" . $Ctest . "\$t = \$y;\nif($Nname++>".$Noption.
          ") {\$y = qq{LOOPING}; goto OVER;};\n}\n\$y = \$x;\n";
      $Nname = $Nname."N";
    } else {
      die "Illegal operand $op in Polish expression";
    }
  }
  else { #operand number, stack code for it
    #index+1 to a program in @prog
    if ($Xoption) {
      $ProgArg = $ccfile[$op-1];
      if ($noState[$op-1]) {
        $ExProg = "./XqtF";
	$ProgArg .= "t";
      } else {	
        $ExProg = "./XqtS";
      }
    }
    else {
      $ExProg = $prog[$op-1];
      $ProgArg = "";
    }
    $StateF = $StateFile[$op-1];
    
    if ($noState[$op-1]) {
      $StateStuff = "stateless => 1";
      $runStuff = "\$comp->run(\$x);";
      $midStuff = " \$y = \$comp->getOutput; \$rt += \$comp->getRuntime;";
      $lastStuff = "";
    } else {
      $initStuff = "";
      $StateStuff = "statefile => '$StateF'";
      $runStuff = "\$comp[$logi_op]->run(\$x,\$states[$logi_op]);";
      $midStuff = " \$y = \$comp[$logi_op]->getOutput; \$rt += \$comp[$logi_op]->getRuntime;";
      $lastStuff = "\$states[$logi_op] = \$comp[$logi_op]->getState;";
      $logi_op++;  #bump phony state number
    }
    $initState = "component->new(component => '$ExProg', comparg => '$ProgArg', $StateStuff);";
    if ($noState[$op-1]) {
      $initStuff = "\$comp = $initState";
    } else {
      $lastlogiop = $logi_op - 1;
      $initList[$lastlogiop] = "\$comp[$lastlogiop] = $initState;";
    }
    if ($Toption) {
      $tracestuff = "
      \&tracef::find_subdomain(\$x, \$y, \"$ccfile[$op-1]\", \\\@sub_res, \\\$sub_idx);
           \$sub_arr_cnt{\"$ccfile[$op-1]\".(\$sub_idx-1)}++ ;"
    } else {
      $tracestuff = "";
    }
    push @CodeStack, "
    $initStuff
    $runStuff
    $midStuff
    $lastStuff
    $tracestuff
     \n";
  }
} # end foreach op in Polish

print SP "chop (\$x = <STDIN>);\n";

for ($i=0; $i<$logi; $i++) { # init state code
  print SP "$initList[$i]\n";
}

print SP "\@states = \&loadStates($logi);\n";
print SP "\$rt = 0;\n";

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

#label exit
print SP "OVER:\n";

# save component states
print SP "\&saveStates( \@states );\n";

die "Component list doesn't match reverse Polish description" unless ($logi == $logi_op);

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};  
}

print SP qq{print STDERR "\$rt\\n";\n};

#end of generating Perl program(s)
close SP;

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


exit;
################ CUT old SmeasF code here

# 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;
  }
  &samplings::init($subLeft[$sub_idx], $subRight[$sub_idx], $sub_cnt[$sub_idx]);
  # choose equi-distant inputs for a subdomain
  $tstpt = &samplings::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 = &samplings::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 "%f %f\n", $sys_output, $sys_runtime;
} # end loop over list of subdomains

# delete temporary file
 unlink "tmp_hash" ;
