Commit 5633c4a2 authored by Junchao Zhang's avatar Junchao Zhang
Browse files

Add a script use_mpi_f08/wrappers_c/buildiface

This script is used to generate C wrapper files

No review since F08 binding is experimental now.
parent 19cca6bc
#! /usr/bin/env perl
#
# (C) 2014 by Argonne National Laboratory.
# See COPYRIGHT in top-level directory.
#
use warnings;
use strict;
# Change this to be an argument that passed in on the command line
# For all of the MPIO functions, we should surround the functions with
# #ifdef MPI_MODE_RDONLY
# ...
# #else
# ierr = MPI_ERR_INTER`
# #endif
# Check to make sure the file was passed in as a parameter
if ($#ARGV != 0) {
print "Usage: buildiface <filename>\n";
exit 1;
}
open(FD, $ARGV[0]) || die "Could not open file " . $ARGV[0];
while (<FD>) {
if (/\/\*\s*Begin Prototypes/) { last; }
}
my $eol = 1;
my $fullline = "";
my $tab = " ";
my $retarg;
my $routine;
my $args;
my @arglist;
my $fname;
my $cdesc_routine;
my $x;
my $y;
my @argbits;
my $num_dtypes;
my @dtype_bind;
my $io_header;
my %inplace = ('MPI_Allgather' => 0,
'MPI_Allgatherv' => 0,
'MPI_Allreduce' => 0,
'MPI_Alltoall' => 0,
'MPI_Alltoallv' => 0,
'MPI_Alltoallw' => 0,
'MPI_Exscan' => 0,
'MPI_Gather' => 0,
'MPI_Gatherv' => 0,
'MPI_Iallgather' => 0,
'MPI_Iallgatherv' => 0,
'MPI_Iallreduce' => 0,
'MPI_Ialltoall' => 0,
'MPI_Ialltoallv' => 0,
'MPI_Ialltoallw' => 0,
'MPI_Igather' => 0,
'MPI_Igatherv' => 0,
'MPI_Ireduce_scatter_block' => 0,
'MPI_Ireduce_scatter' => 0,
'MPI_Ireduce' => 0,
'MPI_Iscan' => 0,
'MPI_Iscatter' => 3,
'MPI_Iscatterv' => 4,
'MPI_Reduce_scatter' => 0,
'MPI_Reduce_scatter_block' => 0,
'MPI_Reduce' => 0,
'MPI_Scan' => 0,
'MPI_Scatter' => 3,
'MPI_Scatterv' => 4);
# Check to see if this is mpio.h.in. If so, we have some more to do later
if ($ARGV[0] =~ /mpio\.h\.in/) {
$io_header = 1;
} else {
$io_header = 0;
}
if (-e "cdesc.h") {
open(CDESCH, ">>cdesc.h") || die "Could not open file cdesc.h";
} else {
open(CDESCH, ">cdesc.h") || die "Could not open file cdesc.h";
print CDESCH <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
* (C) 2014 by Argonne National Laboratory.
* See COPYRIGHT in top-level directory.
*
* This file is automatically generated by buildiface
* DO NOT EDIT
*/
#include <stdio.h>
#include <stdlib.h>
#include <ISO_Fortran_binding.h>
#include <mpi.h>
extern int cdesc_create_dtype(CFI_cdesc_t *cdesc, MPI_Datatype oldtype, MPI_Datatype *newtype);
extern int MPIR_Fortran_array_of_string_f2c(const char* strs_f, char*** strs_c, int str_len, int know_size, int size);
extern int MPIR_Comm_spawn_c(const char *command, char *argv_f, int maxprocs, MPI_Info info, int root,
MPI_Comm comm, MPI_Comm *intercomm, int* array_of_errcodes, int argv_elem_len);
extern int MPIR_Comm_spawn_multiple_c(int count, char *array_of_commands_f,
char **array_of_argv_f, const int* array_of_maxprocs,
const MPI_Info *array_of_info, int root, MPI_Comm comm,
MPI_Comm *intercomm, int* array_of_errcodes,
int commands_elem_len, int argv_elem_len);
extern int MPIR_F_sync_reg_cdesc(CFI_cdesc_t* buf);
EOT
}
open(OUTFD, ">cdesc.c") || die "Could not open file cdesc.c";
print OUTFD <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
* (C) 2014 by Argonne National Laboratory.
* See COPYRIGHT in top-level directory.
*
* This file is automatically generated by buildiface
* DO NOT EDIT
*/
#include "cdesc.h"
int cdesc_create_dtype(CFI_cdesc_t *cdesc, MPI_Datatype oldtype, MPI_Datatype *newtype)
{
MPI_Datatype *types;
int i, err = MPI_SUCCESS;
types = malloc(cdesc->rank * sizeof(MPI_Datatype));
for (i = 0; i < cdesc->rank; i++) {
if (cdesc->dim[i].sm == cdesc->elem_len) {
err = MPI_Type_contiguous(cdesc->dim[i].extent, i == 0 ? oldtype : types[i-1], &types[i]);
if (err)
return err;
}
else {
err = MPI_Type_create_hvector(cdesc->dim[i].extent, 1, cdesc->dim[i].sm, i == 0 ? oldtype : types[i-1],
&types[i]);
if (err)
return err;
}
err = MPI_Type_commit(&types[i]);
if (err)
return err;
}
err = MPI_Type_dup(types[cdesc->rank-1], newtype);
if (err)
return err;
for (i = 0; i < cdesc->rank; i++)
MPI_Type_free(&types[i]);
free(types);
return err;
}
EOT
close OUTFD;
open(MAKEFD, ">Makefile.mk") || die "Could not open Makefile.mk\n";
print MAKEFD <<EOT;
## DO NOT EDIT
## This file created by buildiface
##
## vim: set ft=automake :
# ensure that the buildiface script ends up in the release tarball
EXTRA_DIST += src/binding/fortran/use_mpi_f08/wrappers_c/buildiface
mpi_f08_sources =
if BUILD_F08_BINDING
mpi_f08_sources += \\
EOT
# if the Nth datatype does not correspond to the Nth void* buffer, set
# the correct binding here. A value of "2:4" means that the first
# datatype corresponds to the 2nd void* buffer and the second datatype
# corresponds to the 4th void* buffer. There must not exist a third
# datatype.
my %dtype_bindings = (
'MPI_Unpack' => '2',
'MPI_Unpack_external' => '2',
);
while (<FD>) {
if (/\/\*\s*End Prototypes/) { last; }
if (/\/\*\s*Begin Skip Prototypes/) {
while (<FD>) {
if (/\/\*\s*End Skip Prototypes/) { last; }
}
}
# If we found a semi-colon at the end, that's the end of the line.
# This is not perfect (e.g., does not work when a single line has
# multiple semi-colon separated statements), but should be good
# enough for the MPICH mpi.h file
if (/.*;$/) { $eol = 1; }
else { $eol = 0; }
chomp($_);
$fullline .= "$_";
if ($eol == 0) { next; }
# We got the entire prototype in a single line
# parse out comments
$fullline =~ s+/\*.*\*/++g;
# parse out attributes
$fullline =~ s/MPICH_ATTR_WEAK_ALIAS\(.*\)//g;
$fullline =~ s/MPICH_ATTR_POINTER_WITH_TYPE_TAG\(.*\)//g;
# parse out unnecessary spaces
$fullline =~ s/^ *//g;
$fullline =~ s/ *$//g;
# split the line into the return type, routine name, and arguments
$fullline =~ m/([^ ]*) ([^(]*)\((.*)\)/;
$retarg = $1;
$routine = $2;
$args = $3;
# cleanup args
$args =~ s/\s\s*/ /g;
$args =~ s/^\s*//g;
$args =~ s/\s*$//g;
# the following routines are ignored:
# Having void * arguments but they are not choice buffer
if (($routine eq "MPI_Grequest_start")
|| ($routine eq "MPI_Comm_create_keyval")
|| ($routine eq "MPI_Comm_set_attr")
|| ($routine eq "MPI_Comm_get_attr")
|| ($routine eq "MPI_Type_create_keyval")
|| ($routine eq "MPI_Type_set_attr")
|| ($routine eq "MPI_Type_get_attr")
|| ($routine eq "MPI_Win_create_keyval")
|| ($routine eq "MPI_Win_set_attr")
|| ($routine eq "MPI_Win_get_attr")
) {
$fullline = "";
next;
}
#
# FIXME: Alltoallw takes an array of datatypes; we need better
# logic to create such an array for derived datatypes
# Temporarily enabled since no non-contig subarray is supported
#if (($routine eq "MPI_Alltoallw")
# || ($routine eq "MPI_Ialltoallw")
# || ($routine eq "MPI_Neighbor_alltoallw")
# || ($routine eq "MPI_Ineighbor_alltoallw")
# ) {
# $fullline = "";
# next;
#}
@arglist = split(/,/, $args);
# If the function arguments have a void*, it is of interest to us.
# Dump the function definition into the file and the function name
# into the Makefile.
# Here's the strategy we use:
#
# If the number of void* and datatype arguments are the same
# (e.g., MPI_SEND), we map them one to one. This might not be
# generally true, but is true as of MPI-3. It needs to be checked
# whenever we add new functions.
#
# Some functions have different datatype and void* counts. If the
# number of datatypes is larger than the number of void* buffers
# (e.g., MPI_PUT), we map the datatype to the first void* buffer
# and ignore the remaining datatypes. We also create more
# datatypes than what we use. This is inefficient, but not
# incorrect (needs to be fixed).
#
# If the number of datatypes is smaller than the number of void*
# buffers (e.g., MPI_PACK), we assign datatypes for the first few
# void* buffers and ignore the rest. This rule also holds true
# for functions that have multiple void* buffers all of which
# correspond to the same datatype (e.g., MPI_REDUCE), where we
# assume that the a uniform subarray format is used by all void*
# buffers. Again, this is not generally correct, but is
# sufficient for MPI-3.
#
# Some functions do not have the void* and datatype correspondence
# in order. For example, in MPI_UNPACK, the first (and only)
# datatype corresponds to the second void* buffer. We handle
# these functions as a special case as described in the
# %dtype_bindings array.
if (grep/void\s*\*/, @arglist) {
$fname = "$routine";
$fname =~ s/MPI_//g;
$fname =~ tr/A-Z/a-z/;
$fname .= "_cdesc.c";
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/$fname \\\n";
open(CFILE, ">$fname") || die "Could not open $fname\n";
# replace MPI_Foo with MPIR_Foo_cdesc
$cdesc_routine = $routine;
$cdesc_routine =~ s/MPI_/MPIR_/g;
$cdesc_routine .= "_cdesc";
print CFILE <<EOT;
/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
* (C) 2014 by Argonne National Laboratory.
* See COPYRIGHT in top-level directory.
*
* This file is automatically generated by buildiface
* DO NOT EDIT
*/
#include "cdesc.h"
EOT
print CFILE "\n$retarg $cdesc_routine(";
print CDESCH "extern $retarg $cdesc_routine(";
for ($x = 0; $x <= $#arglist; $x++) {
$arglist[$x] =~ s/^\s*//g;
$arglist[$x] =~ s/\s*$//g;
}
for ($x = 0; $x <= $#arglist; $x++) {
# remove variable names in arguments
@argbits = split(/ /, $arglist[$x]);
$arglist[$x] = "";
for ($y = 0; $y <= $#argbits; $y++) {
$argbits[$y] =~ s/\*.*/*/g;
$argbits[$y] =~ s/[^ ]*\[\]/[]/g;
if ($y < $#argbits) {
$arglist[$x] .= "$argbits[$y] ";
}
else {
if ($argbits[$y] =~ /\[\]/ || $argbits[$y] =~ /\*/) {
$arglist[$x] .= "$argbits[$y] ";
}
else {
# reduce the array size by one to drop the last bit
$#argbits--;
}
}
}
# replace void * with CFI_cdesc_t*
if ($arglist[$x] =~ /.*void\s*\*/) {
$arglist[$x] = "CFI_cdesc_t*";
}
@argbits = split(/ /, $arglist[$x]);
if ($x) {
print CFILE ", ";
print CDESCH ", ";
}
# print out all but the last bit of the argument
for ($y = 0; $y < $#argbits; $y++) {
print CFILE "$argbits[$y] ";
print CDESCH "$argbits[$y] ";
}
# deal with [] structures for the last bit
if ($argbits[$#argbits] =~ /\[\]/) {
print CFILE "x$x\[\]";
print CDESCH "x$x\[\]";
}
else {
print CFILE "$argbits[$#argbits] x$x";
print CDESCH "$argbits[$#argbits] x$x";
}
}
print CFILE ")\n{\n";
print CDESCH ");\n";
if ($io_header) {
print CFILE "#ifdef MPI_MODE_RDONLY\n"
}
print CFILE "${tab}int err = MPI_SUCCESS;\n";
print CFILE "${tab}int is_contig = 1;\n\n";
for ($x = 0; $x <= $#arglist; $x++) {
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE " /* When MPI_BOTTOM is passed in, base_addr is NULL and it is illegal to call CFI_is_contiguous. */\n";
print CFILE "${tab}if (x$x->base_addr != NULL) {\n";
print CFILE "${tab}${tab}if (!CFI_is_contiguous(x$x)) { is_contig = 0; }\n";
print CFILE "${tab}}\n"
}
}
print CFILE "\n";
print CFILE "${tab}if (is_contig) {\n";
if (defined($inplace{$routine})) {
print CFILE "${tab}${tab}void *addr = x$inplace{$routine}->base_addr;\n";
print CFILE "${tab}${tab}if (addr == MPIR_F08_MPI_IN_PLACE)\n";
print CFILE "${tab}${tab}${tab}addr = MPI_IN_PLACE;\n\n";
}
print CFILE "${tab}${tab}err = $routine(";
for ($x = 0; $x <= $#arglist; $x++) {
if ($x) {
print CFILE ", ";
}
if (defined($inplace{$routine}) && $x eq $inplace{$routine}) {
print CFILE "addr";
}
else {
print CFILE "x$x";
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "->base_addr";
}
}
}
print CFILE ");\n";
print CFILE "${tab}}\n";
print CFILE "${tab}else {\n";
print CFILE "#if 0\n";
for ($x = 0, $y = 0; $x <= $#arglist; $x++) {
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "${tab}${tab}MPI_Datatype dtype$y = MPI_DATATYPE_NULL;\n";
$y++;
}
}
for ($x = 0, $y = 0; $x <= $#arglist; $x++) {
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "${tab}${tab}cdesc_create_dtype(x$x, MPI_INT, &dtype$y);\n";
$y++;
}
}
$num_dtypes = $y;
print CFILE "\n${tab}${tab}err = $routine(";
if (defined($dtype_bindings{$routine})) {
@dtype_bind = split(/:/, $dtype_bindings{$routine});
}
for ($x = 0, $y = 0; $x <= $#arglist; $x++) {
if ($x) {
print CFILE ", ";
}
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "x$x->base_addr";
}
elsif ($arglist[$x] =~ /MPI_Datatype/) {
if ($y >= $num_dtypes) {
# if we already saw the expected number of
# datatypes, ignore the rest
print CFILE "x$x";
}
elsif ($dtype_bind[$y]) {
$dtype_bind[$y]--;
print CFILE "dtype$dtype_bind[$y]";
}
else {
print CFILE "dtype$y";
}
$y++;
}
else {
print CFILE "x$x";
}
}
print CFILE ");\n\n";
for ($x = 0, $y = 0; $x <= $#arglist; $x++) {
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "${tab}${tab}MPI_Type_free(&dtype$y);\n";
$y++;
}
}
print CFILE "\n${tab}${tab}return err;\n";
print CFILE "#else\n";
print CFILE "${tab}${tab}fprintf(stderr, \"MPI_SUBARRAYS_SUPPORTED is false; subarrays are not supported\\n\");\n";
print CFILE "${tab}${tab}return MPI_ERR_ARG;\n";
print CFILE "#endif\n";
print CFILE "${tab}}\n";
if ($io_header) {
print CFILE "#else\n";
print CFILE "${tab}*ierr = MPI_ERR_INTERN;\n";
print CFILE "#endif\n";
}
print CFILE "${tab}return err;\n";
print CFILE "}\n";
close CFILE;
}
$fullline = "";
}
if ($make_exists) {
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c \\\n";
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/comm_spawn_c.c \\\n";
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/comm_spawn_multiple_c.c \\\n";
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/f_sync_reg_c.c \\\n";
print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/utils.c\n\n";
print MAKEFD <<EOT;
AM_CPPFLAGS += -I\${master_top_srcdir}/src/binding/fortran/use_mpi_f08/wrappers_c
noinst_HEADERS += src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h
endif BUILD_F08_BINDING
EOT
}
close MAKEFD;
close CDESCH;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment