#!/usr/bin/perl -w

#calculation script CalcF for one construct
# floating-point intervals version
# Uses "xxx.ccft" files for component specs

use dec15;

$realeps = &dec15::geteps();
$eps = $realeps;  #larger than actual float granularity 

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

#get options
$Voption = 0;  #default is silent
$Coption = 0;  #default is L
$Loption = 1;
$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 "-C") {
    $Coption = 1; $Loption = 0;
  } 
  if ($ARGV[$i] eq "-L") {
    $Coption = 0; $Loption = 1;
  }
}

#########################################
#   read configuration file system .sscf
#########################################
$i = 0;
open(SSCF, "system.sscf");
chop($type = <SSCF>);
#debug
#print "|$type|\n";
if($type eq "conditional" || $type eq "loop") {
  chop ($ccf0 = <SSCF>);
}
chop($ccf1 = <SSCF>);  #The TRUE branch for conditional
unless ($type eq "loop") {
  chop($ccf2 = <SSCF>);
}
close SSCF;

########################################################
#Subroutine definition:
#return the vector of subdomain values for parameter file
#value is an array of strings, the string at subscript K
#being the line containing the subdomain intervals.

sub process_ccf { #one parameter: file name to read
  my ($i, $filePre, $line, @r);
#debug
#print "ccf file: $_[0] \n";
  @filePre = split(/\./,$_[0]);
  $ProgFile = $filePre[0];  # use .ccf file name w/o .ccf
  #debug
  #print "Program file: $ProgFile \n";
  open(CCF,$_[0]) or die "no component control file ",$_[0];
  chop($line = <CCF>);
  if ($line ne "theory") { #must get the file made by CmeasF
    close(CCF);  #use the same name
    open(CCF,$filePre[0].".ccft") or die "component ",$filePre[0]," has no measured .ccft file";
    $line = <CCF>;  #discard "theory" name
  }
  $i = 0;
  while ($line = <CCF>) {
    $r[$i] = $line;
    $i++;
  }
  close(CCF);
  return @r; #and global $ProgFile
}
#end of subroutine
##########################################################

#the "rangex" arrays contain line strings for the subdomain intervals
#and must be split out to be used

#Test component is range0
if ($type eq "conditional" || $type eq "loop") {
  @range0 = process_ccf($ccf0);
  $range0cnt = $#range0+1;
  $p0 = $ProgFile;
}

#range1 is 1st in series, TRUE for conditional, body for loop
@range1 = process_ccf($ccf1);
$range1cnt = $#range1+1;
$p1 = $ProgFile;

#range2 is 2nd in series, FALSE for conditional
unless ($type eq "loop") {
  @range2 = process_ccf($ccf2);
  $range2cnt = $#range2+1;
  $p2 = $ProgFile;
}

##########################################
# component 0 is the test, if a conditional or loop
# component 1 first in a series, "true" part for conditional, body for a loop
# then component 2 if a series or "false" part of conditional
##########################################

#Read and store values from component measurements
#TBD do something about this ugly code

if ($type eq "conditional" || $type eq "loop") {
  for ($i=0; $i < $range0cnt; $i++) {
    @line = split(" ",$range0[$i]);
    #debug
    #print "@line\n";
    $subDleft0[$i] = $line[0];
    $subDright0[$i] = $line[1];
    if ($Loption) {
       $bool = $line[4];  #for test below
       #$valSlope0[$i] = $line[3]; #should always be zero for a test component; not used
       if ($line[3] > $eps) {
         $bool = 2; #cause error below
       }
       $valIntcpt0[$i] = $line[4];
       $runSlope0[$i] = $line[5];
       $runIntcpt0[$i] = $line[6];
    }
    if ($Coption) {
      $valAve0[$i] = $line[3];
      $bool = $line[3];  #for test below
      $runAve0[$i] = $line[4];
    }
    unless (abs($bool) <= $eps || abs($bool - 1) <= &dec15::epsplace(1)) { #not binary 
      die "test component ",$p0," does not have 1/0 binary value on subdomain [",$line[0],", ",$line[1],")";
    }
  }
}
for ($i=0; $i < $range1cnt; $i++) { 
  @line = split(" ",$range1[$i]);
  $subDleft1[$i] = $line[0];
  $subDright1[$i] = $line[1];
  if ($Loption) {
    if ($line[2] ne "L") {
      die "option -L but component file ",$p1," is not measured as piecewise-linear";
    }
       $valSlope1[$i] = $line[3];
       $valIntcpt1[$i] = $line[4];
       $runSlope1[$i] = $line[5];
       $runIntcpt1[$i] = $line[6];
  }
  if ($Coption) {
    if ($line[2] ne "C") {
      die "option -C but component file ",$p1," is not measured as step-function";
    }
    $valAve1[$i] = $line[3];
    $runAve1[$i] = $line[4];
  }
}

unless ($type eq "loop") {
  for ($i=0; $i < $range2cnt; $i++) { 
    @line = split(" ",$range2[$i]);
    $subDleft2[$i] = $line[0];
    $subDright2[$i] = $line[1];
    if ($Loption) {
       $valSlope2[$i] = $line[3];
       $valIntcpt2[$i] = $line[4];
       $runSlope2[$i] = $line[5];
       $runIntcpt2[$i] = $line[6];
    }
    if ($Coption) {
      $valAve2[$i] = $line[3];
      $runAve2[$i] = $line[4];
    }
  }
}

#################################################
# Subroutine definitions:
#
# take two intervals as arrays (left 0, right 1, left 2, right 3) 
#as input, and return # the intersection interval as a similar array.
# If the intersection is empty, return [1,0)
#

sub intersect { 
my(@int1,@int2,$t,@nul);
@nul = (1, 0);
@int1 = ($_[0], $_[1]);
@int2 = ($_[2], $_[3]);
#debug
#print "@int1\n";
#print "@int2\n";
# Make @int1 lie to the left
if ($int1[0] > $int2[0]) { 
  @int2 = ($_[0], $_[1]);
  @int1 = ($_[2], $_[3]);
}
if ($int1[0] < $int2[0]) { #strictly to the left
  if ($int1[1] <= $int2[0]) { #no intersection
    return @nul;
  }
  else {
    if ($int1[1] <= $int2[1]) { 
      return ($int2[0],$int1[1]);
    }
    else { #must be that 1 completely covers 2
      return ($int2[0],$int2[1]);
    }
  }
}
else { #left ends coincide
  if ($int1[1] <= $int2[1]) {$t = $int1[1];} else {$t = $int2[1];}
  return ($int1[0],$t);
}
}

##################################################
# test for empty interval
#   parameters are endpoints
sub notnull {
my($left, $right);
 $left = shift;
 $right = shift;
 #debug
 #print "empty? [$left $right)\n";
 if ($left >= $right) { return 0;  #empty
 }
 else { return 1;
 }
}
#####################################################

if ($Loption) {
    $itf = 7;
  }
  if ($Coption) {
    $itf = 5;
  }
$theorytest = "once.ccf";
$theoryseries = "another.ccf";
$again = "again.ccf";
$theory = "theory.ccf";

