ports/openmpi
ports/openmpi
1
1
Форкнуть 0
Код Релизы Активность

A bunch of fixes for Fortran string issues. In general, ensure to

Просмотр исходного кода 
convert between fortran and C string representations properly.  In
doing so, we properly adhere to the MPI spec stating that MPI_Info
keys and values must be whitespace-trimmed when coming in from
Fortran.  Hence, this fixes bug #241.

This commit was SVN r11356.
Этот коммит содержится в:
Jeff Squyres 2006-08-23 13:10:44 +00:00
родитель a7e1135151
Коммит 523128100e
9 изменённых файлов: 274 добавлений и 113 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

2
ompi/mpi/f77/add_error_string_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -76,4 +77,5 @@ void mpi_add_error_string_f(MPI_Fint *errorcode, char *string,
ompi_fortran_string_f2c(string, len, &c_string);
*ierr = OMPI_INT_2_FINT(MPI_Add_error_string(OMPI_FINT_2_INT(*errorcode),
c_string));
free(c_string);
}

48
ompi/mpi/f77/error_string_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/mpi/f77/strings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_ERROR_STRING = mpi_error_string_f
@ -27,12 +31,12 @@
#pragma weak pmpi_error_string__ = mpi_error_string_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_ERROR_STRING,
pmpi_error_string,
pmpi_error_string_,
pmpi_error_string__,
pmpi_error_string_f,
(MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr),
(errorcode, string, resultlen, ierr) )
pmpi_error_string,
pmpi_error_string_,
pmpi_error_string__,
pmpi_error_string_f,
(MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len),
(errorcode, string, resultlen, ierr, string_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_ERROR_STRING,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_ERROR_STRING,
mpi_error_string,
mpi_error_string_,
mpi_error_string__,
mpi_error_string_f,
(MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr),
(errorcode, string, resultlen, ierr) )
mpi_error_string,
mpi_error_string_,
mpi_error_string__,
mpi_error_string_f,
(MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len),
(errorcode, string, resultlen, ierr, string_len) )
#endif
@ -57,17 +61,33 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ERROR_STRING,
#include "ompi/mpi/f77/profile/defines.h"
#endif
static const char FUNC_NAME[] = "MPI_ERROR_STRING";
/* Note that the string_len parameter is silently added by the Fortran
compiler, and will be filled in with the actual length of the
character array from the caller. Hence, it's the max length of the
string that we can use. */
void mpi_error_string_f(MPI_Fint *errorcode, char *string,
MPI_Fint *resultlen, MPI_Fint *ierr)
MPI_Fint *resultlen, MPI_Fint *ierr, int string_len)
{
int c_err, ret;
char c_string[MPI_MAX_ERROR_STRING + 1];
OMPI_SINGLE_NAME_DECL(resultlen);
*ierr =
OMPI_INT_2_FINT(MPI_Error_string(OMPI_FINT_2_INT(*errorcode),
string,
c_string,
OMPI_SINGLE_NAME_CONVERT(resultlen)
));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(resultlen);
string_len = (string_len < MPI_MAX_ERROR_STRING) ?
string_len : MPI_MAX_ERROR_STRING;
if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_string, string,
string_len))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
}
}
}

