#!/usr/bin/perl -w
# Smeast [options] [-N loopcount]
#
# Measure composite system values for an arbitrary system.
# Creates a file "SystemCode" that when executed runs each component in
# its place and acts like a component, and can execute it.
#
# Concurrent components also handled
# 
# Should be the same for stateless, state, concurrent
# Poption to accept profile has drifted out of whack

use sampling ;
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 for execution
$Toption = 0;  #no trace/profiling
$Poption = 0;  #profile provided for the system to weight execution inputs
$Xoption = 0;  #use the component approximation (.ccft) files to execute by table-lookup
               # instead of executing 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 "-P") {
    $Poption = 1;
  }
  if ($ARGV[$i] eq "-X") {
    $Xoption = 1;
  }
}

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

# build a list of .ccf file names and executable names for the components
# find out if any has state
$systemstate = 0;  #assume none
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($fileline = <CCF>);
  @fileand = split(' ', $fileline);
  $filename = $fileand[0];
  if (not defined($fileand[1])) { #regular type
    $fileand[1] = "";
  }
  $StateLess = 0; #assume has state
  # never SYNF .ccf??  Replace check for stateless...
  if ($filename eq "theory") { #bare name means a SYNF-computed component
    $StateLess = 1;
    $Concurrent = 0;
  } else { #check type in header
    $StateLess = 1; #assume no state
    $Concurrent = 0;
    if ($fileand[1] eq "state") {
      $StateLess = 0;
      $systemstate = 1;
      $logi++;
    }
    $Concurrent = 1 if ($fileand[1] eq "concurrent");
  }
  close (CCF);