if ($type eq "conditional") {
  $k = 0; #counter for new subdomains created in @range3 structure
  $jstartT = 0;
  $jstartF = 0; #left-off indices for 2nd component subdomains
  for ($i=0; $i<$range0cnt; $i++) { #intersect subdomains
    if ($Coption) {
      $testTrue = 0+$valAve0[$i];
    }
    if ($Loption) {
      $testTrue = 0+$valIntcpt0[$i];
    }
    $foundany = 0;
    if ($testTrue) {  # test is true on this subdomain
#TBD clean up repetitive code...  (careful of ...1 and ...2)
      ITL: for ($j=$jstartT; $j<$range1cnt; $j++) { # find any intersections with the proper component
        @int = intersect(($subDleft0[$i],$subDright0[$i]),($subDleft1[$j],$subDright1[$j]));
#debug
#print "@int \n";
        if (notnull(@int)) { #add to list of new subdomains
          $foundany = 1;
          $range3[$k] = dec15::dump15s($int[0]).dec15::dump15s($int[1]);
          if ($Loption) {
            $thtimeSlope[$k] = $runSlope1[$j] + $runSlope0[$i];
            $thtimeIntcpt[$k] = $runIntcpt1[$j] + $runIntcpt0[$i];
            $thvalSlope[$k] = $valSlope1[$j];
            $thvalIntcpt[$k] = $valIntcpt1[$j];
            $range3[$k] = $range3[$k] . "L ".dec15::dump15s($thvalSlope[$k]).dec15::dump15s($thvalIntcpt[$k]).dec15::dump15s($thtimeSlope[$k]).dec15::dump15s($thtimeIntcpt[$k])."TRUE";
          }
          if ($Coption) {
            $thval[$k] = $valAve1[$j];
            $thtime[$k] = $runAve1[$j] + $runAve0[$i];
            $range3[$k] = $range3[$k] . "C ".dec15::dump15s($thval[$k]).dec15::dump15s($thtime[$k])."TRUE";
          }
          $k++;
        }
        else { #null intersection
          if ($foundany) {
            $jstartT = $j - 1;  #next time start where one was found
            last ITL;  #can't be any more this time
          }
        }
      }
    }
    else { # test false on this subdomain
      IFL: for ($j=$jstartF; $j<$range2cnt; $j++) { # find any intersections with the proper component
        @int = intersect(($subDleft0[$i],$subDright0[$i]),($subDleft2[$j],$subDright2[$j]));
#debug
#print "@int \n";
        if (notnull(@int)) { #add to list of new subdomains
          $foundany = 1;
          $range3[$k] = dec15::dump15s($int[0]).dec15::dump15s($int[1]);
          if ($Loption) {
          $thtimeSlope[$k] = $runSlope2[$j] + $runSlope0[$i];
          $thtimeIntcpt[$k] = $runIntcpt2[$j] + $runIntcpt0[$i];
          $thvalSlope[$k] = $valSlope2[$j];
          $thvalIntcpt[$k] = $valIntcpt2[$j];
            $range3[$k] = $range3[$k] . "L ".dec15::dump15s($thvalSlope[$k]).dec15::dump15s($thvalIntcpt[$k]).dec15::dump15s($thtimeSlope[$k]).dec15::dump15s($thtimeIntcpt[$k])."FALSE";
          }
          if ($Coption) {
            $thval[$k] = $valAve2[$j];
            $thtime[$k] = $runAve2[$j] + $runAve0[$i];
            $range3[$k] = $range3[$k] . "C ".dec15::dump15s($thval[$k]).dec15::dump15s($thtime[$k])."FALSE";

          }
          $k++;
        }
        else { #null intersection
          if ($foundany) {
            $jstartF = $j - 1;  #next time start where one was found
            last IFL;  #can't be any more this time
          }
        }  
      }
    }
  }
  $range3cnt = $k;
}
elsif ($type eq "series") {

#sub locateOutput { #compare serial & binary search
#$Serial = locateOutputS($_[0]);
#$Binary = locateOutputB($_[0]);
#if ($Serial != $Binary) {
  #warn "Searches disagreed: ", $Serial, " != ",$Binary;
#}
#return $Serial;
#}

#sub locateOutput{ #parameter is the point to locate in 2nd component domains
sub locateOutputS{ #parameter is the point to locate in 2nd component domains
 #return is the index in $range2 structure, or -1 if not found 
  my($find,$j);
  $find = $_[0];
  for ($j = 0; $j < $range2cnt; $j++) { #serial search for now
    @rec = split(" ", $range2[$j]);
    if ($find >= $rec[0] && $find < $rec[1]) { #found here
      return $j;
    }
  }
  return -1;
}

#sub locateOutputB{ #binary search version
sub locateOutput{ #binary search version
  my($needed,$L,$R,$j);
  $needed = $_[0];
  $L = 0;
  $R = $range2cnt-1;  #extremes of subscripts of intervals
  INNER: while (1) {  #must jump out
    #subdomains are in order and disjoint, but may not cover the domain
    $j = int(($L + $R)/2);  #careful, must look at two intervals at the end
                            # if two, then $j is $L to start
  #debug
  #$str = "binary search for ".$needed." in [".$L.",". $R ."], index: ".$j;
  #print "$str \n";
  #end debug
    if ($R - $L + 1 <= 2) { #must be in these subdomains if here
      #try first one
      #debug
      #printf "needed: %.18e in [%.18e,%.18e)\n", $needed, $subDleft2[$j],$subDright2[$j];
      if ($needed >= $subDleft2[$j] && $needed < $subDright2[$j]) { #found
        last INNER
      }
      if ($L != $R) { # there were two, try the other
        $j = $R;
      #debug
      #printf "needed: %.18e in [%.18e,%.18e)\n", $needed, $subDleft2[$j],$subDright2[$j];
        if ($needed >= $subDleft2[$j] && $needed < $subDright2[$j]) { #found
          last INNER
        }
      }
      #not in either one, so can't be found
      return -1;
    }
    else { # [L,R] more than two subdomains; which way to shift?
      if ($needed < $subDleft2[$j]) { #it's left of here
        $R = $j;
      }
      else { #right
        $L = $j;
      }
    }
  } #end while(1)
  return $j;
} #end binary search version

  if ($Loption) {
    @rec0 = split(" ",$range2[0]);
    @reck = split(" ",$range2[$range2cnt-1]);
    $k = 0;  #accumulate new subdomains in $range3[$k]
    SUBD: for($i=0; $i<$range1cnt; $i++) { #over all first subdomains
      $begin1 = $subDleft1[$i];
      $end1 = $subDright1[$i];
      #1st component subdomain is [$begin1, $end1]
      if ($end1 < $begin1) { #switch; should not happen
        warn "interval [,",$begin1,", ",$end1,") reversed?";
        $t = $end1;
        $end1 = $begin1;
        $begin1 = $t;
      }
      #debug
      #print "Subd: [$begin1, $end1)\n";
      $slope = $valSlope1[$i];
      $intcpt = $valIntcpt1[$i];
      $L = 0;  # count of intervals into which this subdomain is broken
      $left = $begin1;
      SUBSUB: while ($left < $end1) { #jump out when all intervals obtained
        #Assumes contiguous subdomains in 2nd component, fix TBD
        $needed = $slope*$left + $intcpt; 
        #debug
        #print "in: $left, out: $needed\n";
        $j = locateOutput($needed); 
        if ($j < 0) { #not found
          if ($L) { #but some found already, so rest uncovered
            warn "Subdomain [",$left,",",$end1,") outputs from ",$p1, " fall in no ",$p2," subdomains";
            warn " (input ",$left,"  output ",$needed,")";
              last SUBSUB;            
          } 
          #continues if none found so far
          $oldleft = $left;
          if ($slope == 0) {
            $left = $end1;
          }
          elsif ($slope > 0) { #reflect back the first interval start
            $left = ($rec0[0] - $intcpt)/$slope;
          }
          else { #slope negative, reflect back the last interval end
            $left = ($reck[1] - $intcpt)/$slope
          }
          #try again with new $left, but some uncovered
          #debug
          #print "$oldleft -> $left\n";
          warn "Subdomain [",$begin1,",",$left,") values from ",$p1, " fall in no ",$p2," subdomains";
          warn " (input ",$oldleft,"  output ",$needed,")";
          next SUBSUB;
        } #continues below only if $left's output found at $j
        @check = split(" ",$range2[$j]); #get 2nd component values
        $jj = locateOutput($slope*$end1 +$intcpt);
        if ($jj == $j) { #same interval (covers slope 0 case)
        #if ($slope == 0) { 
          #whole interval retained
          $right = $end1;
        }
        #reflect back 2nd-component interval boundary to 1st domain
        elsif ($slope > 0) {
          $right = ($subDright2[$j] - $intcpt)/$slope; 
        }
        else { #slope < 0
          $right = ($subDleft2[$j] - $intcpt)/$slope; 
        } #end slope cases  
        if ($right + &dec15::epsplace($right) >= $end1) { #create no eps-size subdomains
            $right = $end1;
        }
        if ($right != $end1 && abs($slope) > $eps && $left+&dec15::epsplace($left)<$right) { 
          # adjust $right for float approx problems:  
          #move right if in same domain
          $nj = $j;
          $manyj = 0;
          while ($nj >= 0 && $j == $nj && $right < $end1 && $manyj < 99) { 
            $nneed = $slope*$right + $intcpt;
            $nj = locateOutput($nneed);
            if ($j == $nj) { #float problem, same 2nd interval shift right
              $right += &dec15::epsplace($right);
              if ($right >= $end1) {
                $right = $end1;
              }
              else {
                $manyj++;
              }
            }
          }
          if ($manyj) { #had to shift
            if ($manyj > 2) { #otherwise not worth noting
              warn "boundary shift right ",$manyj," times";
            }
          }
          else { #try moving left
            $nj =$j+1; #anything not equal
            $manyj = -1;
            while ($nj >= 0 && $j != $nj && $manyj < 101) {
              $right -= &dec15::epsplace($right);
              $nneed = $slope*$right + $intcpt;
              $nj = locateOutput($nneed);
              $manyj++;
            }
            $right += &dec15::epsplace($right);
            if ($manyj > 2) {
              warn "boundary shift left ",$manyj," times";
            }
          }
          if ($manyj > 2) {
            warn "  on subdomain [",$left,", ",$right,")";
          }
        } #end float adj
        unless ($manyj || $right == $end1) { #did not shift, check interior endpoint
          $nneed = $slope*$right + $intcpt;
          $nj = locateOutput($nneed);
          if ($j == $nj) { #end point in same subdomain as already used
            $right += &dec15::epsplace($right);  #shift right
          }
        }
        if ($right < $left+&dec15::epsplace($left)) { #should never happen; ignore if it does
          warn "in (1)[",$begin1,", ",$end1,"), (2)[",$check[0],", ",$check[1],"): tiny subdomain ignored [",$left,", ",$right,"); slope: ",$slope,"; value: ",$needed;
          if (abs($slope) > $eps) { #shift and try again
            $left = $left + &dec15::epsplace($left);
          }
          else { #skip to interval end
            $left = $end1;
          }
          next SUBSUB; #ignore the tiny interval
        }
        $thvalSlope[$k] = $slope*$valSlope2[$j];
        $thvalIntcpt[$k] = $valSlope2[$j]*$intcpt + $valIntcpt2[$j];
       # run times: mx+b + m'x'+b', x' = output of C1 on input x
        $thtimeSlope[$k] = $runSlope1[$i] + $slope*$runSlope2[$j];
        $thtimeIntcpt[$k] = $runSlope2[$j]*$intcpt + $runIntcpt2[$j] + $runIntcpt1[$i];
        if (defined($check[7])) {
          $TF = $check[7];
        }
        else {
          $TF = "SERIES";
        }
        $range3[$k] = dec15::dump15s($left).dec15::dump15s($right)."L ". dec15::dump15s($thvalSlope[$k]).dec15::dump15s($thvalIntcpt[$k]).dec15::dump15s($thtimeSlope[$k]).dec15::dump15s($thtimeIntcpt[$k]).$TF;
        #debug
        #print "$range3[$k] \n";
        $L++;
        $k++;
        if ($right >= $end1) { #test for done with covering this subdomain
          last SUBSUB;
        }
        $left = $right;
      } #end of SUBSUB loop
    }  # end for $i (first comp subdomain loop)
    $range3cnt = $k;
  } #end L-option
  if ($Coption) {
    ILOOP: for($i=0; $i<$range1cnt; $i++) {
      $j = locateOutput($valAve1[$i]);
      if ($j <0 ) { #not found
        warn "Subdomain [",$subDleft1[$i],",",$subDright1[$i],") output ",$valAve1[$i]," is not in any following subdomain!";
        #TBD needs cleanup to continue without this subdomain
        next ILOOP;
      }
      $thtime[$i] = $runAve2[$j] + $runAve1[$i];
      $thval[$i]  = $valAve2[$j];
      @interval = split(" ",$range2[$j]);
      $TorF[$i] = $interval[5];
    }
  } #end C option
}
elsif ($type eq "loop") {
  #create subdirectory, do single calculation there, and bring back to this
  # directory the computed "theory" file 
  $subdir = ".SubCalcLoop";  #name of the subdirectory
  print `rm -r -f $subdir`; #destroy directory so it can be used repeatedly
  mkdir $subdir;
  #$fileList = "CalcFA samplingf.pm dec15.pm $ccf0 $ccf1 ident.ccf ident.bin ident.ccfl $p0 ";
  #maybe later
  #if ($p1 !~ "theory") {
    #$fileList = $fileList.$p1;
  #}

  #`cp $fileList $subdir`;  #copy needed files
  `cp * $subdir`;  #copy needed files
  chdir $subdir; #shift to new directory
#debug -- where are we?
#print `pwd`;
  #build a proper .sscf file
  open (SSCF, ">system.sscf") || die "can't create .sscf file for calculation";
  if ($p1 eq "theory") {
    @tmp = split(/\./,$ccf1);
    $p1 = $tmp[0];  #no "program" name, use file name w/o .ccf
  }
  $p2 = "(ident)";
  if ($Loption) {
    $Cfalse = "ident.ccfl";
  }
  if ($Coption) {
    $Cfalse = "ident.ccf";
  }
  $Ctrue = $ccf1;
  $Ctest = $ccf0;
  warnmess "  Conditional:  IF ",$p0," THEN ",$p1," ELSE ",$p2," FI -> ",$theorytest," -> ",$again;
  print SSCF "conditional\n";
  print SSCF "$Ctest\n";
  print SSCF "$Ctrue\n";
  print SSCF "$Cfalse\n";
  close SSCF;
#debug
#print `cat system.sscf`;
  if (-1 == system "./CalcF ".$allOptions) {die "`CalcF' script failed"} ;
  $cmd = "mv -f ".$theory." ../".$theorytest;
  `$cmd`;
  chdir ".."; #back to parent directory

  # copy FALSE subdomains into "theory.ccf"
  #  and the TRUE subdomains into "again.ccf"
  open (THEO, $theorytest) || die "Can't open ", $theorytest;
  $tmp = <THEO>;  #skip first line (file name)
  open (THE, ">".$theory) || die "Can't open ",$theory;
  print THE "theory\n";
  open (AGAIN, ">".$again) || die "Can't open ",$again;
  print AGAIN "theory\n";
  $anytrue = 0;
  while ($line = <THEO>) {
    @isit = split(" ", $line);
    if ($isit[$itf] eq "TRUE")  {
      print AGAIN $line;
      $anytrue += 1;
    }
    else { #came out FALSE
      if ($isit[$itf] ne "FALSE") {die "Non-Aristotlian!";}
      print THE $line;
    }
  }
  close(THEO);
  close(THE);
  close(AGAIN);
  if ($anytrue) {
    warnmess "  (",$again," stripped of false subdomains -- ",$anytrue," true)";
  }
  #TBD  The "again" files should be given names "again1.ccf", etc., and saved

  #$fileList = $fileList . " ".$again." ".$theorytest;
  while ($anytrue) { #not all the subdomains came out FALSE
#debug
#dump the "yet to do" .ccfl file
#print "Dump of `again.ccfl':\n";
#print `cat again.ccfl`;

    #check for unending theory loop
    open(ONE,">again1");
    open(AGAIN,$again);
    $tmp = <AGAIN>; #discard name
    while ($line = <AGAIN>) { #copy part of each line
      @part = split(" ",$line);
      if ($Loption) {
        print ONE "$part[0] $part[1] $part[3] $part[4]\n";
      }
      if ($Coption) {
        print ONE "$part[0] $part[1] $part[3]\n";
      }
    }
    close(ONE);
    close(AGAIN);
  
    #create subdirectory, do calculation there, and bring back the result
    $subdir = ".SubCalcLoop";  #name of the subdirectory
    print `rm -r -f $subdir`; #destroy directory so it can be used repeatedly
    mkdir $subdir;
    #`cp $fileList  $subdir`;  #copy needed files
    `cp * $subdir`;  #copy needed files
    chdir $subdir; #shift to new directory
  #debug -- where are we?
  #print `pwd`;
    #build a proper .sscf file
    open (SSCF, ">system.sscf") || die "can't create .sscf file for calculation";
    #$p1 = "again";
    #$p2 = "theorytest";
    print SSCF "series\n";
    print SSCF "$again \n";
    print SSCF "$theorytest \n";
    close SSCF;
  #debug
  #print `cat system.sscf`;
    if (-1 == system "./CalcF ".$allOptions) {die "`CalcF' script failed"} ;
    $cmd = "mv -f ".$theory." ../".$theoryseries;
    `$cmd`;
    chdir ".."; #back to parent directory
  
    #copy FALSE subdomains into "theory.ccf", TRUE into "again.ccf"
    #check if all subdomains have taken FALSE branch
  
    open (THEO, $theoryseries) || die "can't open $theoryseries";
    $tmp = <THEO>;  #skip first line (file name)
    open (THE, ">>".$theory) || die "can't append to $theory";
    open (AGAIN, ">".$again) || die "can't open $again";
    print AGAIN "theory\n";
    $anytrue = 0;
    while ($line = <THEO>) {
      @isit = split(" ", $line);
      if ($isit[$itf] eq "TRUE")  {
        print AGAIN $line;
        $anytrue += 1;
      }
      else { #came out FALSE
        if ($isit[$itf] ne "FALSE") {die "Non-Aristotlian!";}
        print THE $line;
      }
    }
    $moremess = "";
    if ($anytrue) {
      $moremess = " (".$anytrue." still true)";
    }
    warnmess "  Series: ",$again,"; ",$theorytest," -> ",$theoryseries," -> ",$again,$moremess;
    close(THEO);
    close(THE);
    close(AGAIN);
    #has the file changed?
    open(TWO,">again2");
    open(AGAIN,$again);
    $tmp = <AGAIN>; #discard name
    while ($line = <AGAIN>) { #copy part of each line
      @part = split(" ",$line);
      if ($Loption) {
        print TWO "$part[0] $part[1] $part[3] $part[4]\n";
      }
      if ($Coption) {
        print TWO "$part[0] $part[1] $part[3]\n";
      }
    }
    close(AGAIN);
    close(TWO);
    $Ret = system "diff again2 again1>/dev/null";  # -q option not avail on Suns
    if (0 == $Ret) { #files were the same
      open(TWO,"again2");
      while ($line = <TWO>) {
        @part = split(" ",$line);
        print "  Body maps [$part[0], $part[1]) to ";
        if ($Coption) {
          print "$part[2]\n";
        }
        if ($Loption) {
          $intervalave = $part[3] + $part[2]*($part[1] + $part[2])/2.0;
          print "$intervalave (average)\n";
        }
      }
      close(TWO);
      die "  so loop calculation will never terminate";
    }
    #sort the theory.ccf file in place  -- surely there must be a better way?!
    open(CCF,$theory);
    open (T1,">t1");
    $tmp = <CCF>;
    print T1 $tmp;
    close(T1);
    open (T2,">t2");
    while ($tmp = <CCF>) {
      print T2 $tmp;
    }
    close(T2);
    close(CCF);
    `rm -f $theory`;
    `cp t1 $theory`;
    `sort -g t2 >> $theory`;
  }
}
else { 
  die "Construct type ", $type, " not implemented";
}

####################################################
#  create "theory" .ccf file of results 
####################################################

unless ($type eq "loop") {  #loop file already written above
# write the "theory" equivalent file
  open(TCCF, ">".$theory) || die "Could not open `theory' file";
  print TCCF "theory\n";
  if ($type eq "series") {
    if ($Coption) {
      for($k=0; $k<$range1cnt; $k++) {
        unless (defined($TorF[$k])) {
          $TorF[$k] = "SERIES";
        }
        printf TCCF "%s\n",dec15::dump15s($subDleft1[$k]).dec15::dump15s($subDright1[$k])."C ".dec15::dump15s($thval[$k]).dec15::dump15s($thtime[$k]).$TorF[$k];
        #debug
        #print "$subDleft1[$k] $subDright1[$k] $thval[$k] $thtime[$k] $TorF[$k] \n";
      }
    }
    if ($Loption) {
#      #must sort these subdomains
#      @range3 = sort {(@t1=split(" ",$a))[0] <=> (@t2=split(" ",$b))[0]} @range3;  
      for($k=0; $k<$range3cnt; $k++) {
        print TCCF "$range3[$k] \n";
      }
    }
  }
  elsif ($type eq "conditional") {
    @t1 = @t2 = ();
    #must sort conditional subdomains
    @range3 = sort {(@t1=split(" ",$a))[0] <=> (@t2=split(" ",$b))[0]} @range3;  
    for ($k=0; $k < $range3cnt; $k++) {
      print TCCF "$range3[$k] \n";
    }
  }
  close(TCCF);
}
#!/usr/bin/perl -w
# CmeasF script (measure component outputs and run times)
#  Use .pscf file to process all components and create .ccft files
#  that contain their specs
#
use samplingf;
use dec15;
$eps = &dec15::geteps();

#get options
$Coption = 0;
$Loption = 1;  #assume linear
$Voption = 0;
OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  if ($ARGV[$i] eq "-V") {
    $Voption = 1;
  }
  if ($ARGV[$i] eq "-C") {
    $Coption = 1; $Loption = 0;
  }
  if ($ARGV[$i] eq "-L") {
    $Coption = 0; $Loption = 1;
  }
}

#process system configuration file
$sys_desc = "system.pscf" ;
open(SYSTEM, $sys_desc ) || die "could not open the file", $sys_desc ;
$comp_name = <SYSTEM>; #discard polish line

#store component .ccf names
@components = ();
$i = 0;
while ($comp_name = <SYSTEM>) { #read to end
  chop($comp_name);
  $components[$i] = $comp_name;
  $i++
}
if ($Coption) { #must also do ident file
  $components[$i++] = "ident.ccf";
}
close SYSTEM ;

#debug
#foreach $comp (@components) {print $comp."\n"; }

########################################subroutine#######################
sub fitline {
# best-fit line in the sense of least squares of differences
# parameters:  $_[0] - X-vector; $_[1] - Y-vector; $_[2] - X-ave; $_[3] - Y-ave; $_[4] - Count
my($xvec, $yvec, $xave, $yave, $N, $Slope, $Inter, $dev, $cross, $var, $i);
$xvec = $_[0];
$yvec = $_[1];
$xave = $_[2];
$yave = $_[3];
$N = $_[4];
$cross = 0;
$var = 0;
for ($i=0; $i<$N; $i++) {
  $cross += @$xvec[$i] * @$yvec[$i];
  $var += @$xvec[$i] * @$xvec[$i];
}
if ($N == 1) {
  $Slope = 0;
}
else {
  $Slope = ($cross/$N - $yave*$xave)/($var/$N - $xave*$xave);
}
if (abs($cross/$N - $yave*$xave) <= $eps) {
  #debug
  #$a = $cross/$N;
  #$b = $yave*$xave;
  #$c = $var/$N;
  #$d = $xave*$xave;
  #print "$Slope $a - $b / $c - $d\n";
  #end debug
  $Slope = 0;
}
$Inter = $yave - $Slope*$xave;
$dev = 0;
for ($i=0; $i<$N; $i++) {
  # It should be possible to do this in the first pass as in std dev -- fix TBD
  $dev += ($Slope*@$xvec[$i] + $Inter -@$yvec[$i])**2;
}
$dev = sqrt($dev/$N)/($yave+$eps); #rms deviation from the line
return $Slope, $Inter, $dev;
#  return (slope,intercept,deviation) of the fitted line
}
#########################################################################