51
ompi/mpi/f77/get_processor_name_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_GET_PROCESSOR_NAME = mpi_get_processor_name_f
@ -27,12 +31,12 @@
#pragma weak pmpi_get_processor_name__ = mpi_get_processor_name_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_GET_PROCESSOR_NAME,
pmpi_get_processor_name,
pmpi_get_processor_name_,
pmpi_get_processor_name__,
pmpi_get_processor_name_f,
(char *name, MPI_Fint *resultlen, MPI_Fint *ierr),
(name, resultlen, ierr) )
pmpi_get_processor_name,
pmpi_get_processor_name_,
pmpi_get_processor_name__,
pmpi_get_processor_name_f,
(char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len),
(name, resultlen, ierr, name_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_GET_PROCESSOR_NAME,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_GET_PROCESSOR_NAME,
mpi_get_processor_name,
mpi_get_processor_name_,
mpi_get_processor_name__,
mpi_get_processor_name_f,
(char *name, MPI_Fint *resultlen, MPI_Fint *ierr),
(name, resultlen, ierr) )
mpi_get_processor_name,
mpi_get_processor_name_,
mpi_get_processor_name__,
mpi_get_processor_name_f,
(char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len),
(name, resultlen, ierr, name_len) )
#endif
@ -57,13 +61,32 @@ OMPI_GENERATE_F77_BINDINGS (MPI_GET_PROCESSOR_NAME,
#include "ompi/mpi/f77/profile/defines.h"
#endif
void mpi_get_processor_name_f(char *name, MPI_Fint *resultlen, MPI_Fint *ierr)
static const char FUNC_NAME[] = "MPI_GET_PROCESSOR_NAME";
/* Note that the name_len parameter is silently added by the Fortran
compiler, and will be filled in with the actual length of the
character array from the caller. Hence, it's the max length of the
string that we can use. */
void mpi_get_processor_name_f(char *name, MPI_Fint *resultlen, MPI_Fint *ierr,
int name_len)
{
int c_err, ret;
char c_name[MPI_MAX_PROCESSOR_NAME + 1];
OMPI_SINGLE_NAME_DECL(resultlen);
*ierr = OMPI_INT_2_FINT(MPI_Get_processor_name(name,
*ierr = OMPI_INT_2_FINT(MPI_Get_processor_name(c_name,
OMPI_SINGLE_NAME_CONVERT(resultlen)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(resultlen);
name_len = (name_len < OMPI_FINT_2_INT(*resultlen)) ?
name_len : OMPI_FINT_2_INT(*resultlen);
if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_name, name,
name_len))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
}
}

51
ompi/mpi/f77/info_delete_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_INFO_DELETE = mpi_info_delete_f
@ -27,12 +31,12 @@
#pragma weak pmpi_info_delete__ = mpi_info_delete_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_DELETE,
pmpi_info_delete,
pmpi_info_delete_,
pmpi_info_delete__,
pmpi_info_delete_f,
(MPI_Fint *info, char *key, MPI_Fint *ierr),
(info, key, ierr) )
pmpi_info_delete,
pmpi_info_delete_,
pmpi_info_delete__,
pmpi_info_delete_f,
(MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len),
(info, key, ierr, key_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_DELETE,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_INFO_DELETE,
mpi_info_delete,
mpi_info_delete_,
mpi_info_delete__,
mpi_info_delete_f,
(MPI_Fint *info, char *key, MPI_Fint *ierr),
(info, key, ierr) )
mpi_info_delete,
mpi_info_delete_,
mpi_info_delete__,
mpi_info_delete_f,
(MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len),
(info, key, ierr, key_len) )
#endif
@ -57,11 +61,26 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_DELETE,
#include "ompi/mpi/f77/profile/defines.h"
#endif
void mpi_info_delete_f(MPI_Fint *info, char *key, MPI_Fint *ierr)
{
MPI_Info c_info;
static const char FUNC_NAME[] = "MPI_INFO_DELETE";
/* Note that the key_len parameter is silently added by the Fortran
compiler, and will be filled in with the actual length of the
character array from the caller. Hence, it's the max length of the
string that we can use. */
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, key));
*ierr = OMPI_INT_2_FINT(MPI_Info_delete(c_info, c_key));
free(c_key);
}

