int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler)
{
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
} else if (NULL == errhandler ||
MPI_ERRHANDLER_NULL == errhandler ||
( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type &&
OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
FUNC_NAME);
}
}
/* Ditch the old errhandler, and decrement its refcount */
OBJ_RELEASE(comm->error_handler);
/* We have a valid comm and errhandler, so increment its refcount */
comm->error_handler = errhandler;
OBJ_RETAIN(comm->error_handler);
/* All done */
return MPI_SUCCESS;
}
int MPI_Win_get_errhandler(MPI_Win win, MPI_Errhandler *errhandler)
{
MPI_Errhandler tmp;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN,
FUNC_NAME);
} else if (NULL == errhandler) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG,
FUNC_NAME);
}
}
/* On 64 bits environments we have to make sure the reading of the
error_handler became atomic. */
do {
tmp = win->error_handler;
} while (!OPAL_ATOMIC_CMPSET_PTR(&(win->error_handler), tmp, tmp));
/* Retain the errhandler, corresponding to object refcount
decrease in errhandler_free.c. */
OBJ_RETAIN(win->error_handler);
*errhandler = win->error_handler;
/* All done */
return MPI_SUCCESS;
}
int MPI_Comm_get_name(MPI_Comm comm, char *name, int *length)
{
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_comm_invalid ( comm ) )
return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
if ( NULL == name || NULL == length )
return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG,
FUNC_NAME);
}
#ifdef USE_MUTEX_FOR_COMMS
OPAL_THREAD_LOCK(&(comm->c_lock));
#endif
if ( comm->c_flags & OMPI_COMM_NAMEISSET ) {
strncpy ( name, comm->c_name, MPI_MAX_OBJECT_NAME );
*length = strlen ( comm->c_name );
}
else {
memset ( name, 0, MPI_MAX_OBJECT_NAME );
*length = 0;
}
#ifdef USE_MUTEX_FOR_COMMS
OPAL_THREAD_UNLOCK(&(comm->c_lock));
#endif
return MPI_SUCCESS;
}
int MPI_Open_port(MPI_Info info, char *port_name)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( NULL == port_name ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
}
if ( MPI_INFO_NULL != info ) {
/* in theory, they user might tell us here
how to establish the address. Since our communication
is relying on OOB, we probably won't use the info-object.
Potential values defined in MPI-2:
- "ip_port" : value contains IP port number
- "ip_address" : value contains IP address
*/
}
OPAL_CR_ENTER_LIBRARY();
rc = ompi_dpm_open_port(port_name);
OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME);
}
int MPI_Publish_name(char *service_name, MPI_Info info,
char *port_name)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( NULL == port_name || 0 == strlen(port_name) ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if ( NULL == service_name || 0 == strlen(service_name) ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
}
/*
* No predefined info-objects for this function in MPI-2,
* therefore, we do not parse the info-object at the moment.
*/
rc = ompi_comm_namepublish (service_name, port_name);
if ( OMPI_SUCCESS != rc ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN,
FUNC_NAME);
}
return MPI_SUCCESS;
}
int MPI_Initialized(int *flag)
{
MPI_Comm null = NULL;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
if (NULL == flag) {
/* If we have an error, the action that we take depends on
whether we're currently (after MPI_Init and before
MPI_Finalize) or not */
if (ompi_mpi_initialized && !ompi_mpi_finalized) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
} else {
return OMPI_ERRHANDLER_INVOKE(null, MPI_ERR_ARG,
FUNC_NAME);
}
}
}
/* Pretty simple */
*flag = ompi_mpi_initialized;
return MPI_SUCCESS;
}
int MPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm,
int *size)
{
ompi_convertor_t local_convertor;
size_t length;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (MPI_COMM_NULL == comm) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
} else if (NULL == size) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
} else if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
OBJ_CONSTRUCT( &local_convertor, ompi_convertor_t );
/* the resulting convertor will be set to the position ZERO */
ompi_convertor_copy_and_prepare_for_send( ompi_mpi_local_convertor, datatype, incount, NULL, 0, &local_convertor );
ompi_convertor_get_packed_size( &local_convertor, &length );
*size = (int)length;
OBJ_DESTRUCT( &local_convertor );
return MPI_SUCCESS;
}
int MPI_Win_get_info(MPI_Win win, MPI_Info *info_used)
{
int ret;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
}
if (NULL == info_used) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
if (NULL == win->super.s_info) {
/*
* Setup any defaults if MPI_Win_set_info was never called
*/
opal_infosubscribe_change_info(win, &MPI_INFO_NULL->super);
}
(*info_used) = OBJ_NEW(ompi_info_t);
if (NULL == (*info_used)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_NO_MEM, FUNC_NAME);
}
ret = opal_info_dup(&win->super.s_info, &(*info_used)->super);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_File_get_info(MPI_File fh, MPI_Info *info_used)
{
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info_used) {
return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO, FUNC_NAME);
}
if (ompi_file_invalid(fh)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
}
if (NULL == fh->super.s_info) {
/*
* Setup any defaults if MPI_Win_set_info was never called
*/
opal_infosubscribe_change_info(fh, &MPI_INFO_NULL->super);
}
(*info_used) = OBJ_NEW(ompi_info_t);
if (NULL == (*info_used)) {
return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_NO_MEM, FUNC_NAME);
}
opal_info_dup(fh->super.s_info, &(*info_used)->super);
return OMPI_SUCCESS;
}
int MPI_Comm_get_info(MPI_Comm comm, MPI_Info *info_used)
{
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info_used) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
}
if (NULL == comm->super.s_info) {
/*
* Setup any defaults if MPI_Win_set_info was never called
*/
opal_infosubscribe_change_info(&comm->super, &MPI_INFO_NULL->super);
}
(*info_used) = OBJ_NEW(ompi_info_t);
if (NULL == (*info_used)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM,
FUNC_NAME);
}
opal_info_t *opal_info_used = &(*info_used)->super;
opal_info_dup_mpistandard(comm->super.s_info, &opal_info_used);
return MPI_SUCCESS;
}
int MPI_Comm_set_name(MPI_Comm comm, char *name)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_comm_invalid ( comm ) ) {
return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ( NULL == name ) {
return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG,
FUNC_NAME);
}
}
rc = ompi_comm_set_name (comm, name );
/* -- Tracing information for new communicator name -- */
#if 0
/* Force TotalView DLL to take note of this name setting */
++ompi_tv_comm_sequence_number;
#endif
#if OMPI_PROFILING_DEFINES
#include "ompi/mpi/c/profile/defines.h"
#endif
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler)
{
MPI_Errhandler tmp;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN,
FUNC_NAME);
} else if (NULL == errhandler ||
MPI_ERRHANDLER_NULL == errhandler ||
(OMPI_ERRHANDLER_TYPE_WIN != errhandler->eh_mpi_object_type &&
OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
/* Prepare the new error handler */
OBJ_RETAIN(errhandler);
/* Ditch the old errhandler, and decrement its refcount. On 64
bits environments we have to make sure the reading of the
error_handler became atomic. */
do {
tmp = win->error_handler;
} while (!OPAL_ATOMIC_CMPSET(&(win->error_handler), tmp, errhandler));
OBJ_RELEASE(tmp);
/* All done */
return MPI_SUCCESS;
}
int MPI_Win_get_name(MPI_Win win, char *win_name, int *resultlen)
{
int ret;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (NULL == win_name || NULL == resultlen) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Note that MPI-2.1 requires:
- terminating the string with a \0
- name[*resultlen] == '\0'
- and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1)
The Fortran API version will pad to the right if necessary.
Note that win->name is guaranteed to be \0-terminated and
able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e.,
name+\0). ompi_win_get_name() does the Right things. */
ret = ompi_win_get_name(win, win_name, resultlen);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler)
{
MPI_Errhandler tmp;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN,
FUNC_NAME);
} else if (NULL == errhandler ||
MPI_ERRHANDLER_NULL == errhandler ||
(OMPI_ERRHANDLER_TYPE_WIN != errhandler->eh_mpi_object_type &&
OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
/* Prepare the new error handler */
OBJ_RETAIN(errhandler);
OPAL_THREAD_LOCK(&win->w_lock);
/* Ditch the old errhandler, and decrement its refcount. */
tmp = win->error_handler;
win->error_handler = errhandler;
OBJ_RELEASE(tmp);
OPAL_THREAD_UNLOCK(&win->w_lock);
/* All done */
return MPI_SUCCESS;
}
int MPI_Type_hvector(int count,
int blocklength,
MPI_Aint stride,
MPI_Datatype oldtype,
MPI_Datatype *newtype)
{
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype ||
NULL == newtype) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_TYPE,
FUNC_NAME );
} else if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COUNT,
FUNC_NAME );
} else if (blocklength < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME );
}
}
return MPI_Type_create_hvector(count,
blocklength,
stride,
oldtype,
newtype);
}
int MPI_Keyval_create(MPI_Copy_function *copy_attr_fn,
MPI_Delete_function *delete_attr_fn,
int *keyval, void *extra_state)
{
int ret;
ompi_attribute_fn_ptr_union_t copy_fn;
ompi_attribute_fn_ptr_union_t del_fn;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == keyval) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_KEYVAL,
FUNC_NAME);
} else if ((NULL == copy_attr_fn) || (NULL == delete_attr_fn)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
copy_fn.attr_communicator_copy_fn = (MPI_Comm_internal_copy_attr_function*)copy_attr_fn;
del_fn.attr_communicator_delete_fn = delete_attr_fn;
ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn,
del_fn, keyval, extra_state, 0, NULL);
OMPI_ERRHANDLER_RETURN(ret, MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME);
}
/**
* Delete a (key,value) pair from "info"
*
* @param info MPI_Info handle on which we need to operate
* @param key The key portion of the (key,value) pair that
* needs to be deleted
*
* @retval MPI_SUCCESS If the (key,val) pair was deleted
* @retval MPI_ERR_INFO
* @retval MPI_ERR_INFO_KEYY
*/
int MPI_Info_delete(MPI_Info info, const char *key) {
int key_length;
int err;
/**
* This function merely deletes the (key,val) pair in info
*/
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
key_length = (key) ? (int)strlen (key) : 0;
if ((NULL == key) || (0 == key_length) ||
(MPI_MAX_INFO_KEY <= key_length)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
FUNC_NAME);
}
}
err = ompi_info_delete (info, key);
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME);
}
int MPI_File_get_errhandler( MPI_File file, MPI_Errhandler *errhandler)
{
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) explicitly
says that you are allowed to set the error handler on
MPI_FILE_NULL */
if (NULL == file) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_FILE,
"MPI_File_get_errhandler");
} else if (NULL == errhandler) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
"MPI_File_get_errhandler");
}
}
/* Retain the errhandler, corresponding to object refcount
decrease in errhandler_free.c. */
OBJ_RETAIN(file->error_handler);
*errhandler = file->error_handler;
/* All done */
return MPI_SUCCESS;
}
int MPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr)
{
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (size < 0 || NULL == baseptr) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
} else if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
}
/* Per these threads:
http://www.open-mpi.org/community/lists/devel/2007/07/1977.php
http://www.open-mpi.org/community/lists/devel/2007/07/1979.php
If you call MPI_ALLOC_MEM with a size of 0, you get NULL
back .*/
if (0 == size) {
*((void **) baseptr) = NULL;
return MPI_SUCCESS;
}
*((void **) baseptr) = mca_mpool_base_alloc((size_t) size, (struct opal_info_t*)info);
if (NULL == *((void **) baseptr)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM,
FUNC_NAME);
}
/* All done */
return MPI_SUCCESS;
}
int MPI_Op_commutative(MPI_Op op, int *commute)
{
OPAL_CR_NOOP_PROGRESS();
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == op || MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_OP,
FUNC_NAME);
}
if (NULL == commute) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
/* We have a valid op, get the flag */
*commute = ompi_op_is_commute(op);
/* All done */
return MPI_SUCCESS;
}
int MPI_Group_translate_ranks(MPI_Group group1, int n_ranks, int *ranks1,
MPI_Group group2, int *ranks2)
{
int err;
/* check for errors */
if( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) ||
(NULL == group1) || (NULL == group2)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
if (n_ranks < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
if (n_ranks > 0 && ((NULL == ranks1) || (NULL == ranks2 ))) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
}
if (0 == n_ranks) {
return MPI_SUCCESS;
}
OPAL_CR_ENTER_LIBRARY();
err = ompi_group_translate_ranks ( group1, n_ranks, ranks1,
group2, ranks2 );
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME );
}
int MPI_Get_version(int *version, int *subversion)
{
MPI_Comm null = NULL;
if (MPI_PARAM_CHECK) {
/* Per MPI-2:3.1, this function can be invoked before
MPI_INIT, so we don't invoke the normal
MPI_ERR_INIT_FINALIZE() macro here */
if (NULL == version || NULL == subversion) {
/* Note that we have to check and see if we have
previously called MPI_INIT or not. If so, use the
normal OMPI_ERRHANDLER_INVOKE, because the user may
have changed the default errhandler on MPI_COMM_WORLD.
If we have not invoked MPI_INIT, then just abort
(i.e., use a NULL communicator, which will end up at the
default errhandler, which is abort). */
if (ompi_mpi_initialized && !ompi_mpi_finalized) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
} else {
return OMPI_ERRHANDLER_INVOKE(null, MPI_ERR_ARG,
FUNC_NAME);
}
}
}
/* According to the MPI-2 specification */
*version = MPI_VERSION;
*subversion = MPI_SUBVERSION;
return MPI_SUCCESS;
}
int MPI_File_set_info(MPI_File fh, MPI_Info info)
{
int ret;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_file_invalid(fh)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_FILE, FUNC_NAME);
}
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = opal_infosubscribe_change_info(fh, &info->super);
OMPI_ERRHANDLER_RETURN(ret, fh, ret, FUNC_NAME);
}
int MPI_Win_lock(int lock_type, int rank, int assert, MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (lock_type != MPI_LOCK_EXCLUSIVE &&
lock_type != MPI_LOCK_SHARED) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_LOCKTYPE, FUNC_NAME);
} else if (ompi_win_peer_invalid(win, rank)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME);
} else if (0 != (assert & ~(MPI_MODE_NOCHECK))) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME);
} else if (! ompi_win_allow_locks(win)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME);
}
}
/* NTH: do not bother keeping track of locking MPI_PROC_NULL. */
if (MPI_PROC_NULL == rank) return MPI_SUCCESS;
rc = win->w_osc_module->osc_lock(lock_type, rank, assert, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Add_error_string(int errorcode, char *string)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_mpi_errcode_is_invalid(errorcode) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if ( ompi_mpi_errcode_is_predefined(errorcode) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if ( MPI_MAX_ERROR_STRING < (strlen(string)+1) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
rc = ompi_mpi_errnum_add_string (errorcode, string, (int)(strlen(string)+1));
if ( OMPI_SUCCESS != rc ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN,
FUNC_NAME);
}
return MPI_SUCCESS;
}
/**
* MPI_Info_get_valuelen - Get the length of a value for a given key in an 'M
*
* @param info - info object (handle)
* @param key - null-terminated character string of the index key
* @param valuelen - length of the value associated with 'key' (integer)
* @param flag - true (1) if 'key' defined on 'info', false (0) if not
* (logical)
*
* @retval MPI_SUCCESS
* @retval MPI_ERR_ARG
* @retval MPI_ERR_INFO
* @retval MPI_ERR_INFO_KEY
*
* The length returned in C and C++ does not include the end-of-string
* character. If the 'key' is not found on 'info', 'valuelen' is left
* alone.
*/
int MPI_Info_get_valuelen(MPI_Info info, const char *key, int *valuelen,
int *flag)
{
int key_length;
int err;
/*
* Simple function. All we need to do is search for the value
* having the "key" associated with it and return the length
*/
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
key_length = (key) ? (int)strlen (key) : 0;
if ((NULL == key) || (0 == key_length) ||
(MPI_MAX_INFO_KEY <= key_length)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
FUNC_NAME);
}
if (NULL == flag || NULL == valuelen) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
err = ompi_info_get_valuelen (info, key, valuelen, flag);
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME);
}
int MPI_Type_contiguous(int count,
MPI_Datatype oldtype,
MPI_Datatype *newtype)
{
int rc;
if( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (MPI_DATATYPE_NULL == oldtype || NULL == newtype ||
NULL == newtype) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_TYPE, FUNC_NAME);
} else if( count < 0 ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COUNT, FUNC_NAME);
}
}
rc = ompi_ddt_create_contiguous( count, oldtype, newtype );
OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME );
/* data description */
{
int* a_i[1];
a_i[0] = &count;
ompi_ddt_set_args( *newtype, 1, a_i, 0, NULL, 1, &oldtype, MPI_COMBINER_CONTIGUOUS );
}
OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME );
}
int MPI_File_open(MPI_Comm comm, char *filename, int amode,
MPI_Info info, MPI_File *fh)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
} else if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if (OMPI_COMM_IS_INTER(comm)) {
return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM,
FUNC_NAME);
}
}
/* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) says that
errors in MPI_FILE_OPEN (before the file handle is created)
should invoke the default error handler on MPI_FILE_NULL.
Hence, if we get a file handle out of ompi_file_open(), invoke
the error handler on that. If not, invoke the error handler on
MPI_FILE_NULL. */
/* The io framework is only initialized lazily. If it hasn't
already been initialized, do so now (note that MPI_FILE_OPEN
and MPI_FILE_DELETE are the only two places that it will be
initialized). */
if (!(mca_io_base_components_opened_valid ||
mca_io_base_components_available_valid)) {
if (OMPI_SUCCESS != (rc = mca_io_base_open())) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
if (OMPI_SUCCESS !=
(rc = mca_io_base_find_available(OMPI_ENABLE_PROGRESS_THREADS,
OMPI_ENABLE_MPI_THREADS))) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
}
/* Create an empty MPI_File handle */
*fh = MPI_FILE_NULL;
rc = ompi_file_open(comm, filename, amode, info, fh);
/* Creating the file handle also selects a component to use,
creates a module, and calls file_open() on the module. So
we're good to go. */
OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME);
}
int MPI_File_delete(char *filename, MPI_Info info)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || ompi_info_is_freed(info)) {
rc = MPI_ERR_INFO;
} else if (NULL == filename) {
rc = MPI_ERR_ARG;
}
OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
/* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) says that
errors in MPI_FILE_OPEN (before the file handle is created)
should invoke the default error handler on MPI_FILE_NULL.
Hence, if we get a file handle out of ompi_file_open(), invoke
the error handler on that. If not, invoke the error handler on
MPI_FILE_NULL. */
/* The io framework is only initialized lazily. If it hasn't
already been initialized, do so now (note that MPI_FILE_OPEN
and MPI_FILE_DELETE are the only two places that it will be
initialized). */
if (!(mca_io_base_components_opened_valid ||
mca_io_base_components_available_valid)) {
if (OMPI_SUCCESS != (rc = mca_io_base_open())) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
if (OMPI_SUCCESS !=
(rc = mca_io_base_find_available(OPAL_ENABLE_PROGRESS_THREADS,
OMPI_ENABLE_THREAD_MULTIPLE))) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Since there is no MPI_File handle associated with this
function, the MCA has to do a selection and perform the
action */
rc = mca_io_base_delete(filename, info);
OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
int MPI_Add_error_code(int errorclass, int *errorcode)
{
int code;
int rc;
OPAL_CR_NOOP_PROGRESS();
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_mpi_errcode_is_invalid(errorclass) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if ( !ompi_mpi_errnum_is_class ( errorclass) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if (NULL == errorcode) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD,
MPI_ERR_ARG, FUNC_NAME);
}
}
code = ompi_mpi_errcode_add ( errorclass);
if ( 0 > code ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN,
FUNC_NAME);
}
/*
** Update the attribute value. See the comments
** in attribute/attribute.c and attribute/attribute_predefined.c
** why we have to call the fortran attr_set function
*/
rc = ompi_attr_set_fint (COMM_ATTR,
MPI_COMM_WORLD,
&MPI_COMM_WORLD->c_keyhash,
MPI_LASTUSEDCODE,
ompi_mpi_errcode_lastused,
true);
if ( MPI_SUCCESS != rc ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, rc, FUNC_NAME);
}
*errorcode = code;
return MPI_SUCCESS;
}