sub printf15 { # print line from a ccf file (9 values)
  #first parameter is a file name to write to
  #needed to avoid loss of precision when a float is near an integer in Perl
  my($file, $t, $N);
  $file = shift; #file handle or 0 if none
  for ((1..2)) {
    $t = shift;
    printf $file "%s",&dec15::dump15s($t);
  }
  $t = shift;
  if ($t eq "L") {
    $N = 6;
  }
  else {
    $N = 4;
  }
  printf $file "%s ",$t;
  for ((1..$N)) {
    $t = shift;
    printf $file "%s",&dec15::dump15s($t);
  }
  printf $file "\n";
}
#########################################################################

# get ready to print results
#for each component process its file and execute test
CCFL: foreach $comp (@components) {
  open(COMP, $comp) || die "could not open the file ", $comp;
  # get the name of the executable
  chop($comp_name = <COMP>) ;
  if ($comp_name eq "theory") { #not a real component, skip
    next CCFL;
  }
  #real component, measure it
  #see if the executable is there
  die "component ", $comp_name, " can't be executed." unless (-x $comp_name);
  @wholename = split(/\./,$comp);
  #debug
  #print "@wholename\n";
  $comptheory = $wholename[0].".ccft";
  open(COMPTH, ">".$comptheory)  || die "could not create theory file ", $comptheory;
  print COMPTH "theory\n";
  #read subdomain information
  while($linearr = <COMP>) {
    #read line from .ccf file
    @line = split(' ',$linearr);
    $sub_start = $line[0] ;
    $sub_end = $line[1] ;
    $test_cnt = $line[2] ;
    &samplingf::init($sub_start, $sub_end, $test_cnt);
    $cnt = 0 ;
    $input = &samplingf::next ;
    #for each subdomain get equi-spaced input and call components with this
    @x_vals = ();  #inputs
    $x_bar = 0;  #average
    @y_vals = ();  #functional outputs
    $y_bar = 0;
    $y_sqrs = 0;
    @t_vals = ();  #run times
    $t_bar = 0;
    $t_sqrs = 0;
    while($input ne ".") {
      $x_vals[$cnt] = $input;
      $x_bar += $input;
      $sed = "sed 's/^/out:  /'";  # command to reproduce stdin to stdout with a leading "out:  "
      $cmd = "(echo ".$input."|".$comp_name."|".$sed.") 2>&1|" ;
      open(PI,$cmd);
      for($k=1; $k<=2; $k++) {
        @outstrm = split(' ',<PI>);
        #The output stream is: 1) RT of component; 2) "out:  ".output of component
        # just to be safe, check for the "out" and don't use the order
        #debug
        #print "$outstrm[0] \n";
        #print "$outstrm[1] \n";
        if ($outstrm[0] =~ /out:/) { #functional output, record
          $y = $outstrm[1];
          $y_vals[$cnt] = $y;
          $y_bar += $y;
          $y_sqrs += $y*$y;
        }
        else { #run time; record 
          $t = $outstrm[0];
          $t_vals[$cnt] = $t;
          $t_bar += $t;
          $t_sqrs += $t*$t;
        }
      }
      close(PI);
      $input = &samplingf::next ;
      $cnt++ ;
    } #end loop over inputs
    $x_bar /= $cnt;
    $y_bar /= $cnt;
    $t_bar /= $cnt;
    #debug
    #print "$cnt $y_bar\n";
    if ($Loption || $cnt == 1) { #don't compute stdev
      $y_sdev = 0;
      $t_sdev = 0;
    }
    else {
      $y_sdev = sqrt(abs(($y_sqrs - $cnt*$y_bar*$y_bar)/($cnt -1)))/($y_bar+$eps);
      $t_sdev = sqrt(abs(($t_sqrs - $cnt*$t_bar*$t_bar)/($cnt -1)))/($t_bar+$eps);
    }
#debug
#print "N: $cnt, xave: $x_bar, yave: $t_bar, stdev: $y_sdev\n";
    if ($Loption) {
      ($R_slope, $R_inter, $R_dev) = fitline(\@x_vals, \@t_vals, $x_bar, $t_bar, $cnt);
      #debug
      #print "line:  $R_slope x + $R_inter\n";
      ($V_slope, $V_inter, $V_dev) = fitline(\@x_vals, \@y_vals, $x_bar, $y_bar, $cnt);
      #debug
      #print "line:  $V_slope x + $V_inter\n";
      printf15(COMPTH, $sub_start, $sub_end,"L",$V_slope,$V_inter,$R_slope,$R_inter,$V_dev,$R_dev)
;
    }
    if ($Coption) {
      printf15(COMPTH, $sub_start, $sub_end, "C", $y_bar, $t_bar, $y_sdev, $t_sdev);
    }
    #debug
    #print "sigma: $y_sdev, rsigma: $t_sdev ";
    #if ($Loption) {
      #print "rms: $V_dev, Rrms: $R_dev";
    #}
    #print "\n";
    #end debug
  } #end loop over subdomains, one component
  close COMP ;
} #end loop over components
package dec15;
$Ndig = 16;  #change this for the precision
$eps = 10**(-$Ndig);
sub geteps { #return the current granularity
  return $eps;
}
sub dump15s { #return a $Ndig-digit value string with trailing blank
  my($t);
  $t = shift;
  if ($t < 1.0) {
    $t = int((($t/$eps)+.5))*$eps;
  }
  $t = sprintf "%.*e ", $Ndig-1,$t; 
  return $t;
}
sub epsplace { #return a value that can be used with arg as eps
  my($t,$i,$e,$val);
  $t = shift; 
  $t = dump15s($t);
  $i = index($t,"e");
  $e = substr($t,$i+1); #exponent
  $e = $e + 1 -$Ndig;
  $val = "1.0e".$e;
  return $val;
}
return 1;
#! /usr/bin/perl -w
#
# Profile <.ccf file1> [<.ccf file2>]
#  
#   Plots a histogram profile from the trace for component file1
#    and file2 for comparison if present

sub bar { #move and size print bars
  #parameters are left,right,top of bar
  my($L, $R, $top);
  $L = $_[0];
  $R = $_[1];
  $top = $_[2];
    #debug
  #print "$L $R $top\n";
  $E = $B + $barwid;
  print PLT "$B 0\n";
  print PLT "$B $top\n";
  print PLT "$E $top\n";
  print PLT "$E 0\n";
  print PLT "\n";  #no connection between bars
  $lab = sprintf '"[%.1f, %.1f)"',$L,$R;
  $pos = $B + $shift/2 -$del;
  print CP "set label $lab at $pos,-.003 right rotate\n";
  $B += $shift;  #setup for next bar
  return 
}

$ccfile = $ARGV[0];
$ccfile2 = 0;  #use as switch
if (defined($ARGV[1])) {
  $ccfile2 = $ARGV[1];
}

sub process {
LINE: while ($line = <TRA>) {
  chop($line);
  @spread = split(" ", $line);
  #debug
  #print "@spread \n";
  FIELD: for ($i=0;;$i++) {
    if (not defined($spread[$i])) {
      next LINE;
    }
    #debug
    #print "$spread[$i]\n";
    if ($spread[$i] eq $ccfile) { #found, jump out
      last FIELD;
    }
  }
  #data down to blank line or EOF
  $line = <TRA>; #skip first blank line
  $k = 0;
  $tot_hits = 0;
  DAT: while ($line = <TRA>) {
    chop($line);
    if ($line eq "") { #blank line
      last DAT;
    }
    #format is:  [n, m)[tab]c
    @spread = split(/,|\ |\[|\)|	/, $line);
    #debug
    #print "@spread \n";
    $left[$k] = $spread[1]; 
    $right[$k] = $spread[3]; 
    $hits[$k] = $spread[5];
    $tot_hits += $hits[$k];
    $k++;
  }
  $num_sub = $k;
  #debug
  #print "$tot_hits\n";
  for ($i=0; $i < $num_sub; $i++) {
    $hits[$i] /= $tot_hits;
    #debug
    #print "$hits[$i]\n";
    bar($left[$i], $right[$i], $hits[$i]);
  }
  return;
}
die "couldn't find profile for ",$ccfile;
}

  $barwid = .03;  #horizontal scale is nominally [0,1]
  $del = $barwid/8; #gap between bars
  $shift = $barwid + $del;
  if ($ccfile2) {
    $shift += $del/2; # leave space for other row of bars
  }
  open (PLT, ">profile.plt") or die "Can't open plotting file";
  $B = 0;
  open (TRA, "trace_report") or die "Can't locate trace data file";
  open (CP, ">complot") or die "can't create plot control file";
  process();
  close (CP);
  close(TRA);
  close(PLT);
  if ($ccfile2) {
    open (CP,">/dev/null");
    open (PLT, ">profile2.plt") or die "Can't open plotting file";
    $B = $del/2;
    open (TRA, "trace_report.th") or die "Can't locate 2nd trace data file";
    $ccfile = $ccfile2;
    process();
    close(CP);
    close(TRA);
    close(PLT);
  }
  open(PF,">>complot");
  print PF "set terminal postscript color\n";
  print PF qq(set output "plot.ps"\n);
  print PF qq(set border 2\n);
  print PF qq(set offsets .01\n);
  print PF qq(set bmargin 8\n);
  print PF qq(set tics out\n);
  print PF qq(set ylabel "relative frequency"\n);
  print PF qq(set ytics nomirror\n);
  print PF qq(set noxtics\n);
  if ($ccfile2) { #needs label
    print PF qq(plot "profile.plt" title "measured" with lines lt -1);
  }
  else {
    print PF qq(plot "profile.plt" notitle with lines lt -1);
  }
  if ($ccfile2) {
  print PF qq(, "profile2.plt" title "predicted" with lines lt 1);
  }
  close(PF);

  system("gnuplot complot");
  system("ghostview plot.ps");
  exit;
