Commit 1b761d0f authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Auto-generate MPI_Comm conversion wrapper.

parent 5c55626f
......@@ -355,6 +355,16 @@ Get one value of a Y-axis.
Get all values of a Y-axis.
\section*{\tt \htmlref{pioInit}{pioInit}}
\begin{verbatim}
MPI_Comm pioInit (MPI_Comm commSuper, int nProcsIO, int IOMode, int nNamespaces,
int *hasLocalFile);
\end{verbatim}
initialize I/O server processes and communication.
\section*{\tt \htmlref{streamClose}{streamClose}}
\begin{verbatim}
......
......@@ -355,6 +355,16 @@ Get one value of a Y-axis.
Get all values of a Y-axis.
\section*{\tt \htmlref{pioInit}{pioInit}}
\begin{verbatim}
INTEGER FUNCTION pioInit (INTEGER commSuper, INTEGER nProcsIO, INTEGER IOMode,
INTEGER nNamespaces, INTEGER hasLocalFile)
\end{verbatim}
initialize I/O server processes and communication.
\section*{\tt \htmlref{streamClose}{streamClose}}
\begin{verbatim}
......
......@@ -161,7 +161,7 @@ int main (int argc, char *argv[])
}
}
commModel = pioInit_c ( commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile );
commModel = pioInit(commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile);
#endif
modelRun ();
......
......@@ -186,7 +186,7 @@ int main (int argc, char *argv[])
nProcsIO = nProcsIODef;
}
commModel = pioInit_c ( commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile );
commModel = pioInit(commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile);
#endif
modelRun ();
......
......@@ -236,7 +236,7 @@ int main (int argc, char *argv[])
if ( nProcsIO != 1 )
xabort ( "bad distribution of tasks on PEs" );
commModel = pioInit_c ( commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile );
commModel = pioInit(commGlob, nProcsIO, IOMode, nNamespaces, hasLocalFile);
modelRun ( commModel );
......
......@@ -214,16 +214,25 @@ extern "C" {
#define PIO_MINIOMODEWITHSPECIALPROCS PIO_WRITER
/* parallel IO routines */
#ifndef MPI_VERSION
# define MPI_Comm int
#endif
void pioEndDef ( void );
void pioEndTimestepping ( void );
void pioFinalize ( void );
int pioInit ( int, int, int, int, int * );
/* pioInit: initialize I/O server processes and communication */
MPI_Comm pioInit(MPI_Comm commSuper, int nProcsIO, int IOMode, int nNamespaces,
int *hasLocalFile);
int pioInqVarDecoChunk ( int, int );
int pioInqVarDecoOff ( int, int );
void pioNamespaceSetActive ( int );
void pioWriteTimestep ( int, int, int );
#ifndef MPI_VERSION
#undef MPI_Comm
#endif
/* CDI control routines */
char *cdiStringError(int cdiErrno);
......
......@@ -362,11 +362,11 @@
EXTERNAL pioFinalize
INTEGER pioInit
! (INTEGER ,
! INTEGER ,
! INTEGER ,
! INTEGER ,
! INTEGER )
! (INTEGER commSuper,
! INTEGER nProcsIO,
! INTEGER IOMode,
! INTEGER nNamespaces,
! INTEGER hasLocalFile)
EXTERNAL pioInit
INTEGER pioInqVarDecoChunk
......
......@@ -4,6 +4,14 @@
# include "config.h"
#endif
#if USE_MPI
# include <mpi.h>
#else
#define MPI_Comm int
#define MPI_Comm_f2c(c) (c)
#define MPI_Comm_c2f(c) (c)
#endif
#if ! defined (_CDI_H)
# include "cdi.h"
#endif
......@@ -62,7 +70,13 @@
FCALLSCSUB0 (pioEndDef, PIOENDDEF, pioenddef)
FCALLSCSUB0 (pioEndTimestepping, PIOENDTIMESTEPPING, pioendtimestepping)
FCALLSCSUB0 (pioFinalize, PIOFINALIZE, piofinalize)
FCALLSCFUN5 (INT, pioInit, PIOINIT, pioinit, INT, INT, INT, INT, PINT)
static int pioInit_fwrap(int commSuper, int nProcsIO, int IOMode, int nNamespaces, int * hasLocalFile)
{
MPI_Comm v;
v = pioInit(MPI_Comm_f2c(commSuper), nProcsIO, IOMode, nNamespaces, hasLocalFile);
return MPI_Comm_c2f(v);
}
FCALLSCFUN5 (INT, pioInit_fwrap, PIOINIT, pioinit, INT, INT, INT, INT, PINT)
FCALLSCFUN2 (INT, pioInqVarDecoChunk, PIOINQVARDECOCHUNK, pioinqvardecochunk, INT, INT)
FCALLSCFUN2 (INT, pioInqVarDecoOff, PIOINQVARDECOOFF, pioinqvardecooff, INT, INT)
FCALLSCSUB1 (pioNamespaceSetActive, PIONAMESPACESETACTIVE, pionamespacesetactive, INT)
......
......@@ -19,8 +19,9 @@ typedef struct
}
Docu;
Docu cdoc[9999], fdoc[9999];
size_t ncdoc = 0, nfdoc = 0;
static Docu cdoc[9999], fdoc[9999];
static size_t ncdoc = 0, nfdoc = 0;
static int debug = 0;
int doccmp(const void *s1, const void *s2)
{
......@@ -64,11 +65,25 @@ void doctotxt(FILE *fp, Docu *doc, size_t ndoc)
}
}
enum {ISVOID, ISCONSTSTRING, ISINT, ISREAL, ISDOUBLE, ISINTP, ISINTV, ISINTVV, ISREALP, ISDOUBLEP, ISSTRING, ISSTRINGP, NUM_KNOWN_ARG_TYPES};
enum cftype {ISVOID, ISCONSTSTRING, ISINT, ISREAL, ISDOUBLE, ISMPI_COMM,
ISINTP, ISINTV, ISINTVV, ISREALP, ISDOUBLEP, ISSTRING, ISSTRINGP,
NUM_KNOWN_ARG_TYPES};
enum conversionType { CONV_ARG, CONV_RET };
typedef int (*cfConversionEmitter)(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part);
static int cfMPICommConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part);
struct symbol {
const char *f77name, *cfint, *cname, *parseRE;
size_t nameMatch;
int needsExtraWrapper;
cfConversionEmitter convert;
const char *convcname;
regex_t preg;
};
......@@ -79,43 +94,49 @@ struct symbol {
#define NWS "[^[:blank:]\n]"
static struct symbol funArgSym[]
= { { "", "", "void",
"^"WS"*void"WS"*)", 0 },
"^"WS"*void"WS"*)", 0, 0 },
{ "CHARACTER*80", "STRING", "char *",
"^"WS"*const"WS"+char"WS"+\\*"SYMRE WS"*\\(", 1 },
"^"WS"*const"WS"+char"WS"+\\*"SYMRE WS"*\\(", 1, 0 },
{ "INTEGER", "INT", "int",
"^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*[,\\)]", 3 },
"^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*[,\\)]", 3, 0 },
{ "REAL", "FLOAT", "float",
"^"WS"*(const"WS"+)?float"WS"+"SYMRE"?"WS"*[,\\)]", 2 },
"^"WS"*(const"WS"+)?float"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0 },
{ "DOUBLEPRECISION", "DOUBLE", "double",
"^"WS"*(const"WS"+)?double"WS"+"SYMRE"?"WS"*[,\\)]", 2 },
"^"WS"*(const"WS"+)?double"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0 },
{ "INTEGER", "INT", "MPI_Comm",
"^"WS"*MPI_Comm"WS"+"SYMRE"?"WS"*[,\\)]", 1, 1,
cfMPICommConvert, "int" },
{ "INTEGER", "PINT", "int *",
"^"WS"*(const"WS"+)?int"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2 },
"^"WS"*(const"WS"+)?int"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0 },
{ "INTEGER", "INTV", "int[]",
"^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"WS"*[,\\)]", 3 },
"^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
WS"*[,\\)]", 3, 0 },
{ "INTEGER", "INTVV", "int[][]",
"^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
WS"*\\[[^]]*\\]"WS"*[,\\)]", 3 },
WS"*\\[[^]]*\\]"WS"*[,\\)]", 3, 0 },
{ "REAL", "PFLOAT", "float *",
"^"WS"*(const"WS"+)?float"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2 },
"^"WS"*(const"WS"+)?float"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0 },
{ "DOUBLEPRECISION", "PDOUBLE", "double *",
"^"WS"*(const"WS"+)?double"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2 },
"^"WS"*(const"WS"+)?double"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0 },
{ "CHARACTER*(*)", "STRING", "char *",
"^"WS"*const"WS"+char"WS"+\\*"WS"*"SYMRE"?"WS"*[,\\)]", 1 },
"^"WS"*const"WS"+char"WS"+\\*"WS"*"SYMRE"?"WS"*[,\\)]", 1, 0 },
{ "CHARACTER*(*)", "PSTRING", "char *",
"^"WS"*char"WS"+\\*"SYMRE"?"WS"*[,\\)]", 1 },
"^"WS"*char"WS"+\\*"SYMRE"?"WS"*[,\\)]", 1, 0 },
};
static struct symbol funRet[] = {
{ "", "", "void",
"void"WS"+"SYMRE WS"*\\(", 1 },
"void"WS"+"SYMRE WS"*\\(", 1, 0 },
{ "CHARACTER", "STRING", "(const) char *",
"(const"WS"+)?char"WS"+\\*"WS"*"SYMRE WS"*\\(", 2 },
"(const"WS"+)?char"WS"+\\*"WS"*"SYMRE WS"*\\(", 2, 0 },
{ "INTEGER", "INT", "int",
"(const"WS"+)?int"WS"+"SYMRE WS"*\\(", 2 },
"(const"WS"+)?int"WS"+"SYMRE WS"*\\(", 2, 0 },
{ "REAL", "FLOAT", "float",
"(const"WS"+)?float"WS"+"SYMRE WS"*\\(", 2 },
"(const"WS"+)?float"WS"+"SYMRE WS"*\\(", 2, 0 },
{ "DOUBLEPRECISION", "DOUBLE", "double",
"(const"WS"+)?double"WS"+"SYMRE WS"*\\(", 2 },
"(const"WS"+)?double"WS"+"SYMRE WS"*\\(", 2, 0 },
{ "INTEGER", "INT", "MPI_Comm",
"MPI_Comm"WS"+"SYMRE WS"*\\(", 1, 0, cfMPICommConvert, "int" },
};
enum { NUM_RET_TYPES = sizeof (funRet) / sizeof (funRet[0]) };
......@@ -123,6 +144,7 @@ enum decl { UNKNOWN_DECL, FUNC_DECL, PARAM_DECL };
enum {
MAX_FUNC_ARGS = 200,
MAX_FUNC_NAME_LEN = 127,
};
static inline size_t
......@@ -138,11 +160,11 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
char xname[128], xdes[128];
xname[0] = 0;
int parvalue;
int functype;
enum cftype functype;
int lineno = 0;
size_t len;
char funcname[128];
char funcname[MAX_FUNC_NAME_LEN];
regmatch_t funcargfull[MAX_FUNC_ARGS];
regmatch_t funcargname[MAX_FUNC_ARGS];
int funcargtype[MAX_FUNC_ARGS];
......@@ -273,10 +295,18 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
fprintf(fpint, "# include \"config.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if ! defined (_CDI_H)\n");
fprintf(fpint, "# include \"cdi.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
fputs("#if USE_MPI\n"
"# include <mpi.h>\n"
"#else\n"
"#define MPI_Comm int\n"
"#define MPI_Comm_f2c(c) (c)\n"
"#define MPI_Comm_c2f(c) (c)\n"
"#endif\n"
"\n"
"#if ! defined (_CDI_H)\n"
"# include \"cdi.h\"\n"
"#endif\n"
"\n", fpint);
fprintf(fpint, "#if defined (HAVE_CF_INTERFACE)\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if ! defined (__CFORTRAN_LOADED)\n");
......@@ -291,6 +321,7 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
functype = ISVOID;
size_t funcargc = 0;
pline = line;
int needsExtraWrapper = 0;
enum decl declType = UNKNOWN_DECL;
do {
for (int retType = 0; retType < NUM_RET_TYPES; ++retType)
......@@ -298,14 +329,17 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
{
functype = retType;
declType = FUNC_DECL;
needsExtraWrapper
= needsExtraWrapper || funRet[retType].needsExtraWrapper;
break;
}
if (declType == UNKNOWN_DECL)
break;
regmatch_t *nameMatch = reMatch + funRet[functype].nameMatch;
printf("Found: %.*s\n",
nameMatch->rm_eo - nameMatch->rm_so,
pline + nameMatch->rm_so);
if (debug)
printf("Found: %.*s\n",
nameMatch->rm_eo - nameMatch->rm_so,
pline + nameMatch->rm_so);
ssize_t funNameLast = reMatch[0].rm_eo - 1;
ssize_t nameLen = nameMatch->rm_eo - nameMatch->rm_so;
if ( pline[funNameLast] != '(' )
......@@ -359,7 +393,7 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
/* printf("funcargc = %d\n", funcargc);*/
{
size_t i;
for (i = 0; i < funcargc; i++ )
for (i = 0; i < funcargc; ++i )
{
pline = line + funcargname[i].rm_so;
int argtype;
......@@ -376,6 +410,8 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
regmatch_t *nameMatch = reMatch + funArgSym[argtype].nameMatch;
funcargname[i].rm_so = nameMatch->rm_so + argStart;
funcargname[i].rm_eo = nameMatch->rm_eo + argStart;
needsExtraWrapper
= needsExtraWrapper || funArgSym[argtype].needsExtraWrapper;
break;
}
if (argtype == NUM_KNOWN_ARG_TYPES)
......@@ -419,7 +455,65 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
fprintf(fpinc, " %-16s%s\n\n", "EXTERNAL", sname);
/* fortran interface */
const char *delegateName;
char delegateNameBuf[MAX_FUNC_NAME_LEN + 7];
/* emit wrapper for type conversions if needed */
if (needsExtraWrapper)
{
strcpy(delegateNameBuf, funcname);
strcat(delegateNameBuf, "_fwrap");
delegateName = delegateNameBuf;
fprintf(fpint, "static %s %s(",
(funRet[functype].convert
?funRet[functype].convcname:funRet[functype].cname),
delegateName);
for (size_t i = 0; i < funcargc; i++ )
{
fprintf(fpint, "%s%s %.*s", (i > 0?", ":""),
(funArgSym[funcargtype[i]].convert
?funArgSym[funcargtype[i]].convcname
:funArgSym[funcargtype[i]].cname),
(int)(funcargname[i].rm_eo - funcargname[i].rm_so),
line + funcargname[i].rm_so);
}
fputs(")\n{\n", fpint);
if (functype != ISVOID)
fprintf(fpint, " %s v;\n"
" v = %s(", funRet[functype].cname,
funcname);
else
fprintf(fpint, " %s(", funcname);
for (size_t i = 0; i < funcargc; i++ )
{
if (funArgSym[funcargtype[i]].convert)
{
if (i > 0)
fputs(", ", fpint);
funArgSym[funcargtype[i]]
.convert(fpint,
line + funcargname[i].rm_so,
(size_t)(funcargname[i].rm_eo
- funcargname[i].rm_so), CONV_ARG);
}
else
fprintf(fpint, "%s %.*s", (i > 0?", ":""),
(int)(funcargname[i].rm_eo - funcargname[i].rm_so),
line + funcargname[i].rm_so);
}
fputs(");\n", fpint);
if (functype != ISVOID)
{
fputs(" return ", fpint);
if (funRet[functype].convert)
funRet[functype].convert(fpint, "v", 1, CONV_RET);
else
fputc('v', fpint);
fputs(";\n", fpint);
}
fputs("}\n", fpint);
}
else
delegateName = funcname;
if ( functype == ISVOID )
fprintf(fpint, "FCALLSCSUB");
else
......@@ -427,8 +521,8 @@ void fortran_interface(char *fname, char *fnameinc, char *fnameint)
fprintf(fpint, "%zd ", funcargc);
fprintf(fpint, "(");
if ( functype != ISVOID )
fprintf(fpint, "%s, ", funArgSym[functype].cfint);
fprintf(fpint, "%s, ", funcname);
fprintf(fpint, "%s, ", funRet[functype].cfint);
fprintf(fpint, "%s, ", delegateName);
for (size_t i = 0; i < len; i++ ) sname[i] = (char)toupper((int) sname[i]);
fprintf(fpint, "%s, ", sname);
for (size_t i = 0; i < len; i++ ) sname[i] = (char)tolower((int) sname[i]);
......@@ -696,6 +790,23 @@ compress_whitespace(size_t len, char str[])
return wpos;
}
/* emit conversion code for MPI_Comm argument */
static int cfMPICommConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part)
{
int retval = 0;
switch (part)
{
case CONV_ARG:
retval
= fprintf(outfp, "MPI_Comm_f2c(%.*s)", (int)argNameLen, argName);
break;
case CONV_RET:
retval = fprintf(outfp, "MPI_Comm_c2f(%.*s)", (int)argNameLen, argName);
break;
}
return retval;
}
/*
* Local Variables:
......
......@@ -2,11 +2,16 @@
# include "config.h"
#endif
#include <limits.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#ifdef USE_MPI
#include <mpi.h>
#endif
#include "cdi.h"
#include "limits.h"
#include "pio_util.h"
#include "vlist_var.h"
......@@ -659,6 +664,10 @@ int pioInqVarDecoOff ( int vlistID, int varID )
}
/*****************************************************************************/
/* pioInit definition must currently compile even in non-MPI configurations */
#ifndef MPI_VERSION
# define MPI_Comm int
#endif
/**
@brief initializes the MPI_Communicators needed for the
communication between the calculator PEs and the I/O PEs and within the
......@@ -679,10 +688,11 @@ int pioInqVarDecoOff ( int vlistID, int varID )
@return int indicating wether the calling PE is a calcutator (1) or not (0)
*/
#ifdef USE_MPI
MPI_Comm pioInit_c ( MPI_Comm commGlob, int nProcsIO, int IOMode,
int nNamespaces, int * hasLocalFile )
MPI_Comm
pioInit(MPI_Comm commGlob, int nProcsIO, int IOMode,
int nNamespaces, int * hasLocalFile)
{
#ifdef USE_MPI
int sizeGlob;
if ( IOMode < PIO_MINIOMODE || IOMode > PIO_MAXIOMODE )
......@@ -728,36 +738,16 @@ MPI_Comm pioInit_c ( MPI_Comm commGlob, int nProcsIO, int IOMode,
xdebug ( "nProcsGlob=%d, RETURN", sizeGlob );
return commInqCommModel ();
}
#endif
/*****************************************************************************/
int pioInit ( int commGlobArg, int nProcsIO, int IOMode, int nNamespaces,
int * hasLocalFile )
{
#ifdef USE_MPI
xdebug("START: %s, nProcsIO=%d, IOMode=%d, nNamespaces=%d",
"cdi parallel",
nProcsIO, IOMode, nNamespaces );
#else
xdebug("START: %s, nProcsIO=%d, IOMode=%d, nNamespaces=%d",
"cdi serial",
nProcsIO, IOMode, nNamespaces );
abort();
#endif
}
#ifdef USE_MPI
MPI_Comm commGlob = MPI_Comm_f2c((MPI_Fint)commGlobArg);
xassert ( commGlob != MPI_COMM_NULL );
return MPI_Comm_c2f ( pioInit_c ( commGlob, nProcsIO, IOMode, nNamespaces,
hasLocalFile ));
#ifndef MPI_VERSION
# undef MPI_Comm
#endif
xdebug("%s", "RETURN" );
return 0;
}
/************************************************************************/
/*****************************************************************************/
void pioEndDef ( void )
{
......
......@@ -743,6 +743,7 @@ void getTimeStepData ( int tsID, int vdate, int vtime )
" getWin=%p, sizeof(int)=%u",
modelID, nProcsModel, modelID, rxWin[modelID].size,
getWinBaseAddr, (unsigned)sizeof(int));
/* FIXME: this needs to use MPI_PACK for portability */
xmpi(MPI_Get(rxWin[modelID].buffer, rxWin[modelID].size,
MPI_UNSIGNED_CHAR, modelID, 0,
rxWin[modelID].size, MPI_UNSIGNED_CHAR, getWin));
......
......@@ -469,8 +469,8 @@ int main (int argc, char *argv[])
}
#ifdef USE_MPI
commModel = pioInit_c(commGlob, nProcsIO, IOMode,
nNamespaces, hasLocalFile);
commModel = pioInit(commGlob, nProcsIO, IOMode,
nNamespaces, hasLocalFile);
#else
commModel = -1;
#endif
......
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