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_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_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_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_Compare_and_swap(const void *origin_addr, const void *compare_addr, void *result_addr,
MPI_Datatype datatype, int target_rank, MPI_Aint target_disp, MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
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 (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1);
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS;
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_compare_and_swap(origin_addr, compare_addr, result_addr,
datatype, target_rank, target_disp, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
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_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_complete(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);
}
}
rc = win->w_osc_module->osc_complete(win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_set_attr(MPI_Win win, int win_keyval, void *attribute_val)
{
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);
}
}
ret = ompi_attr_set_c(WIN_ATTR, win, &win->w_keyhash,
win_keyval, attribute_val, false, true);
OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME);
}
int MPI_Win_delete_attr(MPI_Win win, int win_keyval)
{
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);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = ompi_attr_delete(WIN_ATTR, win, win->w_keyhash, win_keyval,
false, true);
OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME);
}
int MPI_Win_fence(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 (0 != (assert & ~(MPI_MODE_NOSTORE | MPI_MODE_NOPUT |
MPI_MODE_NOPRECEDE | MPI_MODE_NOSUCCEED))) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME);
}
}
rc = win->w_osc_module->osc_fence(assert, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Rput(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
int target_rank, MPI_Aint target_disp, int target_count,
MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
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 (origin_count < 0 || target_count < 0) {
rc = MPI_ERR_COUNT;
} else if (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if (NULL == target_datatype ||
MPI_DATATYPE_NULL == target_datatype) {
rc = MPI_ERR_TYPE;
} else if ( target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count);
if (OMPI_SUCCESS == rc) {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count);
}
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == target_rank) {
*request = &ompi_request_empty;
return MPI_SUCCESS;
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_rput(origin_addr, origin_count, origin_datatype,
target_rank, target_disp, target_count,
target_datatype, win, request);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_set_name(MPI_Win win, char *win_name)
{
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) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = ompi_win_set_name(win, win_name);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_test(MPI_Win win, int *flag)
{
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 (0 == (ompi_win_get_mode(win) & OMPI_WIN_POSTED)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_test(win, flag);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_set_info(MPI_Win win, MPI_Info info)
{
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);
}
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_INFO, FUNC_NAME);
}
}
ret = win->w_osc_module->osc_set_info(win, info);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_unlock(int rank, 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 (ompi_win_peer_invalid(win, rank)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME);
}
}
/* NTH: do not bother keeping track of unlocking MPI_PROC_NULL. */
if (MPI_PROC_NULL == rank) return MPI_SUCCESS;
rc = win->w_osc_module->osc_unlock(rank, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_flush_local_all(MPI_Win win)
{
int ret = MPI_SUCCESS;
/* argument checking */
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);
}
OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
/* create window and return */
ret = win->w_osc_module->osc_flush_local_all(win);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_call_errhandler(MPI_Win win, int errorcode)
{
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);
}
}
/* Invoke the errhandler */
OMPI_ERRHANDLER_INVOKE(win, errorcode, FUNC_NAME);
/* See MPI-2 8.5 why this function has to return MPI_SUCCESS */
return MPI_SUCCESS;
}
int MPI_Get(void *origin_addr, int origin_count,
MPI_Datatype origin_datatype, int target_rank,
MPI_Aint target_disp, int target_count,
MPI_Datatype target_datatype, MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
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 (origin_count < 0 || target_count < 0) {
rc = MPI_ERR_COUNT;
} else if (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if (!ompi_win_comm_allowed(win)) {
rc = MPI_ERR_RMA_SYNC;
} else if ( target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else if ( (origin_count < 0) || (target_count < 0) ) {
rc = MPI_ERR_COUNT;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count);
if (OMPI_SUCCESS == rc) {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count);
}
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS;
rc = win->w_osc_module->osc_get(origin_addr, origin_count, origin_datatype,
target_rank, target_disp, target_count,
target_datatype, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_lock_all(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 (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);
}
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_lock_all(assert, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_detach(MPI_Win win, void *base)
{
int ret = MPI_SUCCESS;
/* argument checking */
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 == base) {
ret = MPI_ERR_ARG;
}
OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
/* create window and return */
ret = win->w_osc_module->osc_win_detach(win, base);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_get_attr(MPI_Win win, int win_keyval,
void *attribute_val, int *flag)
{
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 == attribute_val) || (NULL == flag)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
} else if (MPI_KEYVAL_INVALID == win_keyval) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_KEYVAL, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* This stuff is very confusing. Be sure to see
src/attribute/attribute.c for a lengthy comment explaining Open
MPI attribute behavior. */
ret = ompi_attr_get_c(win->w_keyhash, win_keyval,
(void**)attribute_val, flag);
/* MPI-2 Section 6.2.2 says that for MPI_WIN_BASE, base will be a
pointer to the window in C/C++ and an integer representation of
the base address in Fortran. The only rational way to do this
is to store a pointer to the pointer in C (so that the
attribute code will do the right thing in Fortran) and
dereference the C attribute here so that it's right for C as
well. */
if (win_keyval == MPI_WIN_BASE) {
*((void**) attribute_val) = *((void**) attribute_val);
}
OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME);
}
MPI_Fint MPI_Win_c2f(MPI_Win win)
{
if ( MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note that ompi_win_invalid() explicitly checks for
MPI_WIN_NULL, but MPI_WIN_C2F is supposed to treat
MPI_WIN_NULL as a valid window (and therefore return
a valid Fortran handle for it). Hence, this function
should not return an error if MPI_WIN_NULL is passed in.
See a big comment in ompi/communicator/communicator.h about
this (I know that's not win.h, but the issues are related,
and that's where the explanation is). */
if (ompi_win_invalid(win) && MPI_WIN_NULL != win) {
return OMPI_INT_2_FINT(-1);
}
}
return OMPI_INT_2_FINT(win->w_f_to_c_index);
}
int ompi_win_finalize(void)
{
size_t size = opal_pointer_array_get_size (&ompi_mpi_windows);
/* start at 1 to skip win null */
for (size_t i = 1 ; i < size ; ++i) {
ompi_win_t *win =
(ompi_win_t *) opal_pointer_array_get_item (&ompi_mpi_windows, i);
if (NULL != win) {
if (ompi_debug_show_handle_leaks && !ompi_win_invalid(win)){
opal_output(0,"WARNING: MPI_Win still allocated in MPI_Finalize\n");
ompi_win_dump (win);
}
ompi_win_free (win);
}
}
OBJ_DESTRUCT(&ompi_mpi_win_null.win);
OBJ_DESTRUCT(&ompi_mpi_windows);
OBJ_RELEASE(ompi_win_accumulate_ops);
return OMPI_SUCCESS;
}
int MPI_Accumulate(void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
int target_rank, MPI_Aint target_disp, int target_count,
MPI_Datatype target_datatype, MPI_Op op, MPI_Win win)
{
int rc;
ompi_win_t *ompi_win = (ompi_win_t*) win;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
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 (origin_count < 0 || target_count < 0) {
rc = MPI_ERR_COUNT;
} else if (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if (MPI_OP_NULL == op) {
rc = MPI_ERR_OP;
} else if (!ompi_op_is_intrinsic(op)) {
rc = MPI_ERR_OP;
} else if (!ompi_win_comm_allowed(win)) {
rc = MPI_ERR_RMA_SYNC;
} else if ( target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else if ( (origin_count < 0) || (target_count < 0) ) {
rc = MPI_ERR_COUNT;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count);
if (OMPI_SUCCESS == rc) {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count);
}
if (OMPI_SUCCESS == rc) {
/* While technically the standard probably requires that the
datatypes used with MPI_REPLACE conform to all the rules
for other reduction operators, we don't require such
behaivor, as checking for it is expensive here and we don't
care in implementation.. */
if (op != &ompi_mpi_op_replace) {
ompi_datatype_t *op_check_dt, *origin_check_dt;
char *msg;
if (ompi_ddt_is_predefined(origin_datatype)) {
origin_check_dt = origin_datatype;
} else {
int i, index = -1, num_found = 0;
uint64_t mask = 1;
for (i = 0 ; i < DT_MAX_PREDEFINED ; ++i) {
if (origin_datatype->bdt_used & mask) {
num_found++;
index = i;
}
mask *= 2;
}
if (index < 0 || num_found > 1) {
/* this is an erroneous datatype. Let
ompi_op_is_valid tell the user that */
OMPI_ERRHANDLER_RETURN(MPI_ERR_TYPE, win, MPI_ERR_TYPE, FUNC_NAME);
} else {
origin_check_dt = (ompi_datatype_t*)
ompi_ddt_basicDatatypes[index];
}
}
/* ACCUMULATE, unlike REDUCE, can use with derived
datatypes with predefinied operations, with some
restrictions outlined in MPI-2:6.3.4. The derived
datatype must be composed entirley from one predefined
datatype (so you can do all the construction you want,
but at the bottom, you can only use one datatype, say,
MPI_INT). If the datatype at the target isn't
predefined, then make sure it's composed of only one
datatype, and check that datatype against
ompi_op_is_valid(). */
if (ompi_ddt_is_predefined(target_datatype)) {
op_check_dt = target_datatype;
} else {
int i, index = -1, num_found = 0;
uint64_t mask = 1;
for (i = 0 ; i < DT_MAX_PREDEFINED ; ++i) {
if (target_datatype->bdt_used & mask) {
num_found++;
index = i;
}
mask *= 2;
}
if (index < 0 || num_found > 1) {
/* this is an erroneous datatype. Let
ompi_op_is_valid tell the user that */
OMPI_ERRHANDLER_RETURN(MPI_ERR_TYPE, win, MPI_ERR_TYPE, FUNC_NAME);
} else {
/* datatype passes muster as far as restrictions
in MPI-2:6.3.4. Is the primitive ok with the
op? Unfortunately have to cast away
constness... */
op_check_dt = (ompi_datatype_t*)
ompi_ddt_basicDatatypes[index];
}
}
/* check to make sure same primitive type */
if (op_check_dt != origin_check_dt) {
OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME);
}
/* check to make sure primitive type is valid for
reduction. Should do this on the target, but
then can't get the errcode back for this
call */
if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) {
int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg);
free(msg);
return ret;
}
}
}
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
/* While technically the standard probably requires that the
datatypes used with MPI_REPLACE conform to all the rules
for other reduction operators, we don't require such
behaivor, as checking for it is expensive here and we don't
care in implementation.. */
if (op != &ompi_mpi_op_replace) {
ompi_datatype_t *op_check_dt;
char *msg;
/* ACCUMULATE, unlike REDUCE, can use with derived
datatypes with predefinied operations, with some
restrictions outlined in MPI-2:6.3.4. The derived
datatype must be composed entirley from one predefined
datatype (so you can do all the construction you want,
but at the bottom, you can only use one datatype, say,
MPI_INT). If the datatype at the target isn't
predefined, then make sure it's composed of only one
datatype, and check that datatype against
ompi_op_is_valid(). */
if (ompi_ddt_is_predefined(target_datatype)) {
op_check_dt = target_datatype;
} else {
int i, index = -1, num_found = 0;
uint64_t mask = 1;
for (i = 0 ; i < DT_MAX_PREDEFINED ; ++i) {
if (target_datatype->bdt_used & mask) {
num_found++;
index = i;
}
mask *= 2;
}
if (index < 0 || num_found > 1) {
/* this is an erroneous datatype. Let
ompi_op_is_valid tell the user that */
op_check_dt = target_datatype;
} else {
/* datatype passes muster as far as restrictions
in MPI-2:6.3.4. Is the primitive ok with the
op? Unfortunately have to cast away
constness... */
op_check_dt = (ompi_datatype_t*)
ompi_ddt_basicDatatypes[index];
}
}
if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) {
int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg);
free(msg);
return ret;
}
}
}
if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS;
rc = ompi_win->w_osc_module->osc_accumulate(origin_addr,
origin_count,
origin_datatype,
target_rank,
target_disp,
target_count,
target_datatype,
op, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
