#! /usr/bin/env perl
##
## Copyright (C) by Argonne National Laboratory
##     See COPYRIGHT in top-level directory
##

# Parse C or header files to search for MPI_T performance variables (PVARS)
# then output the info in source code form.

use strict;
use warnings;
use File::Basename qw(basename);
use Data::Dumper;
use Getopt::Long;

# Help perl find the YAML parsing module
use lib 'maint/local_perl/lib';
use YAML::Tiny qw();

# To format README file
use Text::Wrap;
$Text::Wrap::unexpand = 0; # disable hard tabs in output

##################################################

# set true to enable debug output
my $debug = 0;
my @pvars = ();
my @categories=();
my $yaml = YAML::Tiny->new();
my $pvarfile = "src/mpi_t/mvp_pvars.txt";
my $pvarcolfile = "src/mpi_t/mvp_coll_pvars.txt";

# namespace prefix for function names
my $fn_ns = "MPIR_T_MVP_pvar";
# namespace prefix for variable and type names
# MVAPICH-specific prefix
my $ns = "MVP";
# an alternative namespace used for environment variables, unused if set to ""
my $alt_ns = "UCR";
# deprecated prefix for backward compatibility
my $dep_ns = "MV2";

# Default :output source files
# NOTE: it's important to use single quote. abs_srcdir may contain sigils
#   e.g. /var/lib/jenkins/workspace/hzhou-custom@2/config/ch3-sock/label/centos64
my $header_file = 'src/include/mvp_pvars.h';
my $c_file      = 'src/util/mvp_pvars.c';
my $readme_file = 'README_MVP.envvar';

sub Usage {
    print <<EOT;

Usage: $0 [OPTIONS]

Supported options:
    --help              - this output (optional)
    --debug             - enable some debugging output (optional)
    --namespace=STR     - use STR as variable/type prefix in generated code (optional, default=$ns)
    --alt-namespace=STR - use STR as alternative variable/type prefix in generated code (optional, default=$alt_ns)
    --header=STR        - specify the header file name (optional, default=$header_file)
    --c-file=STR        - specify the C file name (optional, default=$c_file)
    --readme-file=STR   - specify the readme file name (optional, default=$readme_file)

EOT
    exit 1;
}

# Step 1: Process options
GetOptions(
    "help!"           => \&Usage,
    "debug!"          => \$debug,
    "namespace=s"     => \$ns,
    "alt-namespace=s" => \$alt_ns,
    "header=s"        => \$header_file,
    "c-file=s"        => \$c_file,
    "readme-file=s"   => \$readme_file,
) or Usage();


ProcessFile($pvarfile);
ProcessFile($pvarcolfile);

# Step 4: Preprocess pvars:
# *) Make sure that all categories referenced by pvars actually exist
# *) Strip out the prefix of their name (normally, MPIR_PVAR)
die "missing 'pvars', stopped" unless (@pvars);
my %cat_hash = map {$_->{name} => 1} @categories;

# Step 5: Output pvars and categories
print "Categories include: \n".Dumper(@categories) if $debug;
print "Pvars include :\n".Dumper(@pvars)."\n" if $debug;

my $run_timestamp = gmtime($ENV{SOURCE_DATE_EPOCH} || time)." UTC";
my $uc_ns = uc($ns);

# Setup output files
open(OUTPUT_H,      '>', $header_file);
open(OUTPUT_C,      '>', $c_file);
#open(OUTPUT_README, '>', $readme_file);

#===============================================================
# Step 5.1: Dump the header file.
my $hdr_guard = Header2InclGuard($header_file);
print OUTPUT_H <<EOT;
/*
 * Copyright (C) by Network Based Computing Laboratory
 *     See COPYRIGHT in top-level directory
 */

/* Automatically generated
 *   by:   $0
 *   on:   $run_timestamp
 *
 * DO NOT EDIT!!!
 */

#if !defined($hdr_guard)
#define $hdr_guard
#include "mpiimpl.h"
#ifdef ENABLE_PVAR_MVP

#define MVP_COLL_PVAR_UPDATE_START(c, t) \\
  do { \\
    MPIR_T_PVAR_COUNTER_INC(MVP, c, 1); \\
    MPIR_T_PVAR_TIMER_START(MVP, t); \\
  } while(0);
#define MVP_COLL_PVAR_UPDATE_END(t) \\
  MPIR_T_PVAR_TIMER_END(MVP, t);

#define MVP_MPIC_PVAR_BYTE_COUNTER(arr, tag, count, datatype) \\
  do { \\
    MPI_Aint pvar_msg_sz; \\
    MPIR_Datatype_get_size_macro(datatype, pvar_msg_sz); \\
    pvar_msg_sz *= count; \\
    if (tag < MPIR_BARRIER_TAG || tag > MPIR_FIRST_NBC_TAG) { \\
        MPIR_T_PVAR_COUNTER_ARRAY_INC(MVP, arr, 0, pvar_msg_sz); \\
    } else { \\
        MPIR_T_PVAR_COUNTER_ARRAY_INC(MVP, arr, tag, pvar_msg_sz); \\
    } \\
  } while (0);


