#!/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/BuGuYkQogF/mpich-3.3.2/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
# NOTE: it's important to use single quote. abs_srcdir may contain sigils
# e.g. /var/lib/jenkins-slave/workspace/hzhou-custom@2/config/ch3-sock/label/centos64
my $header_file = '/tmp/BuGuYkQogF/mpich-3.3.2/maint/../src/include/mpir_cvars.h';
my $c_file = '/tmp/BuGuYkQogF/mpich-3.3.2/maint/../src/util/cvar/mpir_cvars.c';
my $readme_file = '/tmp/BuGuYkQogF/mpich-3.3.2/maint/../README.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 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 = 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;
/* -*- 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 <<EOT;
/* TODO: this should be defined elsewhere */
#define ${ns}_assert MPIR_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 <<EOT;
/* -*- 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 = (const 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 <<EOT;
#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 = (const 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;
$desc =~ s/\n/\\\n/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 <<EOT;
${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 <<EOT;
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 <<EOT;
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 <<EOT;
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 <<EOT;
if (tmp_str != NULL) {
${var_name} = MPL_strdup(tmp_str);
${ns}_assert(${var_name});
if (${var_name} == NULL) {
MPIR_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 <<EOT;
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
EOT
print OUTPUT_C <<EOT;
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 <<EOT;
if (${var_name} != NULL) {
MPL_free((char *)${var_name});
${var_name} = NULL;
}
EOT
}
}
print OUTPUT_C <<EOT;
return mpi_errno;
}
EOT
close(OUTPUT_C);
#===============================================================
#Step 5.3 Dump the readme file
print OUTPUT_README <<EOT;
(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' => 'const 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";
for my $filename (sort 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);
}
}