#! /usr/bin/perl -w
# runexpF [<options>] <how_many> [<results>]
#   Assume directories starting with the current and then adding
#   "2" successively up to <how_many> exist, run in each SYNF with <options> 
#   (default, none), leaving the answers in file <results> in the given 
#   directory (default: "results").
#  
$opt = "";
OPT: for ($op=0; ; $op++) { #scan for options
  if (defined($ARGV[$op]) && $ARGV[$op] =~ "-") {
    $opt = $opt." ".$ARGV[$op];
  }
  else { last OPT; }
}
# $op is the subscript following the options (if any)
unless (defined($ARGV[0])) {die "A count must be given"; }
$N = $ARGV[$op++]; 
  #should check for reasonable number
$resfile = "results";
if (defined($ARGV[$op])) { #results file
  $resfile = $ARGV[$op];
}
chop($dir = `pwd`);
for ($i=1; $i <= $N; $i++) {
  system ("rm -f $resfile");
  system ("SYNF $opt > $resfile");
  $dir = $dir."2";
  chdir $dir;
}
package samplingf; 

#version that returns midpoints of intervals

# init - initialize sampling interval
# params:
# - interval begin - start of the interval
# - interval end - end of the interval
# - count - count number


sub init {
  # get params

  $interval_begin = shift ;
  $interval_end = shift ; 
  $sample_count = shift ; 

  # verify params

  die "Init() - interval_begin not defined.\n" if not defined $interval_begin ; 
  die "Init() - interval_end not defined.\n" if not defined $interval_end ; 
  die "Init() - count not defined.\n" if not defined $sample_count ;

  die "Init() - count must be positive value.\n" if ($sample_count <= 0) ; 
  die "Init() - invalid interval boundary values.\n" if ($interval_begin >= $interval_end) ; 
  if ($sample_count == 1) { #midpoint
    $ret_next_value = ($interval_begin + $interval_end)/2;
  }
  elsif ($sample_count == 2) { #arcane!
    $interval_spacing = ($interval_end - $interval_begin)/4;
    $ret_next_value = $interval_begin + $interval_spacing;
    $interval_spacing *= 2;
  }
  else { # start at interval left
    $interval_spacing = ($interval_end - $interval_begin - .000000001)/($sample_count);
    $ret_next_value = $interval_begin + $interval_spacing/2;
  }
  $count = $sample_count;
  return;
}

sub next {
  
  if ($count <=0) { #no more
    return ".";
  }
  $save_this_ret = $ret_next_value;
  $ret_next_value += $interval_spacing;
  $count--;
  return $save_this_ret;
}
return 1;
#!/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
$Coption = 0;  #assume linear
$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 "-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 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) {
    @wholename = split(/\./,$c);
    $theoryProg[$num_comps] = $wholename[0].".ccft";
  }
  $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] eq "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";
}

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 program in @prog
    $ExProg = $prog[$op-1];
    if ($Xoption) {
      $ExProg = "XqtF ".$theoryProg[$op-1];
    }
    else {
      if ($ExProg eq "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`;

# 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" ;
#! /usr/bin/perl -w
# script to divide the subdomains of a complete run in half.
# Driven by system.pscf file.  Each component .ccf file is adjusted
#  but in a new directory that is a copy of the current one D with 
#  2 appended to D.

use dec15;

#copy current directory D into D2
chop($dir = `pwd`);
$cmd = "rm -r -f ".$dir."2";
system($cmd);
$cmd = "mkdir ".$dir."2";
system($cmd);
$cmd = "cp ".$dir."/* ".$dir."2/";
system($cmd);
$dir = $dir."2";  #name now the new directory

open(PSCF, $dir."/system.pscf") || die "can't open system.pscf";
$line = <PSCF>;  #discard Polish line
if (-x "ident.bin") {
  $ccffile = "ident.ccf\n";  
}
else {
  $ccffile = <PSCF>;
}
while ($ccffile) {  #process each file name in the file
  chop($ccffile);
  open(CCF, $ccffile) || die "can't open .ccf file ", $ccffile;
  open(NCCF, ">".$dir."/".$ccffile) || die "failed to open new .ccf filep";
  $line = <CCF>; 
  print NCCF $line;  #copy the name
  while ($line = <CCF>) {  #read each subdomain line in the file
    @subs = split(" ",$line);
    $N = $subs[2];
      $mid = ($subs[0] + $subs[1])/2;
      #print NCCF $subs[0]." ".$mid." ".$N."\n";
      printf NCCF "%s%d\n", &dec15::dump15s($subs[0]).&dec15::dump15s($mid), $N;
      #print NCCF $mid." ".$subs[1]." ".$N."\n";
      printf NCCF "%s%d\n", &dec15::dump15s($mid).&dec15::dump15s($subs[1]), $N;
  }
  close(CCF);
  close(NCCF);
  $ccffile = <PSCF>;  #get next file until EOF
}
close(PSCF);
#! /usr/bin/perl -w
# script to divide the subdomains of a complete run in half repeatedly
# ten times, creating a succession of directories named
# the current one D with a 2 appended for each split:  D2, D22, etc. 
# Uses "split1" from current directory to make each copy.

for ($i=1; $i<=10; $i++) {
  chop($dir = `pwd`);  #current directory
  system("./split1f");
  $dir = $dir."2";  #name just made by split1
  chdir $dir;
}
#! /usr/bin/perl -w
# summarF <how_many> <results>
#   go through direcories starting with the current and then adding
#   "2" successively up to how_many (default 1), analyze and
#   print the results of the run from several sources
#  
$N = 0;
if (defined($ARGV[0])) {
  $N = $ARGV[0]; 
}
if ($N > 12 || $N <= 0) {die "bad number";}
if (defined($ARGV[1])) {
  $res = $ARGV[1];
}
else {
  $res = "results";
}
chop($dir = `pwd`);
for ($i=1; $i <= $N; $i++) {
  system ("avesubF $res");
  system ("scanres $res");
  system ("rm -f results0");
  system ("XcompF > results0");
  system ("scanres results0");
if (0) { #omit component approx code
  open(SP, "system.pscf") || die "can't open system.pscf file";
  $k = <SP>;  #discard Polish line
  $avev = 0;
  $aver = 0;
  $k = 0;
  while ($f = <SP>) {
    chop($f);
    system ("rm -f results1");
    system ("XcuteF $f > results1");
    $foo = `scanres results1`;
    @bar = split(" ",$foo);
#print "$f: $bar[2]\n";
    $avev += $bar[2];
    $aver += $bar[6];
    $k++
  }
  close(SP);
  $avev /= $k; 
  $aver /= $k; 
  printf "fun: %3.2f  run: %3.2f\n",$avev,$aver;
} #end omitted code
  $dir = $dir."2";
  chdir $dir;
}
#!/usr/bin/perl -w

#script SYNF 

#For arbitrary systems described by a Polish structure string,
# arrange to calculate system values, running the right scripts
# in the right subdirectories to do so.  
#It is assumed that all scripts are presently in the current
# directory.

#version that does all component measurements at the start

#Switch processing
$Noption = 1000;  #default count for loop execution
$Voption = 0;  #default is silent
$Coption = 0;  #default is L
$Loption = 1;
$Toption = 0; #no trace
$Poption = 0; #create the "system.scf" file
# -X option may be passed to SmeasF so that it uses the "theory" files
$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 "-C") {
    $Coption = 1; $Loption = 0;
  }
  if ($ARGV[$i] eq "-L") {
    $Coption = 0; $Loption = 1;
  }
  if ($ARGV[$i] eq "-T") {
    $Toption = 1;
  }
  if ($ARGV[$i] eq "-P") {
    $Poption = 1;
  }
  if ($ARGV[$i] eq "-N") {
    $Noption = $ARGV[$i+1];  #This should be better checked & handled
  }
}
#debug
#print "$Voption $Noption \n";
#print "$allOptions \n";


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

#debug
#warnmess "foo ", "and baz";

#Get the Polish string

open(SSCF, "system.pscf") || die "no Polish control file";
chop($Polish = <SSCF>);
#debug
#print "|$Polish|\n";
@PE = split(" ", $Polish);

#Find the largest component number used

$num_comps = 0;
foreach $num (@PE) {
  unless ($num =~ /\D/) {  #if it's a number
    if ($num_comps < $num) {$num_comps = $num ;}
  }
}
#debug
#print "$num_comps \n";

if ($Loption) {
  #unless (-e "ident.ccfl") { #create "ident" component -- really a "theory" file
  # create it every time for now...
  open (I, ">ident.ccfl");
  print I "theory\n";
  print I "0 100000 L 1 0 0 0\n";  #slope 1, intercept 0, 0 run time
  close(I);
  #}
}
if ($Coption) {
  unless (-e "ident.ccf" && -e "ident.bin") {die "`ident' files missing";}
}

$Wrong = 0;  #if TRUE, found something wrong with .ccf file
$ccftsExist = 1;  #assume that there are good ccft files
for ($i=0; $i<$num_comps; $i++) {
  chop($c = <SSCF>);
#debug
#print "component .ccf $i: ", $c, "\n" ;
  unless (defined($c)) {
    die "Not enough .ccf files to match Polish in the .pscf file";
  }
  
  #Rough check of the .ccf file contents
  
  open (CCF, "<".$c) or die "can't read configuration file ", $c ;
  $component[$i] = $c." \n" ;
  chop($prog[$i] = <CCF>); #read the executable name for messages later
  @wholename = split(/\./,$c);
  $ccft = $wholename[0].".ccft";
  #can component be executed?
  unless ($prog[$i] eq "theory" ||-x $prog[$i]) {
    warn "Component file ",$prog[$i]," in ",$c, " is not executable";
    #should do better than this -- actually try to execute it...
    $Wrong = 1;
  }
  $FirstInterval = 1;
  #Comments indicate the check being made
  #  Wrong==2 means a problem that precludes some further checking
  if ($ccftsExist && $prog[$i] ne "theory") {
    @statvec = stat($c); #for ccf file
    $ccfileTime = $statvec[9];
    @statvec = stat($prog[$i]); #for executable file
    $binfileTime = $statvec[9];
    if (-e $ccft) {
      open (CCFT, $ccft) or die "something wrong with file ",$ccft;
      $tmp = <CCFT>; #discard "theory"
      $tmp = <CCFT>;
      @tmp = split(" ",$tmp);
      $ccftsExist = 0 unless (($tmp[2] eq "L" && $Loption) || ($tmp[2] eq "C" && $Coption)); 
      @statvec = stat($ccft); #for theory ccf file
      $ccftsExist = 0 unless ($statvec[9] > $ccfileTime && $statvec[9] > $binfileTime);
      close (CCFT);
    }
  }
  while ($line = <CCF>) {
    @bits = split(" ",$line);
    unless (defined($bits[0])) { 
      warn $c," contains a blank line";
      $Wrong = 2;  #but keep going...
    }
    elsif ($bits[0] > $bits[1]) {
      warn $c,", Line ",qq{$line}," has empty interval [",$bits[0],",",$bits[1],"]";
      $Wrong = 2;  #but keep going...
    } 
    elsif ($prog[$i] ne "theory" && ((not defined($bits[2])) || $bits[2] == 0)) {
      warn "Count missing in ",$c;
      $Wrong = 1;
    }
    if ($Wrong < 2) { #OK to make check for interval coverage
      if ($FirstInterval) { #left-most
        $FirstInterval = 0;
        $Right = $bits[0];
      }
      unless ($Right == $bits[0]) {
        warn "Intervals overlap or are not contiguous in ",$c;
        $Wrong = 2;
      }
      else {
        $Right = $bits[1];
      }
    }
  } #end while going through one file
  close (CCF);
} #end for going through all files

if (defined(<SSCF>)) {
  warn "Too many .ccf files to correspond to Polish in .pscf file";
}
close (SSCF);
if ($Wrong) {die "Please fix .ccf file(s) and try again";}
if ($ccftsExist) { #don't measure again
 warnmess "Using existing component approximations";
}
else {
  if (system "./CmeasF ".$allOptions) {die "`CmeasF' script failed";}
  warnmess "Component approximations measured";
}

#ready to start

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

warnmess "Beginning the system calculation of Polish $Polish";
if ($Coption) {
  warnmess "Using step-function approximation";
}
if ($Loption) {
  warnmess "Using piecewise-linear approximation";
}
foreach $op (@PE) { # process the Polish
  if ($op =~ /\D/) { #operator
    $thfpre = "theory".++$theory_ccf;
    $thf = $thfpre.".ccf\n";

    #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)
    `rm -r -f $subdir`; #destroy directory so it can be used repeatedly
    mkdir $subdir;
    `cp * $subdir`;
    chdir $subdir; #shift to new directory
#debug -- where are we?
#print `pwd`;
    #build a proper .sscf file
    open (SSCF, ">system.sscf") || die "can't create .sscf file for calculation";
    @thfpre = split(/\./,$thf);  #name without the ".ccf" in [0]
#end common setup stuff
    if ($op eq "S") { # series of 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a series (S) combination";
      }
      chop($C2 = pop @ccfStack);
      chop($C1 = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      #later, just the right files
      #$fileList = $fileList . $C1." ".$C2." ".$p1." ".$p2;
      warnmess "Series: ",$p1,";",$p2," -> ",$thfpre[0];
      print SSCF "series\n";
      print SSCF "$C1\n";
      print SSCF "$C2\n";
    }
    elsif ($op eq "C") { #conditional, 3 components
#debug
#print "$#ccfStack  @ccfStack \n";
      if ($#ccfStack < 2) {
        die "Not enough operands for a conditional (C) combination";
      }
      chop($Cfalse = pop @ccfStack);
      chop($Ctrue = pop @ccfStack);
      chop($Ctest = pop @ccfStack);
      $p3 = pop @ProgStack;
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      #$fileList = $fileList . $Ctrue." ".$Cfalse." ".$Ctest." ".$p1." ".$p2." ".$p3;
      warnmess "Conditional:  IF ",$p1," THEN ",$p2," ELSE ",$p3," FI -> ",$thfpre[0];
      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";
      }
      chop($Cbody = pop @ccfStack);
      chop($Ctest = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
  
      #$fileList = $fileList . $Cbody." ".$Ctest." ".$p1." ".$p2." ident.ccfl ident.bin";
      warnmess "Loop:  WHILE ",$p1," DO ",$p2," OD -> ",$thfpre[0];
      print SSCF "loop\n";
      print SSCF "$Ctest\n";
      print SSCF "$Cbody\n";
    }
    else {
      die "Illegal operand `$op' in Polish system description";
    }
#common cleanup operations
    close SSCF;
#debug
#print `cat system.sscf`;
    system "rm -f ../".$thfpre[0];
    system "cp system.sscf ../".$thfpre[0];  #save the system structure as a series of files

    if (system "./CalcF ".$allOptions) {die "`CalcF' script failed";}
    $cmd = "mv -f theory.ccf ../".$thf;
    `$cmd`;
    chdir ".."; #back to parent directory
    push @ccfStack, $thf;
    push @ProgStack, $thfpre[0];
  } #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) {
  die "Too many operands in the Polish system description";
}
#What is now left on the stack is the "theory" file for the complete system

chop($thf = pop @ccfStack);
#`mv -f $thf theory.ccf`;  #rename as the result of this run
#warnmess "Result in `theory.ccf' is ",$thf," from above";

if ($Poption) { #use existing file
  unless (-e "system.scf") {
    die "-P option requires `system.scf' file";
  }
  warnmess "Using existing measurement/profile description";
}
else {
#Measure the complete system # using the subdomains of the theory
  open(SCF, ">system.scf") || die "can't open `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 = 13;
    print SCF $lineS[0]." ".$lineS[1]." ".$HowMany."\n";
  }
  close(TH);
  close(SCF);
warnmess "File system.scf written to correspond to calculated subdomains";
}

if ($Toption) { #tracing, so execute the "theory" version
  if (system "./SmeasF -X ".$allOptions) {die "`SmeasF' script failed";}
  #move its files that would otherwise be overwritten
  system "rm -f trace_report.th trace_path.th SmeasF.dat.th";
  system "mv trace_report trace_report.th";
  system "mv trace_path trace_path.th";
  system "mv SmeasF.dat SmeasF.dat.th";
}
if (system "./SmeasF ".$allOptions) {die "`SmeasF' script failed";}

unless ($Poption) { #no comparision:  subdomains don't match
#Print (stdout) the theory/measurement comparison
# read the "theory" equivalent file created for this system above
open(TCCF, $thf) || die "can't open final `theory' file";
open(XS, "SmeasF.dat") || die "can't open measurements file";
warnmess "Comparison between system prediction and measurement:";
warnmess "subdomain	func pred | meas	runtime pred | meas";
$thline = <TCCF>; #discard the label line
while ($thline = <TCCF>) {
#debug
#print "$thline \n";
  @theorystuff = split(" ",$thline);
  #format is:
  #interval: [0,1]; "L"; function line: 3 x + 4; run-time line: 5 x + 6; TRUE/FALSE/SERIES: 7
  if ($Loption) {
    $theoryval = $theorystuff[3]*($theorystuff[0]+$theorystuff[1])/2 + $theorystuff[4];
    $theorytime = $theorystuff[5]*($theorystuff[0]+$theorystuff[1])/2 + $theorystuff[6];
    # take the average value of the linear function over the subdomain
  }
  elsif ($Coption) {
    $theoryval = $theorystuff[3];
    $theorytime = $theorystuff[4];
  }
  #must be one or the other

  $measline = <XS>;
    @line = split(" ",$measline);
    $expval = $line[0];
    $exptime = $line[1];
      #kludge by .000...1 for possible zero-value measured...
      $normval = $expval;
      if ($normval == 0) {$normval = .0000000001};
      $erratio1 = 100 * (abs($theoryval-$expval)/$normval);
      $normtime = $exptime;
      if ($normtime == 0) {$normtime = .0000000001};
      $erratio2 = 100 * (abs($theorytime-$exptime)/$normtime);

      printf "[%.3f,%.3f)	",$theorystuff[0],$theorystuff[1];
      printf "%3.2f %3.2f %3.2f%%	", $theoryval, $expval, $erratio1;
      printf "%3.2f %3.2f %3.2f%%",$theorytime, $exptime, $erratio2;
      print "\n";
}
close(TCCF);
}
#!perl 
use warnings;
use strict "refs";

# hash data persistance
use Data::Dumper;
$Data::Dumper::Terse = 1;

package tracef ;

################################################################################################################
# find_subdomain - determine subdomain that given input belongs to, if any.  
#
# Input Params:
# - x - start of the interval
# - ccf_filename - name of the component .CCF file
# - sub_arr - array of two points that contain ends of subinterval
#
#
# Return Value:
#              Return value is 1 if search worked, 0 otherwise.
#              Return value of sub_res contains proper subinterval if search succeeded.
#              Return value of sub_res is "undefined" if search failed.
#              Return value of sub_ord is "undefined" if search failed.

sub find_subdomain
{
 
  #assume search failed...

  $search_res = 0 ; 

  # get params
  my($x, $y, $ccf_filename, $sub_out, $sub_ord_out) = @_;

  print TEMP "        ", $x, "           ", $y, "           ";

#debug - print incoming and outgoing params...
# print "subdomain input: ", $x, "\n" ; 
# print "ccf_filename: ", $ccf_filename, "\n" ; 

  #check if inputs
  die "Fatal Error: find_subdomain() - input value to subdomain not defined.\n" if not defined $x ;
  die "Fatal Error: find_subdomain() - component file name not defined.\n" if not defined $ccf_filename ;
  die "Fatal Error: find_subdomain() - missing subdomain result array.\n" if not defined $sub_out ;
  die "Fatal Error: find_subdomain() - missing subdomain index output variable.\n" if not defined $sub_ord_out ;

  open(CCF,  $ccf_filename ) or die "could not open the file", $ccf_filename, "\n" ; 

  #assume there is no appropriate interval
  $sub_out->[0] = "undefined" ; 
  $sub_out->[1] = "undefined" ; 
  $$sub_ord_out = "undefined" ;

  #read subdomain information from component, search for subdomain that contains our input
  #search is linear, which is slow, should be binary search - in next version, perhaps - LATER

  #skip first line...
  $_ = <CCF> ; 

  $my_Cnt = 1 ; 

  while($_ = <CCF>)
  {
    #read line from .ccf file
    @line = split(' ',$_);

    $sub_start = $line[0] ;
    $sub_end = $line[1] ;

#debug
#print "sub_start: ", $sub_start, "\n" ; 
#print "sub_end: ", $sub_end, "\n" ; 
  
    #look if value fits between subdomain boundaries...
    if(($sub_start <= $x) && ($x < $sub_end))
    {

#debug
#print "got the interval, sub_start: ", $sub_start, " subdomain: ", $x, " sub_end: ", $sub_end, "\n" ; 

      $sub_out->[0] = $sub_start ;    #note subdomain boundaries
      $sub_out->[1] = $sub_end ;
      $search_res = 1 ;

      $$sub_ord_out = $my_Cnt ;               #note which subdomain in order had been matched.  
    }
    $my_Cnt++ ; 
  }
  close (CCF) ; 
  printf TEMP " [%.2f, ", $sub_out->[0];
  printf TEMP "%.2f)	", $sub_out->[1];
  print TEMP $ccf_filename. "\n";

  return $search_res ; 
}

##########################################################################################################
#
# Count subdomains
#
# Description: This function counts number of subdomains in each component, and initializes subdomain
#              counter for number of hits to 0 for each subdomain of each component. Subdomain counters
#              are returned as hash reference. (it's up to caller to provide this reference)
#
# Input: 
# 	 
# 	$sub_arr_cnt - this is output hash array. key for the array is the name of the .ccf file
#		       value of the hash element is maximum number of elements per subdomain
#	               Secondary key for the array gives number of hits for a particular subdomain
#		       
#                      Example: $sub_arr_cnt{"test1.ccf"} = 3,  $sub_arr_cnt{"test1.ccf"}{0} = 0 ; (initially)
#
#       $out_ccf_list - list of component names in order specified in "system.pscf" file.
#
# Output: Procedure returns all parameters as output arguments. It is up to caller to pass appropriate data structures when
#	  invoking this subroutine call. 
#

sub count_subdomains
{  #also does initialization
  my($sub_arr_cnt,$ccf_list) = @_;
  
  my(%sub_arr_cnt) = %$sub_arr_cnt ; 
  my(@ccf_list) = @$ccf_list ; 

  die "Fatal Error: count_subdomains() - missing subdomain count.\n" if not defined $sub_arr_cnt ;
  die "Fatal Error: count_subdomains() - missing list of subdomains.\n" if not defined $ccf_list ;

  open(CCF,  "system.pscf" ) or die "could not open configuration file", $ccf_list, "\n" ;

  #skip first line...
  $_ = <CCF> ;

  $iListCnt = 0 ;

  # make a list of ccf files...
  while($_ = <CCF>) 
  {
     chop $_ ;
     @$ccf_list->[$iListCnt] = $_ ; 
     $iListCnt++ ;  
  }

  close(CCF) ; 

  # count subdomains in each .ccf file
  foreach $ccf_el (@$ccf_list) 
  {
    #open each configuration file and count its subdomains 
    open(CCF_EL,  $ccf_el ) or die "could not open the file", $ccf_el, "\n" ;

    $sub_arr_cnt->{$ccf_el} = 0 ;

    # record number of subdomains per component
    while($_ = <CCF_EL>)
    {
      ($sub_arr_cnt->{$ccf_el})++ ;
    }

    $iCnt = 0 ;

    #initialize counters for all subdomains in this component to zero
    while($iCnt < $sub_arr_cnt->{$ccf_el})
    {
      $sub_arr_cnt->{$ccf_el.$iCnt} = 0 ;
      $iCnt++ ;
    }

    close(CCF_EL) ;
  }

#initialize
open (TEMP, ">>trace_path") or die "Can't open data file for writing";
print TEMP "---------------------------------------------------------------------------------\n";
print TEMP "    INPUT           OUTPUT          SUBDOMAIN               COMPONENT\n";
print TEMP "---------------------------------------------------------------------------------\n";
print TEMP "---------------------------------------------------------------------------------\n";

}

#################################################################################################################
#
# list_subdomains
#
# Description: list subdomains is responsible for creation of report on number of hits
# for each subdomain. It creates a report containing detailed trace information about
# number of hits for each subdomain of each component.
#
#
# Input:
#
#       $sub_arr_cnt - this hash array contain current state of the counters for all subdomains of each component. 
#                      value of each hash element in array reflects whether subdomain has been hit or not
#                      for that particular input run. There is exactly one hash array for each input that
#                      is run through the system - each hash is added to ones that were ran before. 
#                      Intermediate results of addition are stored in the file and reused in subsequent hash addition. 
#                      Hash file is overwritten in each run with new subdomain hit data. 
#                      Once input is exhausted, hash file contains cummulative sum of all subdomain hits for each subdomain
#                      of each component. 
#
#                      Keys for array are the same as described in count subdomains function, i.e. 
#                      Secondary key for the array gives number of hits for a particular subdomain
#
#                      Example: $sub_arr_cnt{"test1.ccf"} = 3,  $sub_arr_cnt{"test1.ccf"}{0} = 0 ; (initially)
#
#       $out_ccf_list - list of component names in order specified in "system.pscf" file.
#
#

sub list_subdomains
{
  #close out the path report file
  close(TEMP);

  # get params - this should include results file...
  my($sub_arr_cnt,$list_ccf) = @_;

  my(%sub_arr_cnt) = %$sub_arr_cnt;
  my(@list_ccf)= @$list_ccf;

  # temporary file for storing hashed subdomain hit info
  $tmp_hash = "tmp_hash" ; 

  # hash reference...
  my $href ;

  # restore previous subdomain counters (hash) from a file, if such exists...
  $href = get_hash ($tmp_hash) ;

  #add current counter values to restored ones...
  if(defined $href)
  {
    #got previous hash
    my %hash = %$href ;
    

################## DO HASH ADDITION

    foreach $ccf_el (@$list_ccf)
    {
      #open each configuration file and count its subdomains
      open(CCF_EL,  $ccf_el ) or die "could not open the file", $ccf_el, "\n" ;

      $iCnt = 0 ;

      while($iCnt < $sub_arr_cnt{$ccf_el})
      {
        $hash{$ccf_el.$iCnt} += $sub_arr_cnt{$ccf_el.$iCnt} ; 
        $iCnt++ ;
      }

      close(CCF_EL) ;
    }

#################### END HASH ADDITION

    #place new values in the file...
    dump_hash(\%hash, $tmp_hash) ; 
  }
  else  #dump hash first time to a file...
  {
    # dump contents of hash to a file
    dump_hash (\%sub_arr_cnt, $tmp_hash) ;
  }


####################  CREATE TRACE REPORT

  my $href2 ; 

  # restore last hash from temporary hash file
  $href2 = get_hash($tmp_hash) ; 

  # prepare to write report
  $report_file = "trace_report" ;
  open (REPORT, ">".$report_file) || die "could not open file: ".$report_file ;

  # for each component, report number of hits per subdomain
  foreach $ccf_el (@$list_ccf)
  {
   print REPORT "\n\nComponent described by ", $ccf_el, "\n\n" ;

    #open that component file...
    open(CCF,  $ccf_el ) or die "could not open the file", $ccf_el, "\n" ;

    #skip first line...
    $_ = <CCF> ;

    $iCnt = 0 ;

    # read subdomain info and print them out...
    while($_ = <CCF>)
    {
      #read line from .ccf file
      @line = split(' ',$_);

      $sub_start = $line[0] ;
      $sub_end = $line[1] ;

      # write out subdomains, and overall number of hits per subdomain...
      printf REPORT "[%.2f, %.2f)	%d\n", $sub_start, $sub_end, $href2->{$ccf_el.$iCnt};

      $iCnt++ ;
    }
    close (CCF) ;
  }
  close (REPORT) ;
}

####################### END TRACE REPORT CREATION


##################################################################################################
#
# dump_hash - dump hash to a file
#

sub dump_hash
{
  my($hash, $hash_file) = @_;
  my(%hash) = %$hash;

  open OUT, ">".$hash_file or die "Can't open file: $!".$hash_file;
  print OUT Data::Dumper->Dump( [\%hash], ['*fgh'] );
  close OUT;
}

###################################################################################################
#
# get_hash - restore a hash from a file, assuming that file exists, otherwise return undefined value
# subroutine returns hash reference
#

sub get_hash
{
  my($hash_file) = @_;

  my %hashref ;

  if (-e $hash_file)
  {
    open IN, $hash_file or die "Can't open file: $!".$hash_file;
    $old = $/ ; 
    $/ = undef ;
    %hashref = eval scalar <IN> ;
    die $@ if $@;
    close IN;
    $/ = $old ; 
  }
  else
  {
    return undef ;
  }

  # return a reference to a hash
  return \%hashref ;
}

return 1 ; 
#! /usr/bin/perl -w
# XcompF -r <left> <right> <count>
#   -- a program to compare and plot the measured and calculated functions
#         for a component-based system.
#
#  Assumes that the SYN script has been run in the current directory without
#   the -T option, so that SystemCode is an executable file, and "theory.ccf"
#   is the resulting calculated file.  These are the functions compared.
#
#  If any of the non-switch parameters are present, all must be.  Otherwise the default
#    is the interval defined by the calculated file and a count of 75.
#    The -r option causes the sampling to be random
#    and 5 times as frequent as the count described above.

use samplingf;

# Get the input range from the theory.ccf file
# and allow override from command line

open(ST,"system.scf") or die "must have a system.scf file";
chop($lastheory = <ST>);
close(ST);
open(TH,$lastheory) or die "A calculated ", $lastheory, " file must be present";
chop($k = <TH>);
if ($k ne "theory") {die "doesn't seem to be a theory file";}
$useRand = 0;
if (defined($ARGV[0]) && $ARGV[0] eq "-r") { #use random sampling
$useRand = 1;
}
if (defined($ARGV[$useRand])) { #some parameters
  unless (defined($ARGV[$useRand+2])) { die "Parameters: <left> <right> <count> must all be given";}
  $left = $ARGV[0+$useRand];
  $right = $ARGV[1+$useRand];
  $count = $ARGV[2+$useRand];
}
$k = 0;
$lin = 0;
$line = <TH>;  
@subd = split(" ",$line);
if ($subd[2] eq "L") { #linear approx
  $lin = 1;
}
open(B,">subd.plt"); #for marking boundaries
open(C,">pred.plt"); #calculation values
open(CR,">runpred.plt"); #calculated run times
while ($line) { #read and store boundaries, plot theory lines.
  @subd = split(" ",$line);
  $LB[$k] = $subd[0];
  $UB[$k] = $subd[1];
  if (!defined($ARGV[$useRand]) || ($subd[1] >= $left && $subd[0] <= $right)) {
    print B "$subd[0] 0\n";
    if ($lin) { 
      $slope[$k] = $subd[3];
      $intcpt[$k] = $subd[4];
      $v1 = $slope[$k]*$LB[$k] + $intcpt[$k];
      $v2 = $slope[$k]*$UB[$k] + $intcpt[$k];
      $runslope[$k] = $subd[5];
      $runintcpt[$k] = $subd[6];
      $v3 = $runslope[$k]*$LB[$k] + $runintcpt[$k];
      $v4 = $runslope[$k]*$UB[$k] + $runintcpt[$k];
      print C "$LB[$k] $v1\n";
      print C "$UB[$k] $v2\n";
      print CR "$LB[$k] $v3\n";
      print CR "$UB[$k] $v4\n";
    }
    else { #step function approx
      $val[$k] = $subd[3];
      $run[$k] = $subd[4];
      print C "$LB[$k] $val[$k]\n";
      print C "$UB[$k] $val[$k]\n";
      print CR "$LB[$k] $run[$k]\n";
      print CR "$UB[$k] $run[$k]\n";
    }
  }
  $line = <TH>;
  $k++;
}
$numSubd = $k;
close(C);
close(CR);
if (!defined($ARGV[$useRand]) || ($UB[$numSubd-1] <= $right)) {
print B "$UB[$numSubd-1] 0\n";
}
close(B);
unless (defined($ARGV[$useRand])) { #no parameters
  $left = $LB[0];
  $right = $UB[$numSubd-1];
  $count = 75;
  if ($useRand) {  #increase default count
    $count *= 5;
  }
}
$rs = "";
if ($useRand) {
  $rs = " (random)";
}
print "Comparing on [$left, $right] for $count $rs points\n";