void MPIR_REGISTER_MVP_VARIABLES(void);
/* Extern declarations for each pvar
 * (definitions in $c_file) */

EOT

foreach my $p (@pvars) {
    printf OUTPUT_H "/* declared in $p->{location} */\n";

    if ($p->{type} eq 'COUNTER_ARRAY') {
        printf OUTPUT_H "extern %s PVAR_%s_%s[%s];\n", Type2Ctype($p->{type}, $p->{datatype}),'COUNTER',$p->{name}, $p->{size};
    } else {
        printf OUTPUT_H "extern %s PVAR_%s_%s;\n", Type2Ctype($p->{type}, $p->{datatype}),$p->{type},$p->{name};
    }
}
print OUTPUT_H <<EOT;

#define MVP_PVAR_COUNT ${\scalar @pvars}
#else /* ENABLE_PVAR_MVP */
#define MVP_COLL_PVAR_UPDATE_START(c, t)
#define MVP_COLL_PVAR_UPDATE_END(t)
#define MPIR_REGISTER_MVP_VARIABLES()
#define MVP_PVAR_COUNT 0
#endif /* ENABLE_PVAR_MVP */
#endif /* $hdr_guard */
EOT
close(OUTPUT_H);

#===============================================================
# Step 5.2: Dump the C file.

print OUTPUT_C <<EOT;
/*
 * Copyright (C) by Network Based Computing Laboratory
 *     See COPYRIGHT in top-level directory
 */

/* Automatically generated
 *   by:   $0
 *   on:   $run_timestamp
 *
 * DO NOT EDIT!!!
 */
#include "mpiimpl.h"
#ifdef ENABLE_PVAR_MVP
EOT

# Declaring definitions
foreach my $p (@pvars) {
    if ($p->{type} eq 'COUNTER_ARRAY') {
        printf OUTPUT_C "%s PVAR_%s_%s[%s];\n",Type2Ctype($p->{type}, $p->{datatype}),'COUNTER',$p->{name}, $p->{size};
    } else {
        printf OUTPUT_C "%s PVAR_%s_%s;\n",Type2Ctype($p->{type}, $p->{datatype}),$p->{type},$p->{name};
    }
}

print OUTPUT_C <<EOT;

void MPIR_REGISTER_MVP_VARIABLES(void)
{

EOT

foreach my $p (@pvars) {
    if ($p->{type} eq "TIMER"){
        printf OUTPUT_C qq(     MPIR_T_PVAR_TIMER_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),
                        qq(         $p->{module}, /* Module */),
                        qq(         $p->{datatype}, /* Datatype */),
                        qq(         $p->{name}, /* Name */),
                        qq(         $p->{verbosity}, /* Verbosity */),
                        qq(         $p->{bind}, /* Bind */),
                        qq(         $p->{flags}, /* Flags */),
                        qq(         "$p->{category}", /* Category Name */),
                        qq(         "$p->{description}" /* Description */);

    } elsif ($p->{type} eq "COUNTER"){
         printf OUTPUT_C qq(     MPIR_T_PVAR_COUNTER_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),
                        qq(         $p->{module}, /* Module */),
                        qq(         $p->{datatype}, /* Datatype */),
                        qq(         $p->{name}, /* Name */),
                        qq(         $p->{verbosity}, /* Verbosity */),
                        qq(         $p->{bind}, /* Bind */),
                        qq(         ($p->{flags}), /* Flags */),
                        qq(         "$p->{category}", /* Category Name */),
                        qq(         "$p->{description}" /* Description */);

    } elsif ($p->{type} eq "COUNTER_ARRAY"){
         printf OUTPUT_C qq(     MPIR_T_PVAR_COUNTER_ARRAY_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),
                        qq(         $p->{module}, /* Module */),
                        qq(         $p->{datatype}, /* Datatype */),
                        qq(         $p->{name}, /* Name */),
                        qq(         $p->{verbosity}, /* Verbosity */),
                        qq(         $p->{bind}, /* Bind */),
                        qq(         ($p->{flags}), /* Flags */),
                        qq(         "$p->{category}", /* Category Name */),
                        qq(         "$p->{description}" /* Description */);

    } else{
        printf OUTPUT_C qq(     MPIR_T_PVAR_LEVEL_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),
                        qq(         $p->{module}, /* Module */),
                        qq(         $p->{datatype}, /* Datatype */),
                        qq(         $p->{name}, /* Name */),
                        qq(         $p->{initval}, /* Initial Value */),
                        qq(         $p->{verbosity}, /* Verbosity */),
                        qq(         $p->{bind}, /* Bind */),
                        qq(         ($p->{flags}), /* Flags */),
                        qq(         "$p->{category}", /* Category Name */),
                        qq(         "$p->{description}" /* Description */);

    }
}

print OUTPUT_C <<EOT;

}
#endif /* ENABLE_PVAR_MVP */
EOT

# print OUTPUT_C "Pvars include :\n".Dumper(@pvars)."\n";

close(OUTPUT_C);

#===============================================================
# Helper subroutines used in this script

sub get_pvar_mpi_dtype {
    my $p = shift;

    if ($p->{type} eq 'string') {
        return "MPI_CHAR";
    }
    elsif ($p->{type} eq 'int' or $p->{type} eq 'boolean') {
        return "MPI_INT";
    }
    elsif ($p->{type} eq 'double') {
        return "MPI_DOUBLE";
    }
    elsif ($p->{type} eq 'range') {
        return "MPI_INT";
    }
    elsif ($p->{type} eq 'enum') {
        return "MPI_INT";
    }
    else {
        die "unknown type $p->{type}, stopped";
    }
}

#---------------------------------------------------------------
# Transform a pvar type to an MPI_T/C specific struct type
sub Type2Ctype {
    my ($type, $dtype) = @_;
    my %typemap = (
        'TIMER'     => 'MPIR_T_pvar_timer_t',
        'COUNTER'  => mpiType2Ctype($dtype),
        'COUNTER_ARRAY'  => mpiType2Ctype($dtype),
        'LEVEL'  => mpiType2Ctype($dtype),
    );
    die "unknown type '$type', stopped" unless exists $typemap{$type};
    return $typemap{$type};
}

# Transform an MPI type to a C specific struct type
sub mpiType2Ctype {
    my $type = shift;
    my %typemap = (
        'MPI_INT'     => 'int',
        'MPI_UNSIGNED_LONG_LONG'  => 'unsigned long long',
        'MPI_UNSIGNED_LONG'  => 'unsigned long',
        'MPI_DOUBLE'  => 'double',
    );
    die "unknown type '$type', stopped" unless exists $typemap{$type};
    return $typemap{$type};
}

# turns /path/foo_BAR-baz.h into FOO_BAR_BAZ_H_INCLUDED
sub Header2InclGuard {
    my $header_file = shift;
    my $guard = basename($header_file);
    $guard =~ tr/a-z\-./A-Z__/;
    $guard .= "_INCLUDED";
    die "guard contains whitespace, stopped" if ($guard =~ m/\s/);
    return $guard;
}

# Parse a file, search the MPI_T_PVAR_INFO_BLOCK if any.
# Distill pvars and categories from the block.
# Push the results to back of @pvars and @categories respectively.
sub ProcessFile {
    my $cfile = $_[0];
    my $pvar_info_block = undef;
    my $in_pvar_info_block = 0;

    #print "Processing file $cfile\n" if $debug;
    open my $CFILE_HANDLE, "< $cfile" or die "Error: open file $cfile -- $!\n";
    while (<$CFILE_HANDLE>) {
        if (/END_MPI_T_MVP_PVAR_INFO_BLOCK/) {
            last;
        } elsif ($in_pvar_info_block) {
            $pvar_info_block .= $_;
        } elsif (/BEGIN_MPI_T_MVP_PVAR_INFO_BLOCK/) {
            $in_pvar_info_block = 1;
            print "Found MPI_T_MVP_PVAR_INFO_BLOCK in $cfile\n" if $debug;
        }
    }
    close $CFILE_HANDLE;

    # Do some checking to ensure a correct pvar info block, also
    # add file locations to help users' debugging.
    if ($pvar_info_block) {
        my $info = ($yaml->read_string($pvar_info_block))->[0];
        if (exists $info->{pvars}) {
            # Remember location where the pvar is defined. Put that into
            # comments of the generated *.h file so that users know where
            # to look when meeting compilation errors.
            foreach my $pvar (@{$info->{pvars}}) {
                $pvar->{location} = $cfile;
				die "ERROR: pvar has no name in $cfile\n" unless exists $pvar->{name};
				die "ERROR: pvar $pvar->{name} has no type in $cfile\n" unless exists $pvar->{type};
				die "ERROR: pvar $pvar->{name} has no module in $cfile\n" unless exists $pvar->{module};
				die "ERROR: pvar $pvar->{name} has no datatype in $cfile\n" unless exists $pvar->{datatype};
				die "ERROR: pvar $pvar->{name} has no verbosity in $cfile\n" unless exists $pvar->{verbosity};
				die "ERROR: pvar $pvar->{name} has no bind in $cfile\n" unless exists $pvar->{bind};
				die "ERROR: pvar $pvar->{name} has no flags in $cfile\n" unless exists $pvar->{flags};
				die "ERROR: pvar $pvar->{name} has no category in $cfile\n" unless exists $pvar->{category};
				die "ERROR: pvar $pvar->{name} has no description in $cfile\n" unless exists $pvar->{description};
                if ($pvar->{type} eq 'COUNTER_ARRAY') {
                    die "ERROR: pvar $pvar->{name} has no size in $cfile\n" unless exists $pvar->{size};
                }

            }
            push (@pvars, @{$info->{pvars}});
        }

        if (exists $info->{categories}) {
            # Do the same trick to categories
            foreach my $cat (@{$info->{categories}}) {
                $cat->{location} = $cfile;
                die "ERROR: category has no name in $cfile\n" unless exists $cat->{name};
                die "ERROR: category $cat->{name} has no description in $cfile\n"
                    unless exists $cat->{description};
            }
            push (@categories, @{$info->{categories}});
        }
    }
}