#print "component code filename $i: ", $filename, "\n";  #debug
   $ccfile[$num_comps] = $c;
   @wholename = split(/\./,$c);
   $ccfbase[$num_comps] = $wholename[0];
  if ($Xoption) {
    $basename = $wholename[0];
    if ($StateLess) {
      $theoryProg[$num_comps] = $basename.".ccft";
    } else {
      $theoryProg[$num_comps] = $basename.".ccfc";
    }
  } else {
    $prog[$num_comps] = $filename ; 
    $basename = &component::baseName($filename);
  }
  $noState[$num_comps] = $StateLess;
  $concurrent[$num_comps] = $Concurrent;
  $basename = &component::baseName($filename); #statefile same for Xoption
  $StateFile[$num_comps] = $basename.".state";
  $num_comps++;
}
#print "$num_comps \n";  #debug
close (SSCF);

  # see if components are all usable
  for ($k=0; $k<$num_comps; $k++) {
    if ($Xoption) {
      die "`theory' component file $theoryProg[$k] not available" unless (-e $theoryProg[$k]);
    } else {
      die "component ",$prog[$k]," can't be executed." unless (-e $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. Input is in Perl var $x
#  2. Places its output in $y
#  3. Run time (STDERR) accumulates in $rt

@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";
if ($systemstate) {
  print SP "require 'systemhelper';\n";
}

if ($Toption) {
print SP "use trace;\n";
print SP "trace::init();\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
$condex = 1; #nesting for concurrent components
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";
    }
    elsif ($op eq "P") { #parallel, 2 components, first must be concurrent
      $slaveC = pop @CodeStack;
      $masterC = pop @CodeStack;
      $condex = pop @ConcStack;
      $bit1 = "";
      if (scalar(@ConcStack) == 0) { #last part of parallel
        $bit1 = "\$rt += \$rc;\n";
      }
      push @CodeStack, $masterC . "\$x = \$y;\n" . $slaveC
           . "\$x = \$y;\n(\$y, \$r3, \$r4) = component::finish(\$x,$condex);\n"
           . "if (\$r3 > \$rc) {\$rc = \$r3;}\n \$rc += \$r4 + \$r1$condex;\n"
           . $bit1;
    } else {
      die "Illegal operand $op in Polish expression";
    }
  }
  else { #operand number, stack code for it
    #$op is index+1 to a program in @prog
    # all ops except concurrent are just run
    if ($Xoption) {
      if ($noState[$op-1]) {
        $ExProg = "perl XqtF $ccfile[$op-1]t";
      } else {	
        $ExProg = "perl XqtS $ccfile[$op-1]";
      }
      if ($concurrent[$op-1]) {
       $ExProg = "perl XqtC $ccfile[$op-1]";
      }
      $ProgArg = '';
    }
    else {
      $ExProg = $prog[$op-1];
      $ProgArg = "";
    }
    $StateF = $StateFile[$op-1];
    $rtv = "t";
    if (scalar(@ConcStack) > 0) { #parallel in progress
      $rtv = "c";  #accummulate only local run time
    }
    
    if ($noState[$op-1]) {
      $StateStuff = "stateless => 1";
      $runStuff = "\$comp->run(\$x);";
      $midStuff = " \$y = \$comp->getOutput; \$r$rtv += \$comp->getRuntime;";
      $lastStuff = "";
    } else {
      $initStuff = "";
      $StateStuff = "statefile => '$StateF'";
      $runStuff = "\$comp[$logi_op]->run(\$x,\$states[$logi_op]);";
      $midStuff = " \$y = \$comp[$logi_op]->getOutput; \$r$rtv += \$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) {
      $extrarg = "";
      unless ($noState[$op-1]) {
        $extrarg = ", \$states[$lastlogiop]";
      }
      $tracestuff = "	\&trace::bump(\"$ccfbase[$op-1]\", \$x $extrarg);";
    } else {
      $tracestuff = "";
    }
    if (!$concurrent[$op-1]) { #regular component
      push @CodeStack, "
      $initStuff
      $runStuff
      $midStuff
      $tracestuff
      $lastStuff
       \n";
    } else { #concurrent, special code
      $bit = "";
      if (scalar(@ConcStack) == 0) { #beginning of a parallel
        $bit = "\$rc = 0;\n";
      }
      push @CodeStack, $bit . "(\$y,\$r1$op) = component::start(\$x,\'$ExProg\',$op);\n";
      push @ConcStack, $op;  #stack the index
    }
  }
} # end foreach op in Polish

print SP "\$| = 1;\n";
for ($i=0; $i<$logi; $i++) { # init state code
  print SP "$initList[$i]\n";
}
print SP "L: while(1){\n";
print SP "chop (\$x = <STDIN>);\n";
print SP "if (\$x eq \".\") {last L;}\n";

if ($systemstate) {
  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
if ($systemstate) {
  print SP "\&saveStates( \@states );\n";
}

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

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

if ($Toption) {
  print SP qq{trace::done();\n};
}

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

#do the chmod so it can be executed
#only execute with "perl SystemCode"
#`chmod 755 SystemCode`;
unless ($Poption) {exit;}
#
################ old SmeasFt code below
# Executes SystemCode (usually done in Xcomp[t]), but Poption stuff is here
# Not likely to be any good for state...

# 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);
    #print "profile count: $sub_cnt[$k]\n";  #debug
  }
}

#$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;
  }
  &sampling::init($subLeft[$sub_idx], $subRight[$sub_idx], $sub_cnt[$sub_idx]);
  # choose equi-distant inputs for a subdomain
  $tstpt = &sampling::next ;
  $sys_runtime = 0;
  #Really time the running system, too  TBD
  #($tmp,$tmp,$cuser1,$tmp) = times;
     #print "subdomain: ", $subLeft[$sub_idx], "...", $subRight[$sub_idx], "\n" ; #debug - show subdomain borders
  $sys_output = 0;
  for ($input_idx=0 ; $tstpt ne "."; $input_idx++) {
     #print "point: $tstpt \n";  #debug
# Run the composite system created above with the selected inputs
    ($sys_out,$thisRuntime) = component::excomp($tstpt, "perl SystemCode");

#print "$cmd \n";  #debug
    # 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

    if ($sys_out =~ /LOOPING/) {
      die "System may be looping on input ", $tstpt, "; stopped at ",$Noption, " iterations";
    }
    $sys_runtime += $thisRuntime;
    $sys_output += $sys_out;

  #print "System runtime is: ", $sys_runtime, "\n" ;  #debug
  $tstpt = &sampling::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" ;
