void ompi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr,
int key_len, int value_len)
{
int ret, c_ierr;
MPI_Info c_info;
char *c_key = NULL, *c_value = NULL;
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key)) ||
OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(value, value_len,
&c_value))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (NULL != c_key) {
free(c_key);
}
return;
}
c_info = MPI_Info_f2c(*info);
c_ierr = MPI_Info_set(c_info, c_key, c_value);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free(c_key);
free(c_value);
}
void ompi_file_set_view_f(MPI_Fint *fh, MPI_Offset *disp,
MPI_Fint *etype, MPI_Fint *filetype,
char *datarep, MPI_Fint *info, MPI_Fint *ierr,
int datarep_len)
{
MPI_File c_fh = PMPI_File_f2c(*fh);
MPI_Datatype c_etype = PMPI_Type_f2c(*etype);
MPI_Datatype c_filetype = PMPI_Type_f2c(*filetype);
MPI_Info c_info = PMPI_Info_f2c(*info);
char *c_datarep;
int c_ierr, ret;
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
&c_datarep))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(c_fh, ret, "MPI_FILE_SET_VIEW");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_ierr = PMPI_File_set_view(c_fh, (MPI_Offset) *disp,
c_etype, c_filetype,
c_datarep, c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free(c_datarep);
}
/*
* creates a C argument vector from an F77 array of strings
* (terminated by a blank string)
*/
int ompi_fortran_argv_f2c(char *array, int len, char ***argv)
{
int err, argc = 0;
char *cstr;
/* Fortran lines up strings in memory, each delimited by \0. So
just convert them until we hit an extra \0. */
*argv = NULL;
while (1) {
if (OMPI_SUCCESS != (err = ompi_fortran_string_f2c(array, len,
&cstr))) {
opal_argv_free(*argv);
return err;
}
if ('\0' == *cstr) {
break;
}
if (OMPI_SUCCESS != (err = opal_argv_append(&argc, argv, cstr))) {
opal_argv_free(*argv);
return err;
}
free(cstr);
array += len;
}
return OMPI_SUCCESS;
}
void ompi_win_set_name_f(MPI_Fint *win, char *win_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_ierr;
char *c_name;
MPI_Win c_win;
c_win = PMPI_Win_f2c(*win);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(win_name, name_len,
&c_name))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_WIN_SET_NAME");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
/* Call the C function */
c_ierr = PMPI_Win_set_name(c_win, c_name);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
/* Free the C name */
free(c_name);
}
/*
* Creates a C argument vector from an F77 array of array_len strings.
*
* This function is quite similar to ompi_fortran_argv_blank_f2c(),
* except that the length of the array is a parameter (vs. looking for
* a blank line to end the array).
*
* This function is used to convert "array_of_commands" in
* MPI_COMM_SPAWN_MULTIPLE (which is not precisely defined, but is
* assumed to be of length "count", and *not* terminated by a blank
* line).
*/
int ompi_fortran_argv_count_f2c(char *array, int array_len, int string_len, int advance,
char ***argv)
{
int err, argc = 0;
char *cstr;
/* Fortran lines up strings in memory, each delimited by \0. So
just convert them until we hit an extra \0. */
*argv = NULL;
for (int i = 0; i < array_len; ++i) {
if (OMPI_SUCCESS != (err = ompi_fortran_string_f2c(array, string_len,
&cstr))) {
opal_argv_free(*argv);
return err;
}
if (OMPI_SUCCESS != (err = opal_argv_append(&argc, argv, cstr))) {
opal_argv_free(*argv);
free(cstr);
return err;
}
free(cstr);
array += advance;
}
return OMPI_SUCCESS;
}
void mpi_publish_name_f(char *service_name, MPI_Fint *info,
char *port_name, MPI_Fint *ierr, int service_name_len, int port_name_len)
{
MPI_Info c_info;
char *c_service_name;
char *c_port_name;
c_info = MPI_Info_f2c(*info);
ompi_fortran_string_f2c(service_name, service_name_len, &c_service_name);
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
*ierr = OMPI_INT_2_FINT(MPI_Publish_name(c_service_name, c_info,
c_port_name));
free ( c_service_name);
free ( c_port_name);
}
void mpi_info_get_valuelen_f(MPI_Fint *info, char *key,
MPI_Fint *valuelen, MPI_Flogical *flag,
MPI_Fint *ierr, int key_len)
{
int c_err, ret;
MPI_Info c_info;
char *c_key;
OMPI_SINGLE_NAME_DECL(valuelen);
OMPI_LOGICAL_NAME_DECL(flag);
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_get_valuelen(c_info, c_key,
OMPI_SINGLE_NAME_CONVERT(valuelen),
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(valuelen);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
free(c_key);
}
void mpi_type_set_name_f(MPI_Fint *type, char *type_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_err;
char *c_name;
MPI_Datatype c_type;
c_type = MPI_Type_f2c(*type);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(type_name, name_len,
&c_name))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_TYPE_SET_NAME");
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
/* Call the C function */
*ierr = OMPI_INT_2_FINT(MPI_Type_set_name(c_type, c_name));
/* Free the C name */
free(c_name);
}
void mpi_close_port_f(char *port_name, MPI_Fint *ierr, int port_name_len)
{
char *c_port_name;
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
*ierr = OMPI_INT_2_FINT(MPI_Close_port(c_port_name));
free ( c_port_name);
}
void ompi_comm_spawn_f(char *command, char *argv, MPI_Fint *maxprocs,
MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm,
MPI_Fint *intercomm, MPI_Fint *array_of_errcodes,
MPI_Fint *ierr, int cmd_len, int string_len)
{
MPI_Comm c_comm, c_new_comm;
MPI_Info c_info;
int size, c_ierr;
int *c_errs;
char **c_argv;
char *c_command;
OMPI_ARRAY_NAME_DECL(array_of_errcodes);
c_comm = PMPI_Comm_f2c(*comm);
c_info = PMPI_Info_f2c(*info);
PMPI_Comm_size(c_comm, &size);
ompi_fortran_string_f2c(command, cmd_len, &c_command);
/* It's allowed to ignore the errcodes */
if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
c_errs = MPI_ERRCODES_IGNORE;
} else {
OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_errcodes, size);
c_errs = OMPI_ARRAY_NAME_CONVERT(array_of_errcodes);
}
/* It's allowed to have no argv */
if (OMPI_IS_FORTRAN_ARGV_NULL(argv)) {
c_argv = MPI_ARGV_NULL;
} else {
ompi_fortran_argv_blank_f2c(argv, string_len, string_len, &c_argv);
}
c_ierr = PMPI_Comm_spawn(c_command, c_argv,
OMPI_FINT_2_INT(*maxprocs),
c_info,
OMPI_FINT_2_INT(*root),
c_comm, &c_new_comm, c_errs);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*intercomm = PMPI_Comm_c2f(c_new_comm);
}
free(c_command);
if (MPI_ARGV_NULL != c_argv && NULL != c_argv) {
opal_argv_free(c_argv);
}
if (!OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
OMPI_ARRAY_INT_2_FINT(array_of_errcodes, size);
} else {
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_errcodes);
}
}
void ompi_close_port_f(char *port_name, MPI_Fint *ierr, int port_name_len)
{
int c_ierr;
char *c_port_name;
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
c_ierr = MPI_Close_port(c_port_name);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free ( c_port_name);
}
void ompi_unpublish_name_f(char *service_name, MPI_Fint *info,
char *port_name, MPI_Fint *ierr,
int service_name_len, int port_name_len)
{
int c_ierr;
MPI_Info c_info;
char *c_service_name;
char *c_port_name;
c_info = MPI_Info_f2c(*info);
ompi_fortran_string_f2c(service_name, service_name_len, &c_service_name);
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
c_ierr = MPI_Unpublish_name(c_service_name, c_info, c_port_name);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free ( c_service_name);
free ( c_port_name);
}
void mpi_info_delete_f(MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len)
{
int c_err, ret;
MPI_Info c_info;
char *c_key;
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_delete(c_info, c_key));
free(c_key);
}
void mpi_comm_accept_f(char *port_name, MPI_Fint *info, MPI_Fint *root,
MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *ierr,
int port_name_len)
{
MPI_Comm c_comm, c_new_comm;
MPI_Info c_info;
char *c_port_name;
c_comm = MPI_Comm_f2c(*comm);
c_info = MPI_Info_f2c(*info);
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
*ierr = OMPI_INT_2_FINT(MPI_Comm_accept(c_port_name, c_info,
OMPI_FINT_2_INT(*root),
c_comm, &c_new_comm));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*newcomm = MPI_Comm_c2f(c_new_comm);
}
free ( c_port_name );
}
void ompi_file_delete_f(char *filename, MPI_Fint *info, MPI_Fint *ierr, int filename_len)
{
MPI_Info c_info;
char *c_filename;
int c_ierr, ret;
c_info = PMPI_Info_f2c(*info);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(filename, filename_len,
&c_filename))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, ret, "MPI_FILE_DELETE");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_ierr = PMPI_File_delete(c_filename, c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free(c_filename);
}
void mpi_info_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen,
char *value, ompi_fortran_logical_t *flag, MPI_Fint *ierr,
int key_len, int value_len)
{
int c_err, ret;
MPI_Info c_info;
char *c_key = NULL, c_value[MPI_MAX_INFO_VAL + 1];
OMPI_LOGICAL_NAME_DECL(flag);
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, c_key,
OMPI_FINT_2_INT(*valuelen),
c_value,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_LOGICAL(flag);
/* If we found the info key, copy the value back to the
Fortran string (note: all Fortran compilers have FALSE ==
0, so just check for any nonzero value, because not all
Fortran compilers have TRUE == 1). Note: use the full
length of the Fortran string, not *valuelen. See comment
in ompi/mpi/fortran/base/strings.c. */
if (*flag && OMPI_SUCCESS !=
(ret = ompi_fortran_string_c2f(c_value, value, value_len))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
free(c_key);
return;
}
}
free(c_key);
}
void mpi_info_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen,
char *value, ompi_fortran_logical_t *flag, MPI_Fint *ierr,
int key_len, int value_len)
{
int c_err, ret;
MPI_Info c_info;
char *c_key = NULL, c_value[MPI_MAX_INFO_VAL + 1];
OMPI_LOGICAL_NAME_DECL(flag);
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, c_key,
OMPI_FINT_2_INT(*valuelen),
c_value,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_LOGICAL(flag);
/* Use the full length of the Fortran string, not *valuelen.
See comment in ompi/mpi/f77/strings.c. */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_value, value,
value_len))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
free(c_key);
return;
}
}
free(c_key);
}
/*
* 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 mpi_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_err, 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_err = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL,
OMPI_ERR_OUT_OF_RESOURCE, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
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_err = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
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 MPI_Register_datarep(). If they
*are* MPI_CONVERSION_FN_NULL, then just pass that to
MPI_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. */
*ierr = OMPI_INT_2_FINT(MPI_Register_datarep(c_datarep,
read_fn_c, write_fn_c,
extent_intercept_fn,
intercept));
free(c_datarep);
}
