root/ompi/mpi/fortran/mpif-h/register_datarep_f.c

DEFINITIONS

1. intercept_extra_state_constructor
2. ompi_register_datarep_f
3. read_intercept_fn
4. write_intercept_fn
5. extent_intercept_fn

   1 /*
   2  * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
   3  *                         University Research and Technology
   4  *                         Corporation.  All rights reserved.
   5  * Copyright (c) 2004-2005 The University of Tennessee and The University
   6  *                         of Tennessee Research Foundation.  All rights
   7  *                         reserved.
   8  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
   9  *                         University of Stuttgart.  All rights reserved.
  10  * Copyright (c) 2004-2005 The Regents of the University of California.
  11  *                         All rights reserved.
  12  * Copyright (c) 2007-2012 Cisco Systems, Inc.  All rights reserved.
  13  * Copyright (c) 2015-2017 Research Organization for Information Science
  14  *                         and Technology (RIST). All rights reserved.
  15  * Copyright (c) 2017      IBM Corporation. All rights reserved.
  16  * $COPYRIGHT$
  17  *
  18  * Additional copyrights may follow
  19  *
  20  * $HEADER$
  21  */
  22 
  23 #include "ompi_config.h"
  24 
  25 #include "opal/class/opal_object.h"
  26 
  27 #include "ompi/mpi/fortran/mpif-h/bindings.h"
  28 #include "ompi/mpi/fortran/base/constants.h"
  29 #include "ompi/mpi/fortran/base/datarep.h"
  30 #include "ompi/mpi/fortran/base/fortran_base_strings.h"
  31 #include "ompi/mpi/fortran/base/fint_2_int.h"
  32 #include "ompi/runtime/mpiruntime.h"
  33 #include "ompi/file/file.h"
  34 
  35 #if OMPI_BUILD_MPI_PROFILING
  36 #if OPAL_HAVE_WEAK_SYMBOLS
  37 #pragma weak PMPI_REGISTER_DATAREP = ompi_register_datarep_f
  38 #pragma weak pmpi_register_datarep = ompi_register_datarep_f
  39 #pragma weak pmpi_register_datarep_ = ompi_register_datarep_f
  40 #pragma weak pmpi_register_datarep__ = ompi_register_datarep_f
  41 
  42 #pragma weak PMPI_Register_datarep_f = ompi_register_datarep_f
  43 #pragma weak PMPI_Register_datarep_f08 = ompi_register_datarep_f
  44 #else
  45 OMPI_GENERATE_F77_BINDINGS (PMPI_REGISTER_DATAREP,
  46                            pmpi_register_datarep,
  47                            pmpi_register_datarep_,
  48                            pmpi_register_datarep__,
  49                            pompi_register_datarep_f,
  50                            (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),
  51                            (datarep, read_conversion_fn, write_conversion_fn, dtype_file_extent_fn, extra_state, ierr, datarep_len) )
  52 #endif
  53 #endif
  54 
  55 #if OPAL_HAVE_WEAK_SYMBOLS
  56 #pragma weak MPI_REGISTER_DATAREP = ompi_register_datarep_f
  57 #pragma weak mpi_register_datarep = ompi_register_datarep_f
  58 #pragma weak mpi_register_datarep_ = ompi_register_datarep_f
  59 #pragma weak mpi_register_datarep__ = ompi_register_datarep_f
  60 
  61 #pragma weak MPI_Register_datarep_f = ompi_register_datarep_f
  62 #pragma weak MPI_Register_datarep_f08 = ompi_register_datarep_f
  63 #else
  64 #if ! OMPI_BUILD_MPI_PROFILING
  65 OMPI_GENERATE_F77_BINDINGS (MPI_REGISTER_DATAREP,
  66                            mpi_register_datarep,
  67                            mpi_register_datarep_,
  68                            mpi_register_datarep__,
  69                            ompi_register_datarep_f,
  70                            (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),
  71                            (datarep, read_conversion_fn, write_conversion_fn, dtype_file_extent_fn, extra_state, ierr, datarep_len) )
  72 #else
  73 #define ompi_register_datarep_f pompi_register_datarep_f
  74 #endif
  75 #endif
  76 
  77 static const char FUNC_NAME[] = "MPI_REGISTER_DATAREP";
  78 
  79 /* Intercept functions used below (see below for explanations in
  80    comments) */
  81 static int read_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
  82                              void *filebuf, MPI_Offset position,
  83                              void *extra_state);
  84 static int write_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
  85                              void *filebuf, MPI_Offset position,
  86                               void *extra_state);
  87 static int extent_intercept_fn(MPI_Datatype type_c, MPI_Aint *file_extent,
  88                                void *extra_state);
  89 
  90 /* Data structure passed to the intercepts (see below).  It is an OPAL
  91    list_item_t so that we can clean this memory up during
  92    MPI_FINALIZE.  */
  93 typedef struct intercept_extra_state {
  94     opal_list_item_t base;
  95     ompi_mpi2_fortran_datarep_conversion_fn_t *read_fn_f77;
  96     ompi_mpi2_fortran_datarep_conversion_fn_t *write_fn_f77;
  97     ompi_mpi2_fortran_datarep_extent_fn_t *extent_fn_f77;
  98     MPI_Aint *extra_state_f77;
  99 } ompi_intercept_extra_state_t;
 100 
 101 OBJ_CLASS_DECLARATION(ompi_intercept_extra_state_t);
 102 
 103 #if !OMPI_BUILD_MPI_PROFILING || OPAL_HAVE_WEAK_SYMBOLS
 104 static void intercept_extra_state_constructor(ompi_intercept_extra_state_t *obj)
 105 {
 106     obj->read_fn_f77 = NULL;
 107     obj->write_fn_f77 = NULL;
 108     obj->extent_fn_f77 = NULL;
 109     obj->extra_state_f77 = NULL;
 110 }
 111 
 112 OBJ_CLASS_INSTANCE(ompi_intercept_extra_state_t,
 113                    opal_list_item_t,
 114                    intercept_extra_state_constructor, NULL);
 115 #endif  /* !OMPI_BUILD_MPI_PROFILING */
 116 
 117 /*
 118  * This function works by calling the C version of
 119  * MPI_Register_datarep (like most other MPI API functions).  To do
 120  * that, however, we need to call the C MPI_Register_datarep with *C*
 121  * callback functions -- the callback functions passed in to this
 122  * function are Fortran functions, and expect Fortran argument passing
 123  * conventions.
 124  *
 125  * So we have 3 C intercept functions that are passed to the back-end
 126  * MPI_Register_datarep.  Hence, when/if this datarep is ever used,
 127  * the intercept function(s) are invoked, who then translate the
 128  * arguments to Fortran and then invoke the registered callback
 129  * function.
 130  */
 131 void ompi_register_datarep_f(char *datarep,
 132                             ompi_mpi2_fortran_datarep_conversion_fn_t *read_fn_f77,
 133                             ompi_mpi2_fortran_datarep_conversion_fn_t *write_fn_f77,
 134                             ompi_mpi2_fortran_datarep_extent_fn_t *extent_fn_f77,
 135                             MPI_Aint *extra_state_f77,
 136                             MPI_Fint *ierr, int datarep_len)
 137 {
 138     char *c_datarep;
 139     int c_ierr, ret;
 140     MPI_Datarep_conversion_function *read_fn_c, *write_fn_c;
 141     ompi_intercept_extra_state_t *intercept;
 142 
 143     /* Malloc space for the intercept callback data */
 144     intercept = OBJ_NEW(ompi_intercept_extra_state_t);
 145     if (NULL == intercept) {
 146         c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL,
 147                                         OMPI_ERR_OUT_OF_RESOURCE, FUNC_NAME);
 148         if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 149         return;
 150     }
 151     /* Save the new object on a global list because per MPI-2:9.5.3,
 152        there are no ways for the user to deregister datareps once
 153        they've been created.  Hece, this is a memory leak.  So we
 154        track these extra resources in a global list so that they can
 155        be freed during MPI_FINALIZE (so that memory-tracking debuggers
 156        won't show MPI as leaking memory). */
 157     opal_list_append(&ompi_registered_datareps, &(intercept->base));
 158 
 159     /* Convert the fortran string */
 160     if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
 161                                                        &c_datarep))) {
 162         c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, ret, FUNC_NAME);
 163         if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 164         return;
 165     }
 166 
 167     /* Convert the Fortran function callbacks to C equivalents.  Use
 168        local intercepts if they're not MPI_CONVERSION_FN_NULL so that
 169        we can just call the C MPI API PMPI_Register_datarep().  If they
 170        *are* MPI_CONVERSION_FN_NULL, then just pass that to
 171        PMPI_Register_datarep so that it becomes a no-op (i.e., no
 172        callback is ever triggered). */
 173     if (OMPI_IS_FORTRAN_CONVERSION_FN_NULL(read_fn_f77)) {
 174         /* Can't use the MPI_CONVERSION_FN_NULL macro here because it
 175            is specifically not defined when compiling this file so
 176            that we can prototype an all-caps Fortran function */
 177         read_fn_c = (MPI_Datarep_conversion_function*) 0;
 178     } else {
 179         intercept->read_fn_f77 = read_fn_f77;
 180         read_fn_c = read_intercept_fn;
 181     }
 182     if (OMPI_IS_FORTRAN_CONVERSION_FN_NULL(write_fn_f77)) {
 183         /* Can't use the MPI_CONVERSION_FN_NULL macro here because it
 184            is specifically not defined when compiling this file so
 185            that we can prototype an all-caps Fortran function */
 186         write_fn_c = (MPI_Datarep_conversion_function*) 0;
 187     } else {
 188         intercept->write_fn_f77 = write_fn_f77;
 189         write_fn_c = write_intercept_fn;
 190     }
 191     intercept->extent_fn_f77 = extent_fn_f77;
 192     intercept->extra_state_f77 = extra_state_f77;
 193 
 194     /* Now that the intercept data has been setup, call the C function
 195        with the setup intercept routines and the intercept-specific
 196        data/extra state. */
 197     c_ierr = PMPI_Register_datarep(c_datarep,
 198                                   read_fn_c, write_fn_c,
 199                                   extent_intercept_fn,
 200                                   intercept);
 201     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 202     free(c_datarep);
 203 }
 204 
 205 /*
 206  * C->Fortran intercept for the read conversion.
 207  */
 208 static int read_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
 209                              void *filebuf, MPI_Offset position,
 210                              void *extra_state)
 211 {
 212     MPI_Fint ierr, count_f77 = OMPI_FINT_2_INT(count_c);
 213     MPI_Fint type_f77 = PMPI_Type_c2f(type_c);
 214     ompi_intercept_extra_state_t *intercept_data =
 215         (ompi_intercept_extra_state_t*) extra_state;
 216 
 217     intercept_data->read_fn_f77((char *) userbuf, &type_f77, &count_f77, (char *) filebuf,
 218                                 &position, intercept_data->extra_state_f77,
 219                                 &ierr);
 220     return OMPI_FINT_2_INT(ierr);
 221 }
 222 
 223 /*
 224  * C->Fortran intercept for the write conversion.
 225  */
 226 static int write_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
 227                              void *filebuf, MPI_Offset position,
 228                              void *extra_state)
 229 {
 230     MPI_Fint ierr, count_f77 = OMPI_FINT_2_INT(count_c);
 231     MPI_Fint type_f77 = PMPI_Type_c2f(type_c);
 232     ompi_intercept_extra_state_t *intercept_data =
 233         (ompi_intercept_extra_state_t*) extra_state;
 234 
 235     intercept_data->write_fn_f77((char *) userbuf, &type_f77, &count_f77, (char *) filebuf,
 236                                  &position, intercept_data->extra_state_f77,
 237                                  &ierr);
 238     return OMPI_FINT_2_INT(ierr);
 239 }
 240 
 241 /*
 242  * C->Fortran intercept for the extent calculation.
 243  */
 244 static int extent_intercept_fn(MPI_Datatype type_c, MPI_Aint *file_extent_f77,
 245                                void *extra_state)
 246 {
 247     MPI_Fint ierr, type_f77 = PMPI_Type_c2f(type_c);
 248     ompi_intercept_extra_state_t *intercept_data =
 249         (ompi_intercept_extra_state_t*) extra_state;
 250 
 251     intercept_data->extent_fn_f77(&type_f77, file_extent_f77,
 252                                  intercept_data->extra_state_f77, &ierr);
 253     return OMPI_FINT_2_INT(ierr);
 254 }
 255