#!/usr/bin/perl -w
## pocc-versionsgenerator.pl for pocc in /Users/pouchet
##
## Made by Louis-Noel Pouchet
## Contact: <louis-noel.pouchet@inria.fr>
##
## Started on  Wed Apr 15 18:50:36 2009 Louis-Noel Pouchet
## Last update Mon Feb  6 19:27:35 2012 Louis-Noel Pouchet
##
#
# pocc-versionsgenerator: this file is part of the PoCC project.
#
# PoCC, the Polyhedral Compiler Collection package
#
# Copyright (C) 2009,2010 Louis-Noel Pouchet
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# as published by the Free Software Foundation; either version 2.1
# of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# The complete GNU General Public Licence Notice can be found as the
# `COPYING.LESSER' file in the root directory.
#
# Author:
# Louis-Noel Pouchet <Louis-Noel.Pouchet@inria.fr>
#

use Switch;
use Term::ANSIColor;
use Digest::MD5;


sub print_versions
{
    my (%config) = @_;
    ## Print config table.
    my $i;
    my $flag;
    for $flag (keys %config) {
	for $field (keys %{$config{$flag}}) {
	    my @array = @{$config{$flag}{$field}};
	    for ($i = 0; $i <= $#array; $i++) {
		$value = $array[$i];
		print "$flag: $field -> $value\n";
	    }
	}
    }
}


sub read_versions_file
{
    my ($file) = @_;
    my %versions_data;
    open FILE, "$file" or die $!;
    my $opt = "";
    while (<FILE>) {
	if ($_ !~ /^#|^[\s\t]*\n/) {
	    $_ =~ s/(.*)\n/$1/g;
	    if ($_ =~ /^\[.*\]/) {
		$opt = $_;
		$opt =~ s/^\[(.*)\].*/$1/g;
		$versions_data{$opt}{"flag-name"}[0] = $opt;
	    }
	    else {
		my @entry = split(/:/, $_);
		$entry[0] =~ s/\s//g;
		my $data = $entry[1];
		my $i;
		for ($i = 2; $i <= $#entry; $i++) {
		    $data = $data . ":" . $entry[$i];
		}
		my @opts = split(/\|/, $data);
		@{$versions_data{$opt}{$entry[0]}} = @opts;
	    }
	}
    }

#    print_versions(%versions_data);

    return %versions_data;
}


sub dec2bin {
    my $str = unpack("B32", pack("N", shift));
#    $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
    return $str;
}


sub has_tiling
{
    my ($arg) = @_;
    return 1 if ($arg =~ /--pluto-tile/);
    return 0;
}


sub compute_md5
{
   my ($file) = @_;
   open(FILE, $file) or die "Can't open '$file': $!";
   binmode(FILE);
   return Digest::MD5->new->addfile(*FILE)->digest;
}


sub version_already_exists
{
    my ($filename, $similar_handle, $md5tab) = @_;
    my $md5_value = compute_md5("$filename");
    my $code_exists = 0;
    if (defined($$md5tab{$md5_value})) {
	my $dif;
	for $md5val (keys %$md5tab) {
	    if ($md5val eq $md5_value) {
		$dif = `diff $filename $$md5tab{$md5val}`;
		if ($dif eq "") {
		    $code_exists = 1;
		    system("rm -f $filename");
		    print $similar_handle "$$md5tab{$md5val} $filename\n";
		    last;
		}
	    }
	}
    }
    if ($code_exists == 0) {
	$$md5tab{$md5_value} = $filename;
    }
    return $code_exists;
}


sub compute_tiling_depth
{
    my ($filename, @tile_depth) = @_;

    ## Check if 1-d tiling is generating a different code.

    ## FIXME: Do that part.
}