unless (-x "SystemCode") {die "No code `SystemCode' to measure";}
open(M,">meas.plt");
open(MR,">runmeas.plt");
$K = $count;
$verr = 0;
$rerr = 0;
$sed = "sed 's/^/out:  /'";  # command to reproduce stdin to stdout with a leading "out:  "
if ($useRand) {
  $input = $left + rand($right-$left+1);
}
else {
  &samplingf::init($left,$right,$count);
  $input = &samplingf::next;
}
while ($input ne "." && $K-- > 0) {
  $cmd = "(echo ".$input."| ./SystemCode |".$sed.") 2>&1|" ;
  open(PM, $cmd);
  $rmeas = 0;
  while ($line = <PM>) {  #not eof, all output from this system on this input
    # results all come out together, but stdout is preceeded by "out:  "
    @outstrm = split(' ',$line);
    #debug
    #print "$line \n";
    if ($outstrm[0] =~ /out:/) {
      $meas = $outstrm[1];
    }
    else {
      if ($outstrm[0] =~ /LOOPING/) {
        die "System may be looping on input ", $input, "; stopped";
      }
      $rmeas += $outstrm[0];
    }
  }
  close(PM);
  print M "$input $meas \n";
  print MR "$input $rmeas \n";
  #compare with theory
  #find the subdomain it's in
  ITER: for ($k=0; $k < $numSubd; $k++) {
    if ($input >= $LB[$k] && $input <= $UB[$k]) {
      last ITER;
    }
  }  
  if ($k < $numSubd) {
    if ($lin) {
      $v = $slope[$k]*$input + $intcpt[$k];
      $r = $runslope[$k]*$input + $runintcpt[$k];
    }
    else { #step function approx
      $v = $val[$k];
      $r = $run[$k];
    }
    $verr += abs(($meas - $v)/$meas);
    $rerr += abs(($rmeas - $r)/$rmeas);
  }
  else {
    warn "tried to sample at ",$input,"-- out of range"; 
  }
  if ($useRand) {
    $input = $left + rand($right-$left+1);
  }
  else {
    $input = &samplingf::next;
  }
}
close(M); 
close(MR); 
$verr = 100*$verr/$count;
$rerr = 100*$rerr/$count;
printf "Mean relative errors:  %2.2f%% (functional)    %2.2f%% (runtime)\n", $verr, $rerr;

open(PF,">complot");
print PF "set terminal postscript color\n";
print PF qq(set output "plot.ps"\n);
print PF qq(plot "meas.plt", "runmeas.plt", "subd.plt" with points pt 1 pointsize 3, "pred.plt" with lines, "runpred.plt" with lines\n);
close(PF);

system("gnuplot complot");
#system("ghostview plot.ps");
#! /usr/bin/perl -w
# XcuteF  <.ccf file> "runs" and [plots] a component behavior.
#
#  The .ccf file may point to either a theory-created file or an executable.
#  If the latter, the theory file is assumed to be available with the proper
#  approximation option
#

use samplingf;

unless (defined($ARGV[0])) {
  die "A .ccf file must be given";
}
$ccf = $ARGV[0];
open(CCF, $ccf) || die "given file ",$ccf," not found";
chop($name = <CCF>);

$theoryonly = 1;  #assume parameter is a theory file
if ($name ne "theory") {  #executable; create theory equivalent; plot data
  unless (-x $name) {die "No code file to measure";}
  $theoryonly = 0;
  #find the extremes of the domain
  $line = <CCF>;
  @vals = split(" ",$line);
  $left = $vals[0];
  $k = 0;
  while ($line) {
    @vals = split(" ",$line);
    $line = <CCF>;
    $k++;
  }
  $right = $vals[1];
  $count = 120;
  #debug
  #print "[$left, $right)  $k $count\n";
  
  open(M,">meas.plt");
  open(MR,">runmeas.plt");
  $sed = "sed 's/^/out:  /'";  # command to reproduce stdin to stdout with a leading "out:  "
  &samplingf::init($left,$right,$count);
  while (($input = &samplingf::next) ne ".") {
    $cmd = "(echo ".$input." | ".$name." | ".$sed.") 2>&1|" ;
    open(PM, $cmd);
    $rmeas = 0;
    while ($line = <PM>) {  #not eof, all output from this system on this input
      # results all come out together, but stdout is preceeded by "out:  "
      @outstrm = split(' ',$line);
      #debug
      #print "$line \n";
      if ($outstrm[0] =~ /out:/) {
        $meas = $outstrm[1];
      }
      else {
        $rmeas += $outstrm[0];
      }
    }
    close(PM);
    print M "$input $meas \n";
    print MR "$input $rmeas \n";
  }
  close(M); 
  close(MR); 

  close(CCF);
  # assume that the corresponding xxx.ccft file exists and has been done
  # with the correct option
  @filenames = split(/\./,$ccf);
  $ccftFile = $filenames[0].".ccft";
  unless (-e $ccftFile) {
    die "a `theory' file (.ccft) must exist for the executable";
  }
  system "rm -f theory0.ccf";
  system "cp $ccftFile theory0.ccf";
}

# Theory file exists now in either case.
unless ($theoryonly) {  #must open new file
  open(CCF, "theory0.ccf");
  $name = <CCF>;  #discard "theory" name
}
$k = 0;
$line = <CCF>;  
@subd = split(" ",$line);
if ($subd[2] eq "L") { #linear approx
  $lin = 1;
  print "(piecewise-linear approximation)\n";
}
else {
  $lin = 0;
  print "(step-function approximation)\n";
}
open(B,">subd.plt"); #for marking boundaries
open(C,">pred.plt"); #calculation values
open(CR,">runpred.plt"); #calc runtimes
$WtdVerr = 0;
$WtdRerr = 0;
unless ($theoryonly) {
  print "interval   rms errors (func) (run)\n";
}
while ($line) { #read and store boundaries, plot theory.
  @subd = split(" ",$line);
  $LB[$k] = $subd[0];
  print B "$subd[0] 0\n";
  $UB[$k] = $subd[1];
  if ($lin) { 
    $slope = $subd[3];
    $intcpt = $subd[4];
    $rslope = $subd[5];
    $rintcpt = $subd[6];
    $v1 = $slope*$LB[$k] + $intcpt;
    $v2 = $slope*$UB[$k] + $intcpt;
    $r1 = $rslope*$LB[$k] + $rintcpt;
    $r2 = $rslope*$UB[$k] + $rintcpt;
    print C "$LB[$k] $v1\n";
    print C "$UB[$k] $v2\n";
    print CR "$LB[$k] $r1\n";
    print CR "$UB[$k] $r2\n";
    unless ($theoryonly) {
      $verr = 100*$subd[7];
      $rerr = 100*$subd[8];
    }
  }
  else { #step function approx
    $val = $subd[3];
    $run = $subd[4];
    print C "$LB[$k] $val\n";
    print C "$UB[$k] $val\n";
    print CR "$LB[$k] $run\n";
    print CR "$UB[$k] $run\n";
    unless ($theoryonly) {
      $verr = 100*$subd[5];
      $rerr = 100*$subd[6];
    }
  }
  unless ($theoryonly) {
    $WtdVerr += $verr*($UB[$k] - $LB[$k]);
    $WtdRerr += $rerr*($UB[$k] - $LB[$k]); 
    printf "[%.1f, %.1f):	%3.2f%%  %3.2f%%\n",$LB[$k], $UB[$k], $verr, $rerr;
  }
  $line = <CCF>;
  $k++;
}
unless ($theoryonly) {
  $WtdVerr /= $UB[$k-1] - $LB[0];
  $WtdRerr /= $UB[$k-1] - $LB[0];
  printf "Weighted errors: %3.1f%%   %3.1f%%\n", $WtdVerr, $WtdRerr;
}
close(C);
close(CR);
print B "$UB[$k-1] 0\n";
close(B);


open(PF,">complot");
print PF "set terminal postscript\n";
print PF qq(set output "plot.ps"\n);
if ($theoryonly) {
  print PF "plot ";
}
else {
  print PF qq(plot "meas.plt", "runmeas.plt", );
}
print PF qq("subd.plt", "pred.plt" with lines, "runpred.plt" with lines\n);
close(PF);

system("gnuplot complot");
#system("ghostview plot.ps");
#! /usr/bin/perl -w
# Xqt <.ccf file> runs a "theory" file by lookup
#
unless (defined($ARGV[0])) {
  die "A .ccf file must be given";
}
$ccf = $ARGV[0];
open(CCF, $ccf) || die "given file ",$ccf," not found";
chop($name = <CCF>);
if ($name ne "theory") { 
  die "parameter file must be a `theory' file";
}
$X = <STDIN>;  #read input
  while ($line = <CCF>) {
    @vals = split(" ",$line);
    if ($X >= $vals[0] && $X < $vals[1]) { #in this subdomain
      if ($vals[2] eq "C") {
      $Y = $vals[3];
      $T = $vals[4];
      }
      else {
        $Y = $X*$vals[3] + $vals[4];
        $T = $X*$vals[5] + $vals[6];
      }
      print "$Y\n"; #functional value
      print STDERR "$T\n"; #run time
      exit(1); #normal exit
    }
  }
die "input out of range";
