#!/usr/local/bin/perl -w

#
# reapar <source.c> <cpus> <source's parameters>
#
# Main script of the REAPAR system: Analyzes a given C program,
# instruments and compiles it, runs it using the given parameters,
# chooses a parallelization strategy and parallelizes the program
# accordingly.
#
# Stefan U. Haenssgen  03-mar-98
#
#
# NOTES:
# - The program to be parallelized must have an exit code of 0 if
#   no error occurred
#
#
# 03-mar-98	1st version: automatic instrumentation, test run,
#		 granularity check, strategy choice (only for fine grained
#		 right now), parallelization
# 05-mar-98	Separate procedure for instrumentation and compilation
#		Instrument with tree recording for coarse grained programs
#		Separate procedure for running the program
#		New recording filtering procedure
#		For coarse grained, re-instrument with tree recording, run
#		 the program, and simulate threads in recorded tree
#		Pass contents of R_SOPTIONS environment to simulation
#		More error checking
#		Use number of all leafs+nodes, not just leafs, for granularity
#		Added hints what could be wrong to error messages
# 06-mar-98	Added "-keepfiles" option
#


# Configure your setup here:
#
$COMPILER	= "gcc -g";		# C Compiler to use, with arguments
$INSTRUMENT	= "instrument_program";	# REAPAR Instrumentation component
$PARALLELIZE	= "parallelize_program";# Ditto Parallelization
$CHOOSE_FINE	= "choose_strategy_by_heuristics";	# Scripts to choose
$CHOOSE_COARSE	= "choose_strategy_by_simulation";	#  Par.Strategy
$SET_PARAM      = "set_strategy_parameters";		# Set strat.param in C
$FINEGRAINED_MS = 0.7;			# Empiric factor: any program with
					# less than this many ms/leaf gets the
					# "fine granularity" treatment

# End of configuration section


use English;				# Long internal names (e.g. "$MATCH")

# Command line parameters (read later):

$sourcename	= "";			# File name of program's source
$cpus		= 4;			# Number of CPUs to use
$runparams	= "";			# Parameters for program's sample run
$coptions	= "";			# Compiler options

# Global Variables:

