void MPIR_Comm_get_errhandler_impl(MPIR_Comm * comm_ptr, MPIR_Errhandler ** errhandler_ptr) { MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); *errhandler_ptr = comm_ptr->errhandler; if (comm_ptr->errhandler) MPIR_Errhandler_add_ref(comm_ptr->errhandler); MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); return; }
int MPIR_Comm_copy_data(MPID_Comm * comm_ptr, MPID_Comm ** outcomm_ptr) { int mpi_errno = MPI_SUCCESS; MPID_Comm *newcomm_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COPY_DATA); MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COPY_DATA); mpi_errno = MPIR_Comm_create(&newcomm_ptr); if (mpi_errno) goto fn_fail; /* use a large garbage value to ensure errors are caught more easily */ newcomm_ptr->context_id = 32767; newcomm_ptr->recvcontext_id = 32767; /* Save the kind of the communicator */ newcomm_ptr->comm_kind = comm_ptr->comm_kind; newcomm_ptr->local_comm = 0; if (comm_ptr->comm_kind == MPID_INTRACOMM) MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L); else MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_R2R); /* If it is an intercomm, duplicate the network address mapping */ if (comm_ptr->comm_kind == MPID_INTERCOMM) { MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L); } /* Set the sizes and ranks */ newcomm_ptr->rank = comm_ptr->rank; newcomm_ptr->local_size = comm_ptr->local_size; newcomm_ptr->remote_size = comm_ptr->remote_size; newcomm_ptr->is_low_group = comm_ptr->is_low_group; /* only relevant for intercomms */ /* Inherit the error handler (if any) */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); newcomm_ptr->errhandler = comm_ptr->errhandler; if (comm_ptr->errhandler) { MPIR_Errhandler_add_ref(comm_ptr->errhandler); } MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); /* FIXME do we want to copy coll_fns here? */ /* Start with no attributes on this communicator */ newcomm_ptr->attributes = 0; *outcomm_ptr = newcomm_ptr; fn_fail: fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COPY_DATA); return mpi_errno; }
/*@ MPI_Win_get_errhandler - Get the error handler for the MPI RMA window Input Parameters: . win - window (handle) Output Parameters: . errhandler - error handler currently associated with window (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_WIN .N MPI_ERR_OTHER @*/ int MPI_Win_get_errhandler(MPI_Win win, MPI_Errhandler * errhandler) { int mpi_errno = MPI_SUCCESS; MPIR_Win *win_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WIN_GET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WIN_GET_ERRHANDLER); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_WIN(win, mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* Convert MPI object handles to object pointers */ MPIR_Win_get_ptr(win, win_ptr); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(errhandler, "errhandler", mpi_errno); /* Validate win_ptr */ MPIR_Win_valid_ptr(win_ptr, mpi_errno); /* If win_ptr is not valid, it will be reset to null */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); if (win_ptr->errhandler) { *errhandler = win_ptr->errhandler->handle; MPIR_Errhandler_add_ref(win_ptr->errhandler); } else { /* Use the default */ *errhandler = MPI_ERRORS_ARE_FATAL; } MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WIN_GET_ERRHANDLER); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_win_get_errhandler", "**mpi_win_get_errhandler %W %p", win, errhandler); } mpi_errno = MPIR_Err_return_win(win_ptr, FCNAME, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }
/*@ MPI_File_set_errhandler - Set the error handler for an MPI file Input Parameters: + file - MPI file (handle) - errhandler - new error handler for file (handle) .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_File_set_errhandler(MPI_File file, MPI_Errhandler errhandler) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_File_set_errhandler"; #endif int mpi_errno = MPI_SUCCESS; #ifdef MPI_MODE_RDONLY int in_use; MPIR_Errhandler *errhan_ptr = NULL, *old_errhandler_ptr; MPI_Errhandler old_errhandler; #endif MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_FILE_SET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_FILE_SET_ERRHANDLER); #ifdef MPI_MODE_RDONLY /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* FIXME: check for a valid file handle (fh) before converting to a pointer */ MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ MPIR_Errhandler_get_ptr( errhandler, errhan_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) { MPIR_Errhandler_valid_ptr( errhan_ptr,mpi_errno ); /* Also check for a valid errhandler kind */ if (!mpi_errno) { if (errhan_ptr->kind != MPIR_FILE) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**errhandnotfile", NULL ); } } } if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_ROMIO_Get_file_errhand( file, &old_errhandler ); if (!old_errhandler) { /* MPI_File objects default to the errhandler set on MPI_FILE_NULL * at file open time, or MPI_ERRORS_RETURN if no errhandler is set * on MPI_FILE_NULL. (MPI-2.2, sec 13.7) */ MPIR_Errhandler_get_ptr( MPI_ERRORS_RETURN, old_errhandler_ptr ); } else { MPIR_Errhandler_get_ptr( old_errhandler, old_errhandler_ptr ); } if (old_errhandler_ptr) { MPIR_Errhandler_release_ref(old_errhandler_ptr,&in_use); if (!in_use) { MPIR_Errhandler_free( old_errhandler_ptr ); } } MPIR_Errhandler_add_ref(errhan_ptr); MPIR_ROMIO_Set_file_errhand( file, errhandler ); #else /* Dummy in case ROMIO is not defined */ mpi_errno = MPI_ERR_INTERN; #ifdef HAVE_ERROR_CHECKING if (0) goto fn_fail; /* quiet compiler warning about unused label */ #endif #endif /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_FILE_SET_ERRHANDLER); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_file_set_errhandler", "**mpi_file_set_errhandler %F %E", file, errhandler); } /* FIXME: Is this obsolete now? */ #ifdef MPI_MODE_RDONLY mpi_errno = MPIO_Err_return_file( file, mpi_errno ); #endif goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
int MPIR_Comm_copy(MPID_Comm * comm_ptr, int size, MPID_Comm ** outcomm_ptr) { int mpi_errno = MPI_SUCCESS; MPIU_Context_id_t new_context_id, new_recvcontext_id; MPID_Comm *newcomm_ptr = NULL; MPIR_Comm_map_t *map; MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COPY); MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COPY); /* Get a new context first. We need this to be collective over the * input communicator */ /* If there is a context id cache in oldcomm, use it here. Otherwise, * use the appropriate algorithm to get a new context id. Be careful * of intercomms here */ if (comm_ptr->comm_kind == MPID_INTERCOMM) { mpi_errno = MPIR_Get_intercomm_contextid(comm_ptr, &new_context_id, &new_recvcontext_id); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { mpi_errno = MPIR_Get_contextid_sparse(comm_ptr, &new_context_id, FALSE); new_recvcontext_id = new_context_id; if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIU_Assert(new_context_id != 0); } /* This is the local size, not the remote size, in the case of * an intercomm */ if (comm_ptr->rank >= size) { *outcomm_ptr = 0; /* always free the recvcontext ID, never the "send" ID */ MPIR_Free_contextid(new_recvcontext_id); goto fn_exit; } /* We're left with the processes that will have a non-null communicator. * Create the object, initialize the data, and return the result */ mpi_errno = MPIR_Comm_create(&newcomm_ptr); if (mpi_errno) goto fn_fail; newcomm_ptr->context_id = new_context_id; newcomm_ptr->recvcontext_id = new_recvcontext_id; /* Save the kind of the communicator */ newcomm_ptr->comm_kind = comm_ptr->comm_kind; newcomm_ptr->local_comm = 0; /* There are two cases here - size is the same as the old communicator, * or it is smaller. If the size is the same, we can just add a reference. * Otherwise, we need to create a new network address mapping. Note that this is the * test that matches the test on rank above. */ if (size == comm_ptr->local_size) { /* Duplicate the network address mapping */ if (comm_ptr->comm_kind == MPID_INTRACOMM) MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L); else MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_R2R); } else { int i; if (comm_ptr->comm_kind == MPID_INTRACOMM) MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_L2L, &map); else MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_R2R, &map); for (i = 0; i < size; i++) { /* For rank i in the new communicator, find the corresponding * rank in the input communicator */ map->src_mapping[i] = i; } } /* If it is an intercomm, duplicate the local network address references */ if (comm_ptr->comm_kind == MPID_INTERCOMM) { MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L); } /* Set the sizes and ranks */ newcomm_ptr->rank = comm_ptr->rank; if (comm_ptr->comm_kind == MPID_INTERCOMM) { newcomm_ptr->local_size = comm_ptr->local_size; newcomm_ptr->remote_size = comm_ptr->remote_size; newcomm_ptr->is_low_group = comm_ptr->is_low_group; } else { newcomm_ptr->local_size = size; newcomm_ptr->remote_size = size; } /* Inherit the error handler (if any) */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); newcomm_ptr->errhandler = comm_ptr->errhandler; if (comm_ptr->errhandler) { MPIR_Errhandler_add_ref(comm_ptr->errhandler); } MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); /* FIXME do we want to copy coll_fns here? */ mpi_errno = MPIR_Comm_commit(newcomm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* Start with no attributes on this communicator */ newcomm_ptr->attributes = 0; /* Copy over the info hints from the original communicator. */ mpi_errno = MPIR_Info_dup_impl(comm_ptr->info, &(newcomm_ptr->info)); if (mpi_errno) MPIR_ERR_POP(mpi_errno); mpi_errno = MPIR_Comm_apply_hints(newcomm_ptr, newcomm_ptr->info); if (mpi_errno) MPIR_ERR_POP(mpi_errno); *outcomm_ptr = newcomm_ptr; fn_fail: fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COPY); return mpi_errno; }
/*@ MPI_Win_set_errhandler - Set window error handler Input Parameters: + win - window (handle) - errhandler - new error handler for window (handle) .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_WIN @*/ int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_Win_set_errhandler"; #endif int mpi_errno = MPI_SUCCESS; MPID_Win *win_ptr = NULL; int in_use; MPID_Errhandler *errhan_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_WIN_SET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_WIN_SET_ERRHANDLER); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_WIN(win, mpi_errno); MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPID_Win_get_ptr( win, win_ptr ); MPID_Errhandler_get_ptr( errhandler, errhan_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate win_ptr */ MPID_Win_valid_ptr( win_ptr, mpi_errno ); /* If win_ptr is not value, it will be reset to null */ if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) { MPID_Errhandler_valid_ptr( errhan_ptr,mpi_errno ); /* Also check for a valid errhandler kind */ if (!mpi_errno) { if (errhan_ptr->kind != MPID_WIN) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**errhandnotwin", NULL ); } } } if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); if (win_ptr->errhandler != NULL) { MPIR_Errhandler_release_ref(win_ptr->errhandler,&in_use); if (!in_use) { MPID_Errhandler_free( win_ptr->errhandler ); } } MPIR_Errhandler_add_ref(errhan_ptr); win_ptr->errhandler = errhan_ptr; MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_WIN_SET_ERRHANDLER); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_win_set_errhandler", "**mpi_win_set_errhandler %W %E", win, errhandler); } mpi_errno = MPIR_Err_return_win(win_ptr, FCNAME, mpi_errno); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
int MPIR_Intercomm_create_impl(MPIR_Comm *local_comm_ptr, int local_leader, MPIR_Comm *peer_comm_ptr, int remote_leader, int tag, MPIR_Comm **new_intercomm_ptr) { int mpi_errno = MPI_SUCCESS; MPIR_Context_id_t final_context_id, recvcontext_id; int remote_size = 0, *remote_lpids = NULL; int comm_info[3]; int is_low_group = 0; int cts_tag; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL); /* Shift tag into the tagged coll space (tag provided by the user is ignored as of MPI 3.0) */ cts_tag = MPIR_COMM_KIND__INTERCOMM_CREATE_TAG | MPIR_Process.tagged_coll_mask; mpi_errno = MPID_Intercomm_exchange_map(local_comm_ptr, local_leader, peer_comm_ptr, remote_leader, &remote_size, &remote_lpids, &is_low_group); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* * Create the contexts. Each group will have a context for sending * to the other group. All processes must be involved. Because * we know that the local and remote groups are disjoint, this * step will complete */ MPL_DBG_MSG_FMT(MPIR_DBG_COMM,VERBOSE, (MPL_DBG_FDEST,"About to get contextid (local_size=%d) on rank %d", local_comm_ptr->local_size, local_comm_ptr->rank )); /* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the calling routine already holds the single criticial section */ /* TODO: Make sure this is tag-safe */ mpi_errno = MPIR_Get_contextid_sparse( local_comm_ptr, &recvcontext_id, FALSE ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Assert(recvcontext_id != 0); MPL_DBG_MSG_FMT(MPIR_DBG_COMM,VERBOSE, (MPL_DBG_FDEST,"Got contextid=%d", recvcontext_id)); /* Leaders can now swap context ids and then broadcast the value to the local group of processes */ if (local_comm_ptr->rank == local_leader) { MPIR_Context_id_t remote_context_id; mpi_errno = MPIC_Sendrecv( &recvcontext_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, remote_leader, cts_tag, &remote_context_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, remote_leader, cts_tag, peer_comm_ptr, MPI_STATUS_IGNORE, &errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); final_context_id = remote_context_id; /* Now, send all of our local processes the remote_lpids, along with the final context id */ comm_info[0] = final_context_id; MPL_DBG_MSG(MPIR_DBG_COMM,VERBOSE,"About to bcast on local_comm"); mpi_errno = MPID_Bcast( comm_info, 1, MPI_INT, local_leader, local_comm_ptr, &errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail"); MPL_DBG_MSG_D(MPIR_DBG_COMM,VERBOSE,"end of bcast on local_comm of size %d", local_comm_ptr->local_size ); } else { /* we're the other processes */ MPL_DBG_MSG(MPIR_DBG_COMM,VERBOSE,"About to receive bcast on local_comm"); mpi_errno = MPID_Bcast( comm_info, 1, MPI_INT, local_leader, local_comm_ptr, &errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail"); /* Extract the context and group sign informatin */ final_context_id = comm_info[0]; } /* At last, we now have the information that we need to build the intercommunicator */ /* All processes in the local_comm now build the communicator */ mpi_errno = MPIR_Comm_create( new_intercomm_ptr ); if (mpi_errno) goto fn_fail; (*new_intercomm_ptr)->context_id = final_context_id; (*new_intercomm_ptr)->recvcontext_id = recvcontext_id; (*new_intercomm_ptr)->remote_size = remote_size; (*new_intercomm_ptr)->local_size = local_comm_ptr->local_size; (*new_intercomm_ptr)->pof2 = local_comm_ptr->pof2; (*new_intercomm_ptr)->rank = local_comm_ptr->rank; (*new_intercomm_ptr)->comm_kind = MPIR_COMM_KIND__INTERCOMM; (*new_intercomm_ptr)->local_comm = 0; (*new_intercomm_ptr)->is_low_group = is_low_group; mpi_errno = MPID_Create_intercomm_from_lpids( *new_intercomm_ptr, remote_size, remote_lpids ); if (mpi_errno) goto fn_fail; MPIR_Comm_map_dup(*new_intercomm_ptr, local_comm_ptr, MPIR_COMM_MAP_DIR__L2L); /* Inherit the error handler (if any) */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(local_comm_ptr)); (*new_intercomm_ptr)->errhandler = local_comm_ptr->errhandler; if (local_comm_ptr->errhandler) { MPIR_Errhandler_add_ref( local_comm_ptr->errhandler ); } MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(local_comm_ptr)); mpi_errno = MPIR_Comm_commit(*new_intercomm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); fn_exit: if (remote_lpids) { MPL_free(remote_lpids); remote_lpids = NULL; } MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL); return mpi_errno; fn_fail: goto fn_exit; }
/*@ MPI_File_get_errhandler - Get the error handler attached to a file Input Parameters: . file - MPI file (handle) Output Parameters: . errhandler - handler currently associated with file (handle) .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_File_get_errhandler(MPI_File file, MPI_Errhandler *errhandler) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_File_get_errhandler"; #endif int mpi_errno = MPI_SUCCESS; #ifdef MPI_MODE_RDONLY MPI_Errhandler eh; MPID_Errhandler *e; #endif MPID_MPI_STATE_DECL(MPID_STATE_MPI_FILE_GET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_FILE_GET_ERRHANDLER); #ifdef MPI_MODE_RDONLY /* Validate parameters, especially handles needing to be converted */ /* FIXME: check for a valid file handle (fh) before converting to a pointer */ /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(errhandler,"errhandler",mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_ROMIO_Get_file_errhand( file, &eh ); if (!eh) { MPID_Errhandler_get_ptr( MPI_ERRORS_RETURN, e ); } else { MPID_Errhandler_get_ptr( eh, e ); } MPIR_Errhandler_add_ref( e ); *errhandler = e->handle; #else /* Dummy in case ROMIO is not defined */ mpi_errno = MPI_ERR_INTERN; #ifdef HAVE_ERROR_CHECKING if (0) goto fn_fail; /* quiet compiler warning about unused label */ #endif #endif /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_FILE_GET_ERRHANDLER); MPIU_THREAD_CS_EXIT(ALLFUNC,); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_file_get_errhandler", "**mpi_file_get_errhandler %F %p", file, errhandler); } /* FIXME: Is this obsolete now? */ #ifdef MPI_MODE_RDONLY mpi_errno = MPIO_Err_return_file( file, mpi_errno ); #endif goto fn_exit; # endif /* --END ERROR HANDLING-- */ }