61
ompi/mpi/f77/info_get_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_INFO_GET = mpi_info_get_f
@ -27,12 +31,12 @@
#pragma weak pmpi_info_get__ = mpi_info_get_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET,
pmpi_info_get,
pmpi_info_get_,
pmpi_info_get__,
pmpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, value, flag, ierr) )
pmpi_info_get,
pmpi_info_get_,
pmpi_info_get__,
pmpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len),
(info, key, valuelen, value, flag, ierr, key_len, value_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET,
mpi_info_get,
mpi_info_get_,
mpi_info_get__,
mpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, value, flag, ierr) )
mpi_info_get,
mpi_info_get_,
mpi_info_get__,
mpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len),
(info, key, valuelen, value, flag, ierr, key_len, value_len) )
#endif
@ -57,19 +61,46 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET,
#include "ompi/mpi/f77/profile/defines.h"
#endif
static const char FUNC_NAME[] = "MPI_INFO_GET";
/* Note that the key_len and value_len parameters are silently added
by the Fortran compiler, and will be filled in with the actual
length of the character array from the caller. Hence, it's the max
length of the string that we can use. */
void mpi_info_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen,
char *value, MPI_Flogical *flag, MPI_Fint *ierr)
char *value, MPI_Flogical *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, key,
*ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, c_key,
OMPI_FINT_2_INT(*valuelen),
value,
c_value,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_LOGICAL(flag);
value_len = (value_len < OMPI_FINT_2_INT(*valuelen)) ?
value_len : OMPI_FINT_2_INT(*valuelen);
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);
}

53
ompi/mpi/f77/info_get_nthkey_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_INFO_GET_NTHKEY = mpi_info_get_nthkey_f
@ -27,12 +31,12 @@
#pragma weak pmpi_info_get_nthkey__ = mpi_info_get_nthkey_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_NTHKEY,
pmpi_info_get_nthkey,
pmpi_info_get_nthkey_,
pmpi_info_get_nthkey__,
pmpi_info_get_nthkey_f,
(MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr),
(info, n, key, ierr) )
pmpi_info_get_nthkey,
pmpi_info_get_nthkey_,
pmpi_info_get_nthkey__,
pmpi_info_get_nthkey_f,
(MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len),
(info, n, key, ierr, key_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_NTHKEY,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_NTHKEY,
mpi_info_get_nthkey,
mpi_info_get_nthkey_,
mpi_info_get_nthkey__,
mpi_info_get_nthkey_f,
(MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr),
(info, n, key, ierr) )
mpi_info_get_nthkey,
mpi_info_get_nthkey_,
mpi_info_get_nthkey__,
mpi_info_get_nthkey_f,
(MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len),
(info, n, key, ierr, key_len) )
#endif
@ -57,14 +61,29 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_NTHKEY,
#include "ompi/mpi/f77/profile/defines.h"
#endif
void mpi_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, char *key,
MPI_Fint *ierr)
{
MPI_Info c_info;
static const char FUNC_NAME[] = "MPI_INFO_GET_NTHKEY";
/* Note that the key_len parameter is silently added by the Fortran
compiler, and will be filled in with the actual length of the
character array from the caller. Hence, it's the max length of the
string that we can use. */
void mpi_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, 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_get_nthkey(c_info,
OMPI_FINT_2_INT(*n),
key));
c_key));
free(c_key);
}

48
ompi/mpi/f77/info_get_valuelen_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_INFO_GET_VALUELEN = mpi_info_get_valuelen_f
@ -27,12 +31,12 @@
#pragma weak pmpi_info_get_valuelen__ = mpi_info_get_valuelen_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_VALUELEN,
pmpi_info_get_valuelen,
pmpi_info_get_valuelen_,
pmpi_info_get_valuelen__,
pmpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, flag, ierr) )
pmpi_info_get_valuelen,
pmpi_info_get_valuelen_,
pmpi_info_get_valuelen__,
pmpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len),
(info, key, valuelen, flag, ierr, key_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_VALUELEN,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN,
mpi_info_get_valuelen,
mpi_info_get_valuelen_,
mpi_info_get_valuelen__,
mpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, flag, ierr) )
mpi_info_get_valuelen,
mpi_info_get_valuelen_,
mpi_info_get_valuelen__,
mpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len),
(info, key, valuelen, flag, ierr, key_len) )
#endif
@ -57,20 +61,36 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN,
#include "ompi/mpi/f77/profile/defines.h"
#endif
static const char FUNC_NAME[] = "MPI_INFO_GET_VALUELEN";
/* Note that the key_len parameter is silently added by the Fortran
compiler, and will be filled in with the actual length of the
character array from the caller. Hence, it's the max length of the
string that we can use. */
void mpi_info_get_valuelen_f(MPI_Fint *info, char *key,
MPI_Fint *valuelen, MPI_Flogical *flag,
MPI_Fint *ierr)
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, key,
*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);
}

59
ompi/mpi/f77/info_set_f.c
Просмотреть файл

@ -9,6 +9,7 @@
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
@ -19,6 +20,9 @@
#include "ompi_config.h"
#include "ompi/mpi/f77/bindings.h"
#include "ompi/constants.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mpi/f77/strings.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_INFO_SET = mpi_info_set_f
@ -27,12 +31,12 @@
#pragma weak pmpi_info_set__ = mpi_info_set_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_SET,
pmpi_info_set,
pmpi_info_set_,
pmpi_info_set__,
pmpi_info_set_f,
(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr),
(info, key, value, ierr) )
pmpi_info_set,
pmpi_info_set_,
pmpi_info_set__,
pmpi_info_set_f,
(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len),
(info, key, value, ierr, key_len, value_len) )
#endif
#if OMPI_HAVE_WEAK_SYMBOLS
@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_SET,
#if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_INFO_SET,
mpi_info_set,
mpi_info_set_,
mpi_info_set__,
mpi_info_set_f,
(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr),
(info, key, value, ierr) )
mpi_info_set,
mpi_info_set_,
mpi_info_set__,
mpi_info_set_f,
(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len),
(info, key, value, ierr, key_len, value_len) )
#endif
@ -57,11 +61,34 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_SET,
#include "ompi/mpi/f77/profile/defines.h"
#endif
void mpi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr)
{
MPI_Info c_info;
static const char FUNC_NAME[] = "MPI_INFO_SET";
/* Note that the key_len and value_len parameters are silently added
by the Fortran compiler, and will be filled in with the actual
length of the character array from the caller. Hence, it's the max
length of the string that we can use. */
void mpi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr,
int key_len, int value_len)
{
int ret, c_err;
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_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
*ierr = OMPI_INT_2_FINT(c_err);
if (NULL != c_key) {
free(c_key);
}
return;
}
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_set(c_info, key, value));
*ierr = OMPI_INT_2_FINT(MPI_Info_set(c_info, c_key, c_value));
free(c_key);
free(c_value);
}

14
ompi/mpi/f77/prototypes_mpi.h
Просмотреть файл

@ -122,7 +122,7 @@ PN(void, mpi_errhandler_free, MPI_ERRHANDLER_FREE, (MPI_Fint *errhandler, MPI_Fi
PN(void, mpi_errhandler_get, MPI_ERRHANDLER_GET, (MPI_Fint *comm, MPI_Fint *errhandler, MPI_Fint *ierr));
PN(void, mpi_errhandler_set, MPI_ERRHANDLER_SET, (MPI_Fint *comm, MPI_Fint *errhandler, MPI_Fint *ierr));
PN(void, mpi_error_class, MPI_ERROR_CLASS, (MPI_Fint *errorcode, MPI_Fint *errorclass, MPI_Fint *ierr));
PN(void, mpi_error_string, MPI_ERROR_STRING, (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr));
PN(void, mpi_error_string, MPI_ERROR_STRING, (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len));
PN(void, mpi_exscan, MPI_EXSCAN, (char *sendbuf, char *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr));
PN(void, mpi_file_call_errhandler, MPI_FILE_CALL_ERRHANDLER, (MPI_Fint *fh, MPI_Fint *errorcode, MPI_Fint *ierr));
PN(void, mpi_file_create_errhandler, MPI_FILE_CREATE_ERRHANDLER, (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr));
@ -188,7 +188,7 @@ PN(void, mpi_get_address, MPI_GET_ADDRESS, (char *location, MPI_Aint *address, M
PN(void, mpi_get_count, MPI_GET_COUNT, (MPI_Fint *status, MPI_Fint *datatype, MPI_Fint *count, MPI_Fint *ierr));
PN(void, mpi_get_elements, MPI_GET_ELEMENTS, (MPI_Fint *status, MPI_Fint *datatype, MPI_Fint *count, MPI_Fint *ierr));
PN(void, mpi_get, MPI_GET, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Fint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *ierr));
PN(void, mpi_get_processor_name, MPI_GET_PROCESSOR_NAME, (char *name, MPI_Fint *resultlen, MPI_Fint *ierr));
PN(void, mpi_get_processor_name, MPI_GET_PROCESSOR_NAME, (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len));
PN(void, mpi_get_version, MPI_GET_VERSION, (MPI_Fint *version, MPI_Fint *subversion, MPI_Fint *ierr));
PN(void, mpi_graph_create, MPI_GRAPH_CREATE, (MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Flogical *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr));
PN(void, mpi_graph_get, MPI_GRAPH_GET, (MPI_Fint *comm, MPI_Fint *maxindex, MPI_Fint *maxedges, MPI_Fint *index, MPI_Fint *edges, MPI_Fint *ierr));
@ -212,14 +212,14 @@ PN(void, mpi_group_translate_ranks, MPI_GROUP_TRANSLATE_RANKS, (MPI_Fint *group1
PN(void, mpi_group_union, MPI_GROUP_UNION, (MPI_Fint *group1, MPI_Fint *group2, MPI_Fint *newgroup, MPI_Fint *ierr));
PN(void, mpi_ibsend, MPI_IBSEND, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr));
PN(void, mpi_info_create, MPI_INFO_CREATE, (MPI_Fint *info, MPI_Fint *ierr));
PN(void, mpi_info_delete, MPI_INFO_DELETE, (MPI_Fint *info, char *key, MPI_Fint *ierr));
PN(void, mpi_info_delete, MPI_INFO_DELETE, (MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len));
PN(void, mpi_info_dup, MPI_INFO_DUP, (MPI_Fint *info, MPI_Fint *newinfo, MPI_Fint *ierr));
PN(void, mpi_info_free, MPI_INFO_FREE, (MPI_Fint *info, MPI_Fint *ierr));
PN(void, mpi_info_get, MPI_INFO_GET, (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr));
PN(void, mpi_info_get, MPI_INFO_GET, (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len));
PN(void, mpi_info_get_nkeys, MPI_INFO_GET_NKEYS, (MPI_Fint *info, MPI_Fint *nkeys, MPI_Fint *ierr));
PN(void, mpi_info_get_nthkey, MPI_INFO_GET_NTHKEY, (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr));
PN(void, mpi_info_get_valuelen, MPI_INFO_GET_VALUELEN, (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr));
PN(void, mpi_info_set, MPI_INFO_SET, (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr));
PN(void, mpi_info_get_nthkey, MPI_INFO_GET_NTHKEY, (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len));
PN(void, mpi_info_get_valuelen, MPI_INFO_GET_VALUELEN, (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len));
PN(void, mpi_info_set, MPI_INFO_SET, (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len));
PN(void, mpi_init, MPI_INIT, (MPI_Fint *ierr));
PN(void, mpi_initialized, MPI_INITIALIZED, (MPI_Flogical *flag, MPI_Fint *ierr));
PN(void, mpi_init_thread, MPI_INIT_THREAD, (MPI_Fint *required, MPI_Fint *provided, MPI_Fint *ierr));