$debuglevel     = 1;                    # Verbosity of output
$vl		= 0;			# Debuglevel for called programs
$runtime        = 0;			# Program sample run time
$numleafs       = 0;			# Leafs in 1st recursive procedure
$keepfiles	= 0;			# Don't delete temporary files if 1
$errcode  	= 0;			# Return code of system() call
$simparams	= "";			# Parameters for the simulation
$instructions   = "
usage: $0 [-detail <n>] [-keepfiles] <source.c> <cpus> <parameters>

       Instruments, executes and parallelizes the given ANSI C program.

	source.c	File containing all the program's C source
	cpus		Number of CPUs to use for parallelization
	parameters	Any parameters the program takes for the sample run
			 (rest of the command line)
	n		Level of detail (0=none, 1=informative (default),
			 2=verbose, 3=very detailed)

       If the -keepfiles switch is used, temporary files are not
       deleted after use, e.g. for examining the profile manually later.

       The contents of the environment variable R_COPTIONS are used as
       additional arguments to the compiler call for generating the
       executable (e.g. \"othercode.c -lm\").
       Likewise, the contents of R_SOPTIONS are passed to the simulation,
       e.g. for telling it a Nothread annotation is active (\"-b A1\" etc.)

";


# Debugging output - print text if level >= debug level
#
sub dprint {
    my $level = shift;
    my $text  = shift;

    if ($level <= $debuglevel) {
        print $text;
    }
}


# Handle parameters - parse command line for arguments, give usage
# information when none found, check if given file exists etc.
#
sub handle_arguments {

    if ( (!defined($ARGV[0])) || ($#ARGV < 1)) {
        die $instructions;
    }

    # Handle environment
    
    if (defined($ENV{"R_COPTIONS"})) {	# Compiler options
	$coptions = $ENV{"R_COPTIONS"};
    }
    if (defined($ENV{"R_SOPTIONS"})) {	# Simulation parameters, e.g. "-t B"
	$simparams = $ENV{"R_SOPTIONS"};
    }

    # Handle parameters

    while ($ARGV[0]  =~ /^-(\S+)/) {
	if ($ARGV[0] eq "-detail") { 	# Read debug level (must be 1st arg!)
	    if (!($ARGV[1] =~ /^[0-9]+$/)) {
		die "ERROR, '-debug' needs integer parameter\n";
	    }
	    $debuglevel = $ARGV[1];
	    shift @ARGV;
	    shift @ARGV;
	}
	if ($ARGV[0] eq "-keepfiles") {	# Don't delete temporary files
	    $keepfiles = 1;
	    shift @ARGV;
	}
    }
    
    $sourcename = $ARGV[0];		# Read and check source code file
    if (! -f $sourcename) {
	die "ERROR: Couldn't open source code '$sourcename'!\n";
    }
    if (! ($sourcename =~ /\.c$/) ) {
	die "ERROR: Source file must be C (*.c)!\n";
    }
#    if ($sourcename =~ /\//) {
#	die "ERROR: Source file must be in the current directory!\n";
#    }
    
    shift @ARGV;			# Read and check CPU number
    $cpus = $ARGV[0];
    if (!($cpus =~ /^[0-9]+$/) || ($cpus <= 1)) {
	die "ERROR: Number of CPUs must be numerical and > 1!\n";
    }
    
    shift @ARGV;			# Rest of arguments -> program
    $runparams = join(" ",@ARGV);
    dprint 3,"Parameters: $sourcename,$cpus.$runparams\n";

    $vl = $debuglevel - 1;
    if ($vl < 0) { $vl = 0;}

}


# Execute the given instrumented program and capture its output
# to a file, returning the file's name
#
sub run_instrumented_program {
    my $instrumented_exe = shift;
    my $tmpfile = "/tmp/reapar_tmp_$$";
    my $execall;
    
    dprint 1,"=== REAPAR: Executing '$instrumented_exe $runparams' ===\n";
    $execall = "$instrumented_exe ".
               "$runparams 2>&1 ".
               "> $tmpfile";
    $errcode = system($execall);
    if ($errcode != 0) {
        print "$execall:\n";
        die "ERROR: Instrumented program returned error code $errcode!\n".
	    "       Are you sure the program performs an 'exit(0)' call\n".
	    "       after successful completion?\n";
    }
    dprint 1,"\n";

    return $tmpfile;
}


# Look at the instrumentation's output after program has completed
# its sample run, write the profile to the given file name.
# Sets the global variables $runtime and $numleafs
#
sub evaluate_instrumentation {
    my $runoutfile 	= shift;
    my $IF 		= $runoutfile;
    my $profilefile 	= shift;
    my $PF 		= $profilefile;
    my $copy_profile 	= 0;

    $numleafs=0;
    
    open($IF, $runoutfile) ||
	die "ERROR: Couldn't open program's output file '$runoutfile' for input\n";
    open($PF, ">$profilefile") ||
	die "ERROR: Couldn't open profile file '$profilefile' for output\n";
    
    while (<$IF>) {			# Work through the profile...
	chomp;
	
	if (/Wallclock time = ([0-9.]+) seconds/) {
	    $runtime = $1;		# Get wallclock run time of program
	    dprint 3,$MATCH."\n";
	    dprint 3,"-> RUNTIME = $runtime\n";
	}
	
	if (/^END REAPAR PROFILES$/) { 	# Start copying profile
	    dprint 3,$MATCH."\n";
	    $copy_profile = 0;
	}
	if ($copy_profile > 0) {	# Inside profile part, copy all lines
	    if ($copy_profile > 3) {	# (ignoring first two lines, namely
		print $PF $_."\n";	#  empty, "Profile" and 1st "[...]")
	    }
	    if ($numleafs == 0) {
#		if (/\(sum\:[ ]+([0-9]+) /) {
		if (/ SUM \=[ ]+([0-9]+)\)/) {
		    $numleafs = $1;
		    dprint 3,$PREMATCH.$MATCH.$POSTMATCH."\n";
		    dprint 3,"-> NUMLEAFS = $numleafs\n";
		}
	    }
	    $copy_profile++;
	}
	if (/^BEGIN REAPAR PROFILES$/) { # Start copying profile
	    dprint 3,$MATCH."\n";
	    $copy_profile = 1;
	}
    }

    close($IF);
    close($PF);
}


# Look at the instrumentation's tree recording output after
# sample run, write the recording to the given file name.
# Sets the global variable $runtime.
#
sub evaluate_recording {
    my $runoutfile 	= shift;
    my $IF 		= $runoutfile;
    my $recordfile 	= shift;
    my $RF 		= $recordfile;
    my $copy_record 	= 0;
    my $treecountdown	= -1;

    open($IF, $runoutfile) ||
	die "ERROR: Couldn't open program's output file '$runoutfile' for input\n";
    open($RF, ">$recordfile") ||
	die "ERROR: Couldn't open record file '$recordfile' for output\n";
    
    while (<$IF>) {			# Work through the recording...
	chomp;
	
	if (/Wallclock time = ([0-9.]+) seconds/) {
	    $runtime = $1;		# Get wallclock run time of program
	    dprint 3,$MATCH."\n";
	    dprint 3,"-> RUNTIME = $runtime\n";
	}
	
	if (/^END REAPAR TREES$/) { 	# Start copying record
	    $copy_record = 0;
	}
	if ($copy_record > 0) {		# Inside record part, copy all lines
	    
	    # Copy 1st recursion tree (1st one found) by setting countdown
	    # for line where it will occur
	    
	    if (/^Recursion Tree for [^ ]+ Number [0-9]+, iteration 0\:/) {
		if ($treecountdown == -1) {
		    $treecountdown = 2;	# Only start counting if 1st time
		}
	    }
	    if ($treecountdown == 0) {	# Copy 1st recursion tree
		print $RF $_."\n";
	    }
	    $copy_record++;
            if ($treecountdown != -1) {
		$treecountdown--;
	    }
	}
	if (/^BEGIN REAPAR TREES$/) { # Start copying record
	    $copy_record = 1;
	}
    }

    close($IF);
    close($RF);
}


# Instrument source code and compile the result,
# returning the file name of the generated executable.
# If 2nd parameter is true, tree recording is added to
# the instrumentation.
#
sub instrument_and_compile {
    my $sourcename 		= shift;	# Name of source code file
    my $usetrees 		= shift;	# 1 if tree recording 2 B used
    my $instrumented_source 	= $sourcename;
    my $instrumented_exe;
    my $instrumentcall;
    my $compilercall;

    # Instrument the source code
    
    $instrumentcall = "$INSTRUMENT ".
	              "-detail $vl ".
                      "-autonostats ";
    if ($usetrees) {
	$instrumentcall = $instrumentcall.
		          "-record ";
        $instrumented_source =~ s/\.c/\_recorded\.c/;
    } else {
        $instrumented_source =~ s/\.c/\_instrumented\.c/;
    }
    $instrumentcall = $instrumentcall.
    		      "-out $instrumented_source ".
                      $sourcename;
    dprint 1,"=== REAPAR: Instrumenting '$sourcename'";
    if ($usetrees) {
	dprint 1," with tree recording";
    }
    dprint 1,"===\n";
    dprint 1,"\n";
    $errcode = system($instrumentcall);
    if ($errcode != 0) {
        print "$instrumentcall:\n";
        die "ERROR: instrumentation returned error code $errcode!\n";
    }

    # Compile the result of the instrumentation

    $instrumented_exe = $instrumented_source;
    $instrumented_exe =~ s/\.c//g;
    $compilercall = "$COMPILER ".
                    "-o $instrumented_exe ".
                    "$instrumented_source ".
                    "$coptions ".
                    "profile.c -lm";
    dprint 1,"=== REAPAR: Compiling '$instrumented_source' ===\n";
    $errcode = system($compilercall);
    if ($errcode != 0) {
        print "$compilercall:\n";
        die "ERROR: compiler returned error code $errcode!\n";
    }
    dprint 1,"\n";

    return $instrumented_exe;
}


# Analyze the program depending on its granularity and return
# the recommended parallelization strategy.
#
sub choose_strategy {
    my $sourcename  = shift;
    my $profilefile = shift;
    my $finegrained = shift;
    my $strategy = "NONE";
    my $param 	 = 0;
    my $cmd 	 = "";
    my $tmpfile	 = "/tmp/reapar_choose_$$";
    my $TF = $tmpfile;

    dprint 1,"\n";
    
    if ($finegrained) {			# Fine grained: Just analyze profile

	dprint 1,"=== REAPAR: Performing fine grained strategy selection ===\n\n";
	$cmd = "$CHOOSE_FINE ".
	       "$cpus ".
	       "$profilefile ".
               "| tee $tmpfile";
	
	$errcode = system($cmd);
	if ($errcode != 0) {
	    print "$cmd:\n";
	    die "ERROR: Fine grained strategy selection  returned error code $errcode!\n";
	}
	open($TF, $tmpfile) ||
	    die "ERROR: Couldn't open selection's output '$tmpfile'!";
	
        while (<$TF>) {			# Work through the profile...
	    chomp;

	    if (/^No depth recommended at all$/) {
		die "ERROR: No parallelization strategy could be recommended.\n";
	    }

	    if (/^First recommended depth for procedure \'([^ ]+)\' is ([0-9]+)$/) {
		$strategy = "DEPTH";
		$param    = $2;
		dprint 3,$PREMATCH.$MATCH.$POSTMATCH."\n";
		dprint 3,"-> DEPTH = $param\n";
	    }
	}

    } else {	# Coarse grained: Generate tree recording, then perform
		# Simulation on recording (overwrites old $profilefile)
	
	my $record_exe;
	my $outputfile;

	# Re-Instrument for recording, run, and filter resulting tree
	
	dprint 1,"=== REAPAR: Performing coarse grained strategy selection ===\n\n";
        $record_exe = &instrument_and_compile($sourcename, 1);
	$outputfile = &run_instrumented_program($record_exe);
	&evaluate_recording($outputfile, $profilefile);

	# Now perform Simulation on recorded tree
	
	$cmd = "$CHOOSE_COARSE ".
	       "$cpus ".
	       "$profilefile ".
	       "$simparams ".
               "| tee $tmpfile";
	
	$errcode = system($cmd);
	if ($errcode != 0) {
	    print "$cmd:\n";
	    die "ERROR: Coarse grained strategy selection  returned error code $errcode!\n";
	}
	dprint 1,"\n";
	
	open($TF, $tmpfile) ||
	    die "ERROR: Couldn't open selection's output '$tmpfile'!";
	
        while (<$TF>) {			# Work through the profile...
	    chomp;

	    if (/^Rank 1\: ([^ ]+) ([0-9]+)[ ]+\(([0-9]+) steps\)$/) {
		
		$strategy = $1;
		$strategy =~ tr/a-z/A-Z/;
		$param = $2;
		
		dprint 3,$PREMATCH.$MATCH.$POSTMATCH."\n";
		dprint 3,"-> STRATEGY = $strategy, PARAMETER = $param\n";
	    }
	    if (/^Rank 1\: ([^ ]+) not recommended\]$/) {
		
		die "ERROR: No parallelization strategy could be recommended.\n";
	    }
	    
	}

    }

    if (!$keepfiles) {unlink $tmpfile};

    return ($strategy,$param);
    
}


# Main program

&handle_arguments();

# Instrument program, no tree recording

$instrumented_exe = &instrument_and_compile($sourcename, 0);

# Execute the instrumented program and capture its output

$tmpfile = &run_instrumented_program($instrumented_exe);

# Evaluate the profile output, decide if the program
# is coarse or fine grained, and perform the necessary
# parallelization analysis

$profilefile = "/tmp/reapar_profile_$$";
&evaluate_instrumentation($tmpfile, $profilefile);
if (!$keepfiles) {unlink $tmpfile};

if ($numleafs == 0) {
    die "ERROR: Number of leafs in first profiled procedure is zero!\n".
	"       Please make sure the first recursive procedure in the\n".
	"       program for which statistics are collected is the one\n".
	"       to be parallelized!\n";
}

$msperleaf = ($runtime*1000)/$numleafs;
$s = sprintf("   Overall execution time %.2f seconds,\n", $runtime);
$s = $s.sprintf("   %d leafs in first recursive procedure\n", $numleafs);
dprint 1,$s;

if ($msperleaf < $FINEGRAINED_MS) {
    printf("-> Fine grained program, less than %.2f ms/leaf (%.2f)\n",
	   $FINEGRAINED_MS, $msperleaf);
    $finegrained = 1;
} else {
    printf("-> Coarse grained program, more than %.2f ms/leaf (%.2f)\n",
	   $FINEGRAINED_MS, $msperleaf);
    $finegrained = 0;
}
($strategy,$param) = &choose_strategy($sourcename, $profilefile, $finegrained);
if (!$keepfiles) {unlink $profilefile};

if ($strategy eq "NONE") {
    die "ERROR: No parallelization strategy could be recommended.\n";
}

# Parallelize the program and set the strategy

$parallelized_source = $sourcename;
$parallelized_source =~ s/\.c/\_parallelized\.c/;
$parallelizecall = "$PARALLELIZE ".
                  "-detail $vl ".
    		  "-out $parallelized_source ".
                  $sourcename;
dprint 1,"=== REAPAR: Parallelizing '$sourcename' ===\n";
dprint 1,"\n";
$errcode = system($parallelizecall);
if ($errcode != 0) {
    print "$parallelizecall:\n";
    die "ERROR: Parallelization returned error code $errcode!\n";
}

$setstratcall = "$SET_PARAM ".
    		"$strategy ".
                "$param ".
                "$parallelized_source > ".
                "$parallelized_source"."_;".
                "mv -f $parallelized_source"."_ $parallelized_source";
dprint 1,"=== REAPAR: Setting parallelization strategy '$strategy $param' ===\n";
$errcode = system($setstratcall);
if ($errcode != 0) {
    print "$setstratcall:\n";
    die "ERROR: Strategy setting returned error code $errcode!\n";
}
dprint 1,"\n";

$parallelized_exe = $parallelized_source;
$parallelized_exe =~ s/\.c//g;
$compilercall = "$COMPILER ".
                "-o $parallelized_exe ".
                "$parallelized_source ".
                "$coptions ".
                "profile.c ".
                "-D_REENTRANT -lm -lthread";
dprint 1,"=== REAPAR: Compiling '$parallelized_source' ===\n";
$errcode = system($compilercall);
if ($errcode != 0) {
    print "$compilercall:\n";
    die "ERROR: Compiler returned error code $errcode!\n";
}
dprint 1,"\n";

print "=== REAPAR: Your parallel program is ready for execution! ===\n\n";
system("ls -l $parallelized_exe");

exit 0;