sub generate_versions
{
    my ($version_file, $file) = @_;
    my $similar_file = $file . "-similar-versions";

    print "[PoCC-generator] Generate flag sequences from $version_file for file $file\n";
    ## Read default options.
    my %config = read_versions_file($version_file);

    ## Retrieve default option(s).
    my $default_opts = "";
    if ((%{$config{"default"}})) {
	$default_opts = $config{"default"}{"flags"}[0];
	## Remove it from the set of configurations.
	delete($config{"default"});
	print "[PoCC-generator] Default options: $default_opts\n";
    }

    ## Deal with tile sizes.
    my @tile_sizes = (32);
    if ((%{$config{"tile-sizes"}})) {
	my $tmp = $config{"tile-sizes"}{"sizes"}[0];
	$tmp =~ s/^\s+//g;
	$tmp =~ s/\s+/ /g;
	@tile_sizes = split(/ /, $tmp);
	## Remove it from the set of configurations.
	delete($config{"tile-sizes"});
	print "[PoCC-generator] Tile sizes: @tile_sizes\n";
    }

    ## Loop on all options.
    my $i;
    my $k;
    my $l;
    ## Compute total number of on/off flags and create an array from that.
    my $count = 0;
    my @flag_array;
    my @flag_mutex;
    my @mutex_group;
    my $group_id = 1;
    for $flag (keys %config) {
	$base_flag = $config{$flag}{"flag-name"}[0];

	if (defined($config{$flag}{"values"})) {
	    my @array = @{$config{$flag}{"values"}};
 	    for ($i = 0; $i <= $#array; $i++) {
		$flag_mutex[$count] = $group_id;
		$flag_array[$count++] = $base_flag." ".$array[$i];
	    }
	}
	else {
	    $flag_mutex[$count] = 0;
	    $flag_array[$count++] = $base_flag;
	}
	if (defined($config{$flag}{"options"})) {
	    my @array = @{$config{$flag}{"options"}};
 	    for ($i = 0; $i <= $#array; $i++) {
		$flag_mutex[$count] = 0;
		$flag_array[$count++] = $base_flag." ".$array[$i];
	    }
	}
	$group_id++;
    }
    my $nb_opts = $#flag_array;
    ## Generate all combinations.
    ## FIXME: Only 32 native flags are supported (32 bits).
    my %final_flags;
    for ($k = 1; $k < 2 ** ($nb_opts + 1); $k++) {
	my $val = dec2bin($k);
	my $opt_str = $default_opts;
	for ($l = 0; $l < 32; $l++) {
	    $mutex_group[$l] = 0;
	}
	for ($l = 0; $l < 32; $l++) {
	    if (substr($val,31 - $l, 1) eq "1") {
		if ($flag_mutex[$l] != 0) {
		    if ($mutex_group[$flag_mutex[$l]] == 0) {
			$opt_str = $opt_str . " " . $flag_array[$l];
			$mutex_group[$flag_mutex[$l]] = 1;
		    }
		}
		else {
		    $opt_str = $opt_str . " " . $flag_array[$l];
		}
	    }
	}
	$final_flags{$opt_str} = 1;
    }
    my $nb_combinations = scalar keys %final_flags;
    print "[PoCC-generator] Total number of flags sequences: $nb_combinations\n";

    ## Open the file containing similar C files.
    open SIMILAR, ">", "$similar_file" or die $!;

    ## Call PoCC for each flag sequence
    $output_dir = $file;
    $output_dir =~ s/\.c$//g;
    $filename_prefix = $output_dir;
    $output_dir = $output_dir . "-pocc-flags";
    system("mkdir -p $output_dir");
    local $| = 1;
    my $version_counter = 0;
    my $file_counter = 0;
    my %md5_table;
    my @tile_depth;
    $tile_depth[0] = 1; $tile_depth[1] = 1; $tile_depth[2] = 1;
    my $timeout = 180;
    for $flag_seq (keys %final_flags) {
	my $out_filename = $flag_seq;
	$out_filename =~ s/\s/_/g;
	$out_filename =~ s/--//g;
	$out_filename =~ s/__/_/g;
	$out_filename = $filename_prefix . $out_filename;
	if ($#tile_sizes >= 1 && has_tiling($flag_seq)) {

	    ## Test the level of tiling required.
	    compute_tiling_depth("$out_filename", @tile_depth);
	    my @tile_comb;
	    for ($n = 0; $n <= $tile_depth[0] * $#tile_sizes; $n++) {
		for ($m = 0; $m <= $tile_depth[1] * $#tile_sizes; $m++) {
		    for ($l = 0; $l <= $tile_depth[2] * $#tile_sizes; $l++) {
			$tile_comb[0] = $tile_sizes[$n];
			$tile_comb[1] = $tile_sizes[$m];
			$tile_comb[2] = $tile_sizes[$l];
			$tile_comb[3] = 32;
			$tile_comb[4] = 32;
			$tile_comb[5] = 32;
			$tile_comb[6] = 32;
			## Hard-wire there's no more than a 8-d tiling.
			$tile_comb[7] = 32;

			my $tile_string = "-$tile_sizes[$n]"."x$tile_sizes[$m]"."x$tile_sizes[$l]";

			system("rm -f tile.sizes");
			for ($i = 0; $i < 7; $i++) {
			    system("/bin/echo -n \"$tile_comb[$i] \" >> tile.sizes");
			}
			system("/bin/echo \"$tile_comb[$i]\" >> tile.sizes");
			my $ret = `perl -e 'alarm shift \@ARGV; exec \@ARGV' $timeout "pocc $flag_seq $file -o $output_dir/$out_filename$tile_string.c 2>/dev/null"`;
			if ($? != 0) {
			    print "Command failed\n";
			    system ("rm -f $output_dir/$out_filename.c");
			}
			else {
			    print "T";
			    if (! version_already_exists("$output_dir/$out_filename$tile_string.c", SIMILAR, \%md5_table)) {
				$file_counter++;
			    }
			    $version_counter++;
			}
		    }
		}
	    }
	}
	else {
	    my $ret = `perl -e 'alarm shift \@ARGV; exec \@ARGV' $timeout "pocc $flag_seq $file -o $output_dir/$out_filename.c 2>/dev/null"`;
	    if ($? != 0) {
		print "Command failed\n";
		system ("rm -f $output_dir/$out_filename.c");
	    }
	    else {
		print ".";
		if (! version_already_exists("$output_dir/$out_filename.c", SIMILAR, \%md5_table)) {
		    $file_counter++;
		}
		$version_counter++;
	    }
	}
    }
    close SIMILAR;

    print "\n";
    print "[PoCC-generator] Total number of versions created: $version_counter\n";
    print "[PoCC-generator] Total number of C files generated: $file_counter\n";
    print "[PoCC-generator] File containing the similarity pairs: $similar_file\n";
}
