08526e8adc
rename ompi/mpi/fortran/base/strings.h so it does not get pulled when /usr/include/strings.h is expected. Refs open-mpi/ompi#3639 Signed-off-by: Gilles Gouaillardet <gilles@rist.or.jp>
255 строки
11 KiB
C
255 строки
11 KiB
C
/*
|
|
* Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
|
|
* University Research and Technology
|
|
* Corporation. All rights reserved.
|
|
* Copyright (c) 2004-2005 The University of Tennessee and The University
|
|
* of Tennessee Research Foundation. All rights
|
|
* reserved.
|
|
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
|
|
* University of Stuttgart. All rights reserved.
|
|
* Copyright (c) 2004-2005 The Regents of the University of California.
|
|
* All rights reserved.
|
|
* Copyright (c) 2007-2012 Cisco Systems, Inc. All rights reserved.
|
|
* Copyright (c) 2015-2017 Research Organization for Information Science
|
|
* and Technology (RIST). All rights reserved.
|
|
* $COPYRIGHT$
|
|
*
|
|
* Additional copyrights may follow
|
|
*
|
|
* $HEADER$
|
|
*/
|
|
|
|
#include "ompi_config.h"
|
|
|
|
#include "opal/class/opal_object.h"
|
|
|
|
#include "ompi/mpi/fortran/mpif-h/bindings.h"
|
|
#include "ompi/mpi/fortran/base/constants.h"
|
|
#include "ompi/mpi/fortran/base/datarep.h"
|
|
#include "ompi/mpi/fortran/base/fortran_base_strings.h"
|
|
#include "ompi/mpi/fortran/base/fint_2_int.h"
|
|
#include "ompi/runtime/mpiruntime.h"
|
|
#include "ompi/file/file.h"
|
|
|
|
#if OMPI_BUILD_MPI_PROFILING
|
|
#if OPAL_HAVE_WEAK_SYMBOLS
|
|
#pragma weak PMPI_REGISTER_DATAREP = ompi_register_datarep_f
|
|
#pragma weak pmpi_register_datarep = ompi_register_datarep_f
|
|
#pragma weak pmpi_register_datarep_ = ompi_register_datarep_f
|
|
#pragma weak pmpi_register_datarep__ = ompi_register_datarep_f
|
|
|
|
#pragma weak PMPI_Register_datarep_f = ompi_register_datarep_f
|
|
#pragma weak PMPI_Register_datarep_f08 = ompi_register_datarep_f
|
|
#else
|
|
OMPI_GENERATE_F77_BINDINGS (PMPI_REGISTER_DATAREP,
|
|
pmpi_register_datarep,
|
|
pmpi_register_datarep_,
|
|
pmpi_register_datarep__,
|
|
pompi_register_datarep_f,
|
|
(char *datarep, ompi_mpi2_fortran_datarep_conversion_fn_t *read_conversion_fn, ompi_mpi2_fortran_datarep_conversion_fn_t *write_conversion_fn, ompi_mpi2_fortran_datarep_extent_fn_t *dtype_file_extent_fn, MPI_Aint *extra_state, MPI_Fint *ierr, int datarep_len),
|
|
(datarep, read_conversion_fn, write_conversion_fn, dtype_file_extent_fn, extra_state, ierr, datarep_len) )
|
|
#endif
|
|
#endif
|
|
|
|
#if OPAL_HAVE_WEAK_SYMBOLS
|
|
#pragma weak MPI_REGISTER_DATAREP = ompi_register_datarep_f
|
|
#pragma weak mpi_register_datarep = ompi_register_datarep_f
|
|
#pragma weak mpi_register_datarep_ = ompi_register_datarep_f
|
|
#pragma weak mpi_register_datarep__ = ompi_register_datarep_f
|
|
|
|
#pragma weak MPI_Register_datarep_f = ompi_register_datarep_f
|
|
#pragma weak MPI_Register_datarep_f08 = ompi_register_datarep_f
|
|
#else
|
|
#if ! OMPI_BUILD_MPI_PROFILING
|
|
OMPI_GENERATE_F77_BINDINGS (MPI_REGISTER_DATAREP,
|
|
mpi_register_datarep,
|
|
mpi_register_datarep_,
|
|
mpi_register_datarep__,
|
|
ompi_register_datarep_f,
|
|
(char *datarep, ompi_mpi2_fortran_datarep_conversion_fn_t *read_conversion_fn, ompi_mpi2_fortran_datarep_conversion_fn_t *write_conversion_fn, ompi_mpi2_fortran_datarep_extent_fn_t *dtype_file_extent_fn, MPI_Aint *extra_state, MPI_Fint *ierr, int datarep_len),
|
|
(datarep, read_conversion_fn, write_conversion_fn, dtype_file_extent_fn, extra_state, ierr, datarep_len) )
|
|
#else
|
|
#define ompi_register_datarep_f pompi_register_datarep_f
|
|
#endif
|
|
#endif
|
|
|
|
static const char FUNC_NAME[] = "MPI_REGISTER_DATAREP";
|
|
|
|
/* Intercept functions used below (see below for explanations in
|
|
comments) */
|
|
static int read_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
|
|
void *filebuf, MPI_Offset position,
|
|
void *extra_state);
|
|
static int write_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
|
|
void *filebuf, MPI_Offset position,
|
|
void *extra_state);
|
|
static int extent_intercept_fn(MPI_Datatype type_c, MPI_Aint *file_extent,
|
|
void *extra_state);
|
|
|
|
/* Data structure passed to the intercepts (see below). It is an OPAL
|
|
list_item_t so that we can clean this memory up during
|
|
MPI_FINALIZE. */
|
|
typedef struct intercept_extra_state {
|
|
opal_list_item_t base;
|
|
ompi_mpi2_fortran_datarep_conversion_fn_t *read_fn_f77;
|
|
ompi_mpi2_fortran_datarep_conversion_fn_t *write_fn_f77;
|
|
ompi_mpi2_fortran_datarep_extent_fn_t *extent_fn_f77;
|
|
MPI_Aint *extra_state_f77;
|
|
} intercept_extra_state_t;
|
|
|
|
OBJ_CLASS_DECLARATION(intercept_extra_state_t);
|
|
|
|
#if !OMPI_BUILD_MPI_PROFILING || OPAL_HAVE_WEAK_SYMBOLS
|
|
static void intercept_extra_state_constructor(intercept_extra_state_t *obj)
|
|
{
|
|
obj->read_fn_f77 = NULL;
|
|
obj->write_fn_f77 = NULL;
|
|
obj->extent_fn_f77 = NULL;
|
|
obj->extra_state_f77 = NULL;
|
|
}
|
|
|
|
OBJ_CLASS_INSTANCE(intercept_extra_state_t,
|
|
opal_list_item_t,
|
|
intercept_extra_state_constructor, NULL);
|
|
#endif /* !OMPI_BUILD_MPI_PROFILING */
|
|
|
|
/*
|
|
* This function works by calling the C version of
|
|
* MPI_Register_datarep (like most other MPI API functions). To do
|
|
* that, however, we need to call the C MPI_Register_datarep with *C*
|
|
* callback functions -- the callback functions passed in to this
|
|
* function are Fortran functions, and expect Fortran argument passing
|
|
* conventions.
|
|
*
|
|
* So we have 3 C intercept functions that are passed to the back-end
|
|
* MPI_Register_datarep. Hence, when/if this datarep is ever used,
|
|
* the intercept function(s) are invoked, who then translate the
|
|
* arguments to Fortran and then invoke the registered callback
|
|
* function.
|
|
*/
|
|
void ompi_register_datarep_f(char *datarep,
|
|
ompi_mpi2_fortran_datarep_conversion_fn_t *read_fn_f77,
|
|
ompi_mpi2_fortran_datarep_conversion_fn_t *write_fn_f77,
|
|
ompi_mpi2_fortran_datarep_extent_fn_t *extent_fn_f77,
|
|
MPI_Aint *extra_state_f77,
|
|
MPI_Fint *ierr, int datarep_len)
|
|
{
|
|
char *c_datarep;
|
|
int c_ierr, ret;
|
|
MPI_Datarep_conversion_function *read_fn_c, *write_fn_c;
|
|
intercept_extra_state_t *intercept;
|
|
|
|
/* Malloc space for the intercept callback data */
|
|
intercept = OBJ_NEW(intercept_extra_state_t);
|
|
if (NULL == intercept) {
|
|
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL,
|
|
OMPI_ERR_OUT_OF_RESOURCE, FUNC_NAME);
|
|
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
|
|
return;
|
|
}
|
|
/* Save the new object on a global list because per MPI-2:9.5.3,
|
|
there are no ways for the user to deregister datareps once
|
|
they've been created. Hece, this is a memory leak. So we
|
|
track these extra resources in a global list so that they can
|
|
be freed during MPI_FINALIZE (so that memory-tracking debuggers
|
|
won't show MPI as leaking memory). */
|
|
opal_list_append(&ompi_registered_datareps, &(intercept->base));
|
|
|
|
/* Convert the fortran string */
|
|
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
|
|
&c_datarep))) {
|
|
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, ret, FUNC_NAME);
|
|
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
|
|
return;
|
|
}
|
|
|
|
/* Convert the Fortran function callbacks to C equivalents. Use
|
|
local intercepts if they're not MPI_CONVERSION_FN_NULL so that
|
|
we can just call the C MPI API PMPI_Register_datarep(). If they
|
|
*are* MPI_CONVERSION_FN_NULL, then just pass that to
|
|
PMPI_Register_datarep so that it becomes a no-op (i.e., no
|
|
callback is ever triggered). */
|
|
if (OMPI_IS_FORTRAN_CONVERSION_FN_NULL(read_fn_f77)) {
|
|
/* Can't use the MPI_CONVERSION_FN_NULL macro here because it
|
|
is specifically not defined when compiling this file so
|
|
that we can prototype an all-caps Fortran function */
|
|
read_fn_c = (MPI_Datarep_conversion_function*) 0;
|
|
} else {
|
|
intercept->read_fn_f77 = read_fn_f77;
|
|
read_fn_c = read_intercept_fn;
|
|
}
|
|
if (OMPI_IS_FORTRAN_CONVERSION_FN_NULL(write_fn_f77)) {
|
|
/* Can't use the MPI_CONVERSION_FN_NULL macro here because it
|
|
is specifically not defined when compiling this file so
|
|
that we can prototype an all-caps Fortran function */
|
|
write_fn_c = (MPI_Datarep_conversion_function*) 0;
|
|
} else {
|
|
intercept->write_fn_f77 = write_fn_f77;
|
|
write_fn_c = write_intercept_fn;
|
|
}
|
|
intercept->extent_fn_f77 = extent_fn_f77;
|
|
intercept->extra_state_f77 = extra_state_f77;
|
|
|
|
/* Now that the intercept data has been setup, call the C function
|
|
with the setup intercept routines and the intercept-specific
|
|
data/extra state. */
|
|
c_ierr = PMPI_Register_datarep(c_datarep,
|
|
read_fn_c, write_fn_c,
|
|
extent_intercept_fn,
|
|
intercept);
|
|
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
|
|
free(c_datarep);
|
|
}
|
|
|
|
/*
|
|
* C->Fortran intercept for the read conversion.
|
|
*/
|
|
static int read_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
|
|
void *filebuf, MPI_Offset position,
|
|
void *extra_state)
|
|
{
|
|
MPI_Fint ierr, count_f77 = OMPI_FINT_2_INT(count_c);
|
|
MPI_Fint type_f77 = PMPI_Type_c2f(type_c);
|
|
intercept_extra_state_t *intercept_data =
|
|
(intercept_extra_state_t*) extra_state;
|
|
|
|
intercept_data->read_fn_f77((char *) userbuf, &type_f77, &count_f77, (char *) filebuf,
|
|
&position, intercept_data->extra_state_f77,
|
|
&ierr);
|
|
return OMPI_FINT_2_INT(ierr);
|
|
}
|
|
|
|
/*
|
|
* C->Fortran intercept for the write conversion.
|
|
*/
|
|
static int write_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
|
|
void *filebuf, MPI_Offset position,
|
|
void *extra_state)
|
|
{
|
|
MPI_Fint ierr, count_f77 = OMPI_FINT_2_INT(count_c);
|
|
MPI_Fint type_f77 = PMPI_Type_c2f(type_c);
|
|
intercept_extra_state_t *intercept_data =
|
|
(intercept_extra_state_t*) extra_state;
|
|
|
|
intercept_data->write_fn_f77((char *) userbuf, &type_f77, &count_f77, (char *) filebuf,
|
|
&position, intercept_data->extra_state_f77,
|
|
&ierr);
|
|
return OMPI_FINT_2_INT(ierr);
|
|
}
|
|
|
|
/*
|
|
* C->Fortran intercept for the extent calculation.
|
|
*/
|
|
static int extent_intercept_fn(MPI_Datatype type_c, MPI_Aint *file_extent_f77,
|
|
void *extra_state)
|
|
{
|
|
MPI_Fint ierr, type_f77 = PMPI_Type_c2f(type_c);
|
|
intercept_extra_state_t *intercept_data =
|
|
(intercept_extra_state_t*) extra_state;
|
|
|
|
intercept_data->extent_fn_f77(&type_f77, file_extent_f77,
|
|
intercept_data->extra_state_f77, &ierr);
|
|
return OMPI_FINT_2_INT(ierr);
|
|
}
|
|
|