#!/usr/bin/env perl

#

# (C) 2011by Argonne National Laboratory.

#     See COPYRIGHT in top-level directory.

#

# Parse C or header files to search for MPI_T control variable

# and category info, 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 '/tmp/_HMuTRgPPE/mpich-3.2.1/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 @cvars = ();

my @categories=();

my $yaml = YAML::Tiny->new();

my @dirs = ();

my @cfiles = ();

my %skipfiles = ();

# namespace prefix for function names

my $fn_ns = "MPIR_T_cvar";

# namespace prefix for variable and type names

my $ns = "MPIR_CVAR";

# an alternative namespace used for environment variables, unused if set to ""

my $alt_ns = "MPIR_PARAM";

# deprecated prefix for backward compatibility

my $dep_ns = "MPICH";

# Default :output source files

my $header_file = "/tmp/_HMuTRgPPE/mpich-3.2.1/maint/../src/include/mpich_cvars.h";

my $c_file      = "/tmp/_HMuTRgPPE/mpich-3.2.1/maint/../src/util/cvar/mpich_cvars.c";

my $readme_file = "/tmp/_HMuTRgPPE/mpich-3.2.1/maint/../README.envvar";

sub Usage {

    print <

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 alternaive 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)

    --dirs=STR          - recursively parse C or header files under the directories as specified

    --skip=STR          - skip parsing files as specified (optional)

EOT

    exit 1;

}

# Step 1: Process options

my $dirline;

my $skipline = "";

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,

    "dirs=s"          => \$dirline,

    "skips=s"         => \$skipline

) or Usage();

Usage unless $dirline;

print "dirline = $dirline\n" if $debug;

@dirs = split(/[:,;\s]+/, $dirline);

my @skips = split(/[:,;\s]+/, $skipline);

%skipfiles = map {$_ => 1} @skips;

# Step 2: Search all cfiles and put them in @cfiles.

foreach my $dir (@dirs) {

    ExpandDir($dir);

}

# Step 3: Parse each cfile and put results in  @cvars and @categories.

foreach my $cfile (@cfiles) {

    ProcessFile($cfile);

}

# Step 4: Preprocess cvars:

# *) Make sure that all categories referenced by cvars actually exist

# *) Strip out the prefix of their name (normally, MPIR_CVAR)

die "missing 'cvars', stopped" unless (@cvars);

my %cat_hash = map {$_->{name} => 1} @categories;

foreach my $p (@cvars) {

    unless (exists $cat_hash{$p->{category}}) {

        warn "Category '".$p->{category}."' referenced by '".$p->{name}."' was not found";

    }

    $p->{name} =~ s/${ns}_//;

    if (exists $p->{'alt-env'}) {

        my @alts = split(/[:,;\s]+/, $p->{'alt-env'});

        foreach my $elmt (@alts) {

            $elmt =~ s/${ns}_//;

        }

        $p->{'alt-env'} = [@alts];

    }

}

# Step 5: Output cvars and categories

print "Categories include: \n".Dumper(@categories) if $debug;

print "Cvars include :\n".Dumper(@cvars)."\n" if $debug;

my $run_timestamp = localtime();

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 <

/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */

/*

 *  (C) 2010 by Argonne National 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 "mpitimpl.h" /* for MPIR_T_cvar_range_value_t */

/* Initializes cvar values from the environment */

int ${fn_ns}_init(void);

int ${fn_ns}_finalize(void);

/* Extern declarations for each cvar

 * (definitions in $c_file) */

EOT

foreach my $p (@cvars) {

    printf OUTPUT_H "/* declared in $p->{location} */\n";

    printf OUTPUT_H "extern %s ${uc_ns}_%s;\n", Type2Ctype($p->{type}), $p->{name};

}

print OUTPUT_H <

/* TODO: this should be defined elsewhere */

#define ${ns}_assert MPIU_Assert

/* Arbitrary, simplifies interaction with external interfaces like MPI_T_ */

#define ${uc_ns}_MAX_STRLEN (384)

#endif /* $hdr_guard */

EOT

close(OUTPUT_H);

#===============================================================

# Step 5.2: Dump the C file.

print OUTPUT_C <

/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */

/*

 *  (C) 2010 by Argonne National Laboratory.

 *      See COPYRIGHT in top-level directory.

 */

/* automatically generated

 *   by:   $0

 *   at:   $run_timestamp

 *

 * DO NOT EDIT!!!

 */

#include "mpiimpl.h"

/* Actual storage for cvars */

EOT

# Output the definitions

foreach my $p (@cvars) {

    my $default = FmtDefault($p->{name}, $p->{default}, $p->{type});

    if ($p->{class} eq 'device') {

        printf OUTPUT_C "#if defined MPID_%s\n", $p->{name};

        printf OUTPUT_C "%s ${uc_ns}_%s = MPID_%s;\n", Type2Ctype($p->{type}), $p->{name},

                       $p->{name};

        printf OUTPUT_C "#else\n";

    }

    if ($p->{type} eq 'string') {

        printf OUTPUT_C "%s ${uc_ns}_%s = (char*)%s;\n", Type2Ctype($p->{type}), $p->{name}, $default;

    } else {

        printf OUTPUT_C "%s ${uc_ns}_%s = %s;\n", Type2Ctype($p->{type}), $p->{name}, $default;

    }

    if ($p->{class} eq 'device') {

        printf OUTPUT_C "#endif /* MPID_%s */\n\n", $p->{name};

    }

}

# Generate the init function.

print OUTPUT_C <

#undef FUNCNAME

#define FUNCNAME ${fn_ns}_init

#undef FCNAME

#define FCNAME MPL_QUOTE(FUNCNAME)

int ${fn_ns}_init(void)

{

    int mpi_errno = MPI_SUCCESS;

    int rc;

    const char *tmp_str;

    static int initialized = FALSE;

    MPIR_T_cvar_value_t defaultval;

    /* FIXME any MT issues here? */

    if (initialized)

        return MPI_SUCCESS;

    initialized = TRUE;

EOT

# Register categories

foreach my $cat (@categories) {

    my $desc = $cat->{description};

    $desc =~ s/"/\\"/g;

    printf OUTPUT_C qq(    /* declared in $cat->{location} */\n);

    printf OUTPUT_C qq(    MPIR_T_cat_add_desc(%s\n%s);\n\n),

        qq("$cat->{name}",),

        qq(        "$desc");

}

# Register and init cvars

foreach my $p (@cvars) {

    my $count;

    my $mpi_dtype;

    my $dftval;

    # Set count and default value of the car

    if ($p->{type} eq 'string') {

        $mpi_dtype = "MPI_CHAR";

        $count = "${uc_ns}_MAX_STRLEN";

        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});

        printf OUTPUT_C qq(    defaultval.str = (char *)%s;\n), $dftval;

    }

    elsif ($p->{type} eq 'int' or $p->{type} eq 'boolean') {

        $mpi_dtype = "MPI_INT";

        $count = 1;

        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});

        printf OUTPUT_C qq(    defaultval.d = %s;\n), $dftval;

    }

    elsif ($p->{type} eq 'double') {

        $mpi_dtype = "MPI_DOUBLE";

        $count = 1;

        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});

        printf OUTPUT_C qq(    defaultval.d = %s;\n), $dftval;

    }

    elsif ($p->{type} eq 'range') {

        $mpi_dtype = "MPI_INT";

        $count = 2;

        $dftval = FmtDefault($p->{name}, $p->{default}, $p->{type});

        printf OUTPUT_C qq(    {\n);

        printf OUTPUT_C qq(        MPIR_T_cvar_range_value_t tmp = %s;\n), $dftval;

        printf OUTPUT_C qq(        defaultval.range = tmp;\n);

        printf OUTPUT_C qq(    }\n);

    }

    else {

        die "unknown type $p->{type}, stopped";

    }

    # Register the cvar

    my $desc = $p->{description};

    $desc =~ s/"/\\"/g;

    printf OUTPUT_C qq(    MPIR_T_CVAR_REGISTER_STATIC(\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s);\n),

        qq(        $mpi_dtype,),

        qq(        ${uc_ns}_$p->{name}, /* name */),

        qq(        &${uc_ns}_$p->{name}, /* address */),

        qq(        $count, /* count */),

        qq(        $p->{verbosity},),

        qq(        $p->{scope},),

        qq(        defaultval,),

        qq(        "$p->{category}", /* category */),

        qq(        "$desc");

    if ($p->{type} eq 'string') {

print OUTPUT_C <

    ${uc_ns}_GET_DEFAULT_STRING(${uc_ns}_$p->{name}, &tmp_str);

EOT

    }

    # Get the env variable value.

    my $env_fn = Type2EnvFn($p->{type});

    my @env_names = ();

    my $var_name = "${uc_ns}_" . $p->{name};

    # Process extra envs first so the primary always wins

    push @env_names, map { "${dep_ns}_$_" } @{$p->{'alt-env'}};

    push @env_names, map { "${alt_ns}_$_" } @{$p->{'alt-env'}};

    push @env_names, map { "${uc_ns}_$_" } @{$p->{'alt-env'}};

    push @env_names, "${dep_ns}_" . $p->{name};

    push @env_names, "${alt_ns}_" . $p->{name};

    push @env_names, "${uc_ns}_" . $p->{name};

    foreach my $env_name (@env_names) {

        # assumes rc is defined

        if ($p->{type} eq 'range') {

print OUTPUT_C <

    rc = MPL_env2${env_fn}("$env_name", &($var_name.low), &($var_name.high));

    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");

EOT

        }

        elsif ($p->{type} eq 'string') {

print OUTPUT_C <

    rc = MPL_env2${env_fn}("$env_name", &tmp_str);

    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");

EOT

        }

        else {

print OUTPUT_C <

    rc = MPL_env2${env_fn}("$env_name", &($var_name));

    MPIR_ERR_CHKANDJUMP1((-1 == rc),mpi_errno,MPI_ERR_OTHER,"**envvarparse","**envvarparse %s","$env_name");

EOT

        }

    }

    if ($p->{type} eq 'string') {

print OUTPUT_C <

    if (tmp_str != NULL) {

        ${var_name} = MPIU_Strdup(tmp_str);

        ${ns}_assert(${var_name});

        if (${var_name} == NULL) {

            MPIU_CHKMEM_SETERR(mpi_errno, strlen(tmp_str), "dup of string for ${var_name}");

            goto fn_fail;

        }

    }

    else {

        ${var_name} = NULL;

    }

EOT

    }

    print OUTPUT_C "\n";

}

print OUTPUT_C <

fn_exit:

    return mpi_errno;

fn_fail:

    goto fn_exit;

}

EOT

print OUTPUT_C <

int ${fn_ns}_finalize(void)

{

    int mpi_errno = MPI_SUCCESS;

EOT

foreach my $p (@cvars) {

    my $var_name = "${uc_ns}_" . $p->{name};

    if ($p->{type} eq 'string') {

        # Need to cleanup after whatever was strduped by the init routine

print OUTPUT_C <

    if (${var_name} != NULL) {

        MPIU_Free(${var_name});

        ${var_name} = NULL;

    }

EOT

    }

}

print OUTPUT_C <

fn_exit:

    return mpi_errno;

fn_fail:

    goto fn_exit;

}

EOT

close(OUTPUT_C);

#===============================================================

#Step 5.3 Dump the readme file

print OUTPUT_README <

(C) 2010 by Argonne National Laboratory.

    See COPYRIGHT in top-level directory.

Automatically generated

  by:   $0

  at:   $run_timestamp

DO NOT EDIT!!!

This file lists the various environment variables available to change the

behavior of the MPICH library.  These are intended to be used by advanced

users.

---------------------------------------------------------------------------

EOT

foreach my $p (@cvars) {

    my @env_names = ();

    my $first;

    my $alt;

    my $default;

    # process extra envs first so the primary always wins

    push @env_names, "${alt_ns}_" . $p->{name};

    push @env_names, "${dep_ns}_" . $p->{name};

    push @env_names, map { "${uc_ns}_$_" } @{$p->{'alt-env'}};

    push @env_names, map { "${alt_ns}_$_" } @{$p->{'alt-env'}};

    push @env_names, map { "${dep_ns}_$_" } @{$p->{'alt-env'}};

    print OUTPUT_README "${uc_ns}_$p->{name}\n";

    $first = 1;

    foreach $alt (@env_names) {

        if ($first) {

            print OUTPUT_README "    Aliases: $alt\n";

        } else {

            print OUTPUT_README "             $alt\n";

        }

        $first = 0;

    }

    print OUTPUT_README wrap("    Description: ", "        ", $p->{description} . "\n");

    $default = FmtDefault($p->{name}, $p->{default}, $p->{type});

    print OUTPUT_README "    Default: $default\n";

    print OUTPUT_README "\n";

}

close(OUTPUT_README);

#===============================================================

# Helper subroutines used in this script

# Transform a cvar type to a C-language type

sub Type2Ctype {

    my $type = shift;

    my %typemap = (

        'int'     => 'int',

        'double'  => 'double',

        'string'  => 'char *',

        'boolean' => 'int',

        'range'   => "MPIR_T_cvar_range_value_t",

    );

    die "unknown type '$type', stopped" unless exists $typemap{$type};

    return $typemap{$type};

}

# Transform a default value into a C value

sub FmtDefault {

    my $name = shift;

    my $val = shift;

    my $type = shift;

    if ($type eq 'string') {

        $val =~ s/"/\\"/g;

        if ($val eq 'NULL' or $val eq 'null') { return "NULL"; }

        else { return qq("$val"); }

    }

    elsif ($type eq 'boolean') {

        if    ($val =~ m/^(0|f(alse)?|no?)$/i)   { return qq(0); }

        elsif ($val =~ m/^(1|t(rue)?|y(es)?)$/i) { return qq(1); }

        else {

            warn "WARNING: type='$type', bad val='$val', continuing";

            return qq(0); # fail-false

        }

    }

    elsif ($type eq 'range') {

        if ($val !~ "-?[0-9]+:-?[0-9]+") {

            die "Unable to parse range value '$val', stopped";

        }

        $val =~ s/:/,/;

        return qq({$val});

    }

    else {

        return qq($val);

    }

}

# 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;

}

sub Type2EnvFn {

    my $type = shift;

    my %typemap = (

        'int' =>  'int',

        'string' => 'str',

        'boolean' => 'bool',

        'double' => 'double',

        'range' => 'range',

    );

    die "unknown type '$type', stopped" unless exists $typemap{$type};

    return $typemap{$type};

}

# Parse a file, search the MPI_T_CVAR_INFO_BLOCK if any.

# Distill cvars and categories from the block.

# Push the results to back of @cvars and @categories respectively.

sub ProcessFile {

    my $cfile = $_[0];

    my $cvar_info_block = undef;

    my $in_cvar_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_CVAR_INFO_BLOCK/) {

            last;

        } elsif ($in_cvar_info_block) {

            $cvar_info_block .= $_;

        } elsif (/BEGIN_MPI_T_CVAR_INFO_BLOCK/) {

            $in_cvar_info_block = 1;

            print "Found MPI_T_CVAR_INFO_BLOCK in $cfile\n" if $debug;

        }

    }

    close $CFILE_HANDLE;

    # Do some checking to ensure a correct cvar info block, also

    # add file locations to help users' debugging.

    if ($cvar_info_block) {

        my $info = ($yaml->read_string($cvar_info_block))->[0];

        if (exists $info->{cvars}) {

            # Remember location where the cvar is defined. Put that into

            # comments of the generated *.h file so that users know where

            # to look when meeting compilation errors.

            foreach my $cvar (@{$info->{cvars}}) {

                $cvar->{location} = $cfile;

                die "ERROR: cvar has no name in $cfile\n" unless exists $cvar->{name};

                die "ERROR: cvar $cvar->{name} has no type in $cfile\n" unless exists $cvar->{type};

                die "ERROR: cvar $cvar->{name} has no verbosity in $cfile\n" unless exists $cvar->{verbosity};

                die "ERROR: cvar $cvar->{name} has no scope in $cfile\n" unless exists $cvar->{scope};

                die "ERROR: cvar $cvar->{name} has no class in $cfile\n" unless exists $cvar->{class};

                die "ERROR: cvar $cvar->{name} has no description in $cfile\n" unless exists $cvar->{description};

            }

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

        }

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

        }

    }

}

# Search cfiles recursively in the directory passed in.

# Push file names along with their paths to back of @cfiles.

sub ExpandDir {

    my $dir = $_[0];

    my @subdirs = ();

    my $DIR_HANDLE;

    opendir $DIR_HANDLE, "$dir" or die "Error: open directory $dir -- $!\n";

    while (my $filename = readdir $DIR_HANDLE) {

        if ($filename =~ /^\./) {

            next;

        } elsif (-d "$dir/$filename") {

            $subdirs[$#subdirs + 1] = "$dir/$filename";

        } elsif ($filename =~ /(.*\.[Cchi])(pp){0,1}$/) {

            if (!defined($skipfiles{"$dir/$filename"}))

            {

                $cfiles[$#cfiles + 1] = "$dir/$filename";

            }

        }

    }

    closedir $DIR_HANDLE;

    # Recursively search subdirs

    foreach $dir (@subdirs) {

        ExpandDir($dir);

    }

}