/*@ MPI_Type_set_attr - Stores attribute value associated with a key Input Parameters: + datatype - MPI Datatype to which attribute will be attached (handle) . type_keyval - key value, as returned by 'MPI_Type_create_keyval' (integer) - attribute_val - attribute value Notes: The type of the attribute value depends on whether C or Fortran is being used. In C, an attribute value is a pointer ('void *'); in Fortran, it is an address-sized integer. If an attribute is already present, the delete function (specified when the corresponding keyval was created) will be called. .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE .N MPI_ERR_KEYVAL @*/ int MPI_Type_set_attr(MPI_Datatype datatype, int type_keyval, void *attribute_val) { static const char FCNAME[] = "MPI_Type_set_attr"; int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_SET_ATTR); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_SET_ATTR); mpi_errno = MPII_Type_set_attr( datatype, type_keyval, attribute_val, MPIR_ATTR_PTR ); if (mpi_errno) goto fn_fail; fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_SET_ATTR); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_set_attr", "**mpi_type_set_attr %D %d %p", datatype, type_keyval, attribute_val); } # endif mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
int MPIR_Init_async_thread(void) { #if MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_self_ptr; int err = 0; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_INIT_ASYNC_THREAD); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_INIT_ASYNC_THREAD); /* Dup comm world for the progress thread */ MPIR_Comm_get_ptr(MPI_COMM_SELF, comm_self_ptr); mpi_errno = MPIR_Comm_dup_impl(comm_self_ptr, &progress_comm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPID_Thread_cond_create(&progress_cond, &err); MPIR_ERR_CHKANDJUMP1(err, mpi_errno, MPI_ERR_OTHER, "**cond_create", "**cond_create %s", strerror(err)); MPID_Thread_mutex_create(&progress_mutex, &err); MPIR_ERR_CHKANDJUMP1(err, mpi_errno, MPI_ERR_OTHER, "**mutex_create", "**mutex_create %s", strerror(err)); MPID_Thread_create((MPID_Thread_func_t) progress_fn, NULL, &progress_thread_id, &err); MPIR_ERR_CHKANDJUMP1(err, mpi_errno, MPI_ERR_OTHER, "**mutex_create", "**mutex_create %s", strerror(err)); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_INIT_ASYNC_THREAD); fn_exit: return mpi_errno; fn_fail: goto fn_exit; #else return MPI_SUCCESS; #endif /* MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE */ }
int MPI_Get_library_version(char *version, int *resultlen) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_GET_LIBRARY_VERSION); /* Note that this routine may be called before MPI_Init */ MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_GET_LIBRARY_VERSION); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(version, "version", mpi_errno); MPIR_ERRTEST_ARGNULL(resultlen, "resultlen", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPL_snprintf(version, MPI_MAX_LIBRARY_VERSION_STRING, "MPICH Version:\t%s\n" "MPICH Release date:\t%s\n" "MPICH Device:\t%s\n" "MPICH configure:\t%s\n" "MPICH CC:\t%s\n" "MPICH CXX:\t%s\n" "MPICH F77:\t%s\n" "MPICH FC:\t%s\n", MPII_Version_string, MPII_Version_date, MPII_Version_device, MPII_Version_configure, MPII_Version_CC, MPII_Version_CXX, MPII_Version_F77, MPII_Version_FC); *resultlen = (int)strlen(version); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_GET_LIBRARY_VERSION); 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_get_library_version", "**mpi_get_library_version %p %p", version, resultlen); } mpi_errno = MPIR_Err_return_comm(0, FCNAME, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Group_rank - Returns the rank of this process in the given group Input Parameters: . group - group (handle) Output Parameters: . rank - rank of the calling process in group, or 'MPI_UNDEFINED' if the process is not a member (integer) .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_GROUP .N MPI_ERR_ARG @*/ int MPI_Group_rank(MPI_Group group, int *rank) { int mpi_errno = MPI_SUCCESS; MPIR_Group *group_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_GROUP_RANK); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_GROUP_RANK); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_GROUP(group, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPIR_Group_get_ptr( group, group_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate group_ptr */ MPIR_Group_valid_ptr( group_ptr, mpi_errno ); /* If group_ptr is not value, it will be reset to null */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ *rank = group_ptr->rank; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_GROUP_RANK); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE,FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_group_rank", "**mpi_group_rank %G %p", group, rank); } mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_T_pvar_readreset - Read the value of a performance variable and then reset it Input Parameters: + session - identifier of performance experiment session (handle) - handle - handle of a performance variable (handle) Output Parameters: . buf - initial address of storage location for variable value (choice) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_SESSION .N MPI_T_ERR_INVALID_HANDLE .N MPI_T_ERR_PVAR_NO_WRITE .N MPI_T_ERR_PVAR_NO_ATOMIC @*/ int MPI_T_pvar_readreset(MPI_T_pvar_session session, MPI_T_pvar_handle handle, void *buf) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_PVAR_READRESET); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_PVAR_READRESET); /* Validate parameters */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_PVAR_SESSION(session, mpi_errno); MPIR_ERRTEST_PVAR_HANDLE(handle, mpi_errno); MPIR_ERRTEST_ARGNULL(buf, "buf", mpi_errno); if (handle == MPI_T_PVAR_ALL_HANDLES || session != handle->session || !MPIR_T_pvar_is_oncestarted(handle)) { mpi_errno = MPI_T_ERR_INVALID_HANDLE; goto fn_fail; } if (!MPIR_T_pvar_is_atomic(handle)) { mpi_errno = MPI_T_ERR_PVAR_NO_ATOMIC; goto fn_fail; } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_T_pvar_readreset_impl(session, handle, buf); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_PVAR_READRESET); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_t_pvar_readreset", "**mpi_t_pvar_readreset %p %p %p", session, handle, buf); } #endif mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Get_count - Gets the number of "top level" elements Input Parameters: + status - return status of receive operation (Status) - datatype - datatype of each receive buffer element (handle) Output Parameters: . count - number of received elements (integer) Notes: If the size of the datatype is zero, this routine will return a count of zero. If the amount of data in 'status' is not an exact multiple of the size of 'datatype' (so that 'count' would not be integral), a 'count' of 'MPI_UNDEFINED' is returned instead. .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE @*/ int MPI_Get_count( const MPI_Status *status, MPI_Datatype datatype, int *count ) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_GET_COUNT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_GET_COUNT); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *datatype_ptr = NULL; MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno); MPIR_ERRTEST_ARGNULL(count, "count", mpi_errno); MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno); /* Validate datatype_ptr */ if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; /* Q: Must the type be committed to be used with this function? */ } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Get_count_impl(status, datatype, count); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_GET_COUNT); 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_get_count", "**mpi_get_count %p %D %p", status, datatype, count); } mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno ); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
/*@ MPI_T_pvar_handle_alloc - Allocate a handle for a performance variable Input Parameters: + session - identifier of performance experiment session (handle) . pvar_index - index of performance variable for which handle is to be allocated (integer) - obj_handle - reference to a handle of the MPI object to which this variable is supposed to be bound (pointer) Output Parameters: + handle - allocated handle (handle) - count - number of elements used to represent this variable (integer) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_SESSION .N MPI_T_ERR_INVALID_INDEX .N MPI_T_ERR_OUT_OF_HANDLES @*/ int MPI_T_pvar_handle_alloc(MPI_T_pvar_session session, int pvar_index, void *obj_handle, MPI_T_pvar_handle *handle, int *count) { int mpi_errno = MPI_SUCCESS; pvar_table_entry_t *entry; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_PVAR_HANDLE_ALLOC); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_PVAR_HANDLE_ALLOC); /* Validate parameters */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_PVAR_SESSION(session, mpi_errno); MPIR_ERRTEST_PVAR_INDEX(pvar_index, mpi_errno); MPIR_ERRTEST_ARGNULL(count, "count", mpi_errno); MPIR_ERRTEST_ARGNULL(handle, "handle", mpi_errno); /* Do not test obj_handle since it may be NULL when no binding */ } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ entry = (pvar_table_entry_t *) utarray_eltptr(pvar_table, pvar_index); if (!entry->active) { mpi_errno = MPI_T_ERR_INVALID_INDEX; goto fn_fail; } mpi_errno = MPIR_T_pvar_handle_alloc_impl(session, pvar_index, obj_handle, handle, count); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_PVAR_HANDLE_ALLOC); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_t_pvar_handle_alloc", "**mpi_t_pvar_handle_alloc %p %d %p %p %p", session, pvar_index, obj_handle, handle, count); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Type_contiguous - Creates a contiguous datatype Input Parameters: + count - replication count (nonnegative integer) - oldtype - old datatype (handle) Output Parameters: . newtype - new datatype (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE .N MPI_ERR_COUNT .N MPI_ERR_EXHAUSTED @*/ int MPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype *newtype) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_CONTIGUOUS); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_CONTIGUOUS); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *datatype_ptr = NULL; MPIR_ERRTEST_COUNT(count, mpi_errno); MPIR_ERRTEST_DATATYPE(oldtype, "datatype", mpi_errno); if (HANDLE_GET_KIND(oldtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(oldtype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_ARGNULL(newtype, "newtype", mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Type_contiguous_impl(count, oldtype, newtype); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_CONTIGUOUS); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_contiguous", "**mpi_type_contiguous %d %D %p", count, oldtype, newtype); } # endif mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_T_enum_get_item - Get the information about an item in an enumeration Input/Output Parameters: . name_len - length of the string and/or buffer for name (integer) Input Parameters: . enumtype - enumeration to be queried (handle) Output Parameters: + index - number of the value to be queried in this enumeration (integer) . value - variable value (integer) - name - buffer to return the string containing the name of the enumeration item (string) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_HANDLE .N MPI_T_ERR_INVALID_ITEM @*/ int MPI_T_enum_get_item(MPI_T_enum enumtype, int index, int *value, char *name, int *name_len) { int mpi_errno = MPI_SUCCESS; enum_item_t *item; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_ENUM_GET_ITEM); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_ENUM_GET_ITEM); /* Validate parameters */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ENUM_HANDLE(enumtype, mpi_errno); MPIR_ERRTEST_ENUM_ITEM(enumtype, index, mpi_errno); MPIR_ERRTEST_ARGNULL(value, "value", mpi_errno); /* Do not do TEST_ARGNULL for name or name_len, since this is * permitted per MPI_T standard. */ } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ item = (enum_item_t *) utarray_eltptr(enumtype->items, index); *value = item->value; MPIR_T_strncpy(name, item->name, name_len); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_ENUM_GET_ITEM); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; #ifdef HAVE_ERROR_CHECKING fn_fail: /* --BEGIN ERROR HANDLING-- */ { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_t_enum_get_item", "**mpi_t_enum_get_item %p %d %p %p %p", enumtype, index, value, name, name_len); } mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ #endif }
int MPIR_Get_intercomm_contextid(MPIR_Comm * comm_ptr, MPIR_Context_id_t * context_id, MPIR_Context_id_t * recvcontext_id) { MPIR_Context_id_t mycontext_id, remote_context_id; int mpi_errno = MPI_SUCCESS; int tag = 31567; /* FIXME - we need an internal tag or * communication channel. Can we use a different * context instead?. Or can we use the tag * provided in the intercomm routine? (not on a dup, * but in that case it can use the collective context) */ MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID); if (!comm_ptr->local_comm) { /* Manufacture the local communicator */ mpi_errno = MPII_Setup_intercomm_localcomm(comm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } mpi_errno = MPIR_Get_contextid_sparse(comm_ptr->local_comm, &mycontext_id, FALSE); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Assert(mycontext_id != 0); /* MPIC routine uses an internal context id. The local leads (process 0) * exchange data */ remote_context_id = -1; if (comm_ptr->rank == 0) { mpi_errno = MPIC_Sendrecv(&mycontext_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, 0, tag, &remote_context_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, 0, tag, comm_ptr, MPI_STATUS_IGNORE, &errflag); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } /* Make sure that all of the local processes now have this * id */ mpi_errno = MPID_Bcast(&remote_context_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, 0, comm_ptr->local_comm, &errflag); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail"); /* The recvcontext_id must be the one that was allocated out of the local * group, not the remote group. Otherwise we could end up posting two * MPI_ANY_SOURCE,MPI_ANY_TAG recvs on the same context IDs even though we * are attempting to post them for two separate communicators. */ *context_id = remote_context_id; *recvcontext_id = mycontext_id; fn_fail: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID); return mpi_errno; }
/*@ MPI_Add_error_class - Add an MPI error class to the known classes Output Parameters: . errorclass - New error class .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_OTHER @*/ int MPI_Add_error_class(int *errorclass) { int mpi_errno = MPI_SUCCESS; int new_class; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ADD_ERROR_CLASS); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ADD_ERROR_CLASS); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(errorclass, "errorclass", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ new_class = MPIR_Err_add_class(); MPIR_ERR_CHKANDJUMP(new_class < 0, mpi_errno, MPI_ERR_OTHER, "**noerrclasses"); *errorclass = ERROR_DYN_MASK | new_class; /* FIXME why isn't this done in MPIR_Err_add_class? */ if (*errorclass > MPIR_Process.attrs.lastusedcode) { MPIR_Process.attrs.lastusedcode = *errorclass; } /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ADD_ERROR_CLASS); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_add_error_class", "**mpi_add_error_class %p", errorclass); } #endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_T_pvar_handle_free - Free an existing handle for a performance variable Input/Output Parameters: + session - identifier of performance experiment session (handle) - handle - handle to be freed (handle) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_SESSION .N MPI_T_ERR_INVALID_HANDLE @*/ int MPI_T_pvar_handle_free(MPI_T_pvar_session session, MPI_T_pvar_handle *handle) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_PVAR_HANDLE_FREE); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_PVAR_HANDLE_FREE); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_ARGNULL(handle, "handle", mpi_errno); if (*handle == MPI_T_PVAR_HANDLE_NULL) /* free NULL is OK */ goto fn_exit; MPIR_ERRTEST_PVAR_SESSION(session, mpi_errno); MPIR_ERRTEST_PVAR_HANDLE(*handle, mpi_errno); if ((*handle) == MPI_T_PVAR_ALL_HANDLES || (*handle)->session != session) { mpi_errno = MPI_T_ERR_INVALID_HANDLE; goto fn_fail; } } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_T_pvar_handle_free_impl(session, handle); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_PVAR_HANDLE_FREE); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_t_pvar_handle_free", "**mpi_t_pvar_handle_free %p %p", session, handle); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Is_thread_main - Returns a flag indicating whether this thread called 'MPI_Init' or 'MPI_Init_thread' Output Parameters: . flag - Flag is true if 'MPI_Init' or 'MPI_Init_thread' has been called by this thread and false otherwise. (logical) .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_Is_thread_main(int *flag) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IS_THREAD_MAIN); MPIR_ERRTEST_INITIALIZED_ORDIE(); #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IS_THREAD_MAIN); /* ... body of routine ... */ #if MPICH_THREAD_LEVEL <= MPI_THREAD_FUNNELED || ! defined(MPICH_IS_THREADED) { *flag = TRUE; } #else { MPID_Thread_id_t my_thread_id; MPID_Thread_self(&my_thread_id); MPID_Thread_same(&MPIR_ThreadInfo.master_thread, &my_thread_id, flag); } #endif /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IS_THREAD_MAIN); 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_is_thread_main", "**mpi_is_thread_main %p", flag); } mpi_errno = MPIR_Err_return_comm(0, FCNAME, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }
MPI_Aint MPI_Aint_add(MPI_Aint base, MPI_Aint disp) { MPI_Aint result; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_AINT_ADD); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_AINT_ADD); result = MPID_Aint_add(base, disp); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_AINT_ADD); return result; }
MPI_Aint MPI_Aint_diff(MPI_Aint addr1, MPI_Aint addr2) { MPI_Aint result; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_AINT_DIFF); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_AINT_DIFF); result = MPID_Aint_diff(addr1, addr2); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_AINT_DIFF); return result; }
/*@ MPI_Wtick - Returns the resolution of MPI_Wtime Return value: Time in seconds of resolution of MPI_Wtime Notes for Fortran: This is a function, declared as 'DOUBLE PRECISION MPI_WTICK()' in Fortran. .see also: MPI_Wtime, MPI_Comm_get_attr, MPI_Attr_get @*/ double MPI_Wtick(void) { double tick; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WTICK); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WTICK); MPID_Wtick(&tick); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WTICK); return tick; }
/*@ MPI_Op_commute - Queries an MPI reduction operation for its commutativity. Input Parameters: . op - operation (handle) Output Parameters: . commute - Flag is true if 'op' is a commutative operation. (logical) .N NULL .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_ARG .seealso: MPI_Op_create @*/ int MPI_Op_commutative(MPI_Op op, int *commute) { MPIR_Op *op_ptr = NULL; int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_OP_COMMUTATIVE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_OP_COMMUTATIVE); MPIR_Op_get_ptr(op, op_ptr); #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Op_valid_ptr(op_ptr, mpi_errno); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Op_commutative(op_ptr, commute); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_OP_COMMUTATIVE); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; #ifdef HAVE_ERROR_CHECKING fn_fail: /* --BEGIN ERROR HANDLING-- */ { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_op_commutative", "**mpi_op_commutative %O %p", op, commute); } mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ #endif }
/*@ MPI_T_pvar_get_index - Get the index of a performance variable Input Parameters: . name - the name of the performance variable (string) . var_class - the class of the performance variable (integer) Output Parameters: . pvar_index - the index of the performance variable (integer) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_INVALID_NAME .N MPI_T_ERR_NOT_INITIALIZED @*/ int MPI_T_pvar_get_index(const char *name, int var_class, int *pvar_index) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_PVAR_GET_INDEX); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_PVAR_GET_INDEX); /* Validate parameters */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_ARGNULL(name, "name", mpi_errno); MPIR_ERRTEST_ARGNULL(pvar_index, "pvar_index", mpi_errno); if (var_class < MPIR_T_PVAR_CLASS_FIRST || var_class >= MPIR_T_PVAR_CLASS_LAST) { mpi_errno = MPI_T_ERR_INVALID_NAME; goto fn_fail; } } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ int seq = var_class - MPIR_T_PVAR_CLASS_FIRST; name2index_hash_t *hash_entry; /* Do hash lookup by the name */ HASH_FIND_STR(pvar_hashs[seq], name, hash_entry); if (hash_entry != NULL) { *pvar_index = hash_entry->idx; } else { mpi_errno = MPI_T_ERR_INVALID_NAME; goto fn_fail; } /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_PVAR_GET_INDEX); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: goto fn_exit; }
/*@ MPI_Add_error_code - Add an MPI error code to an MPI error class Input Parameters: . errorclass - Error class to add an error code. Output Parameters: . errorcode - New error code for this error class. .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_OTHER @*/ int MPI_Add_error_code(int errorclass, int *errorcode) { int mpi_errno = MPI_SUCCESS; int new_code; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ADD_ERROR_CODE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ADD_ERROR_CODE); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* FIXME: verify that errorclass is a dynamic class */ MPIR_ERRTEST_ARGNULL(errorcode, "errorcode", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ new_code = MPIR_Err_add_code(errorclass); MPIR_ERR_CHKANDJUMP(new_code < 0, mpi_errno, MPI_ERR_OTHER, "**noerrcodes"); *errorcode = new_code; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ADD_ERROR_CODE); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_add_error_code", "**mpi_add_error_code %d %p", errorclass, errorcode); } #endif mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_T_category_get_cvars - Get control variables in a category Input Parameters: + cat_index - index of the category to be queried, in the range [0,N-1] (integer) - len - the length of the indices array (integer) Output Parameters: . indices - an integer array of size len, indicating control variable indices (array of integers) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_INDEX @*/ int MPI_T_category_get_cvars(int cat_index, int len, int indices[]) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_CATEGORY_GET_CVARS); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_CATEGORY_GET_CVARS); /* Validate parameters */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_CAT_INDEX(cat_index, mpi_errno); if (len != 0) MPIR_ERRTEST_ARGNULL(indices, "indices", mpi_errno); } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ if (len == 0) goto fn_exit; mpi_errno = MPIR_T_category_get_cvars_impl(cat_index, len, indices); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_CATEGORY_GET_CVARS); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_t_category_get_cvars", "**mpi_t_category_get_cvars %d %d %p", cat_index, len, indices); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Wtime - Returns an elapsed time on the calling processor Return value: Time in seconds since an arbitrary time in the past. Notes: This is intended to be a high-resolution, elapsed (or wall) clock. See 'MPI_WTICK' to determine the resolution of 'MPI_WTIME'. If the attribute 'MPI_WTIME_IS_GLOBAL' is defined and true, then the value is synchronized across all processes in 'MPI_COMM_WORLD'. Notes for Fortran: This is a function, declared as 'DOUBLE PRECISION MPI_WTIME()' in Fortran. .see also: MPI_Wtick, MPI_Comm_get_attr, MPI_Attr_get @*/ double MPI_Wtime( void ) { double d; MPID_Time_t t; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WTIME); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WTIME); MPID_Wtime( &t ); MPID_Wtime_todouble( &t, &d ); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WTIME); return d; }
/*@ MPI_Error_class - Converts an error code into an error class Input Parameters: . errorcode - Error code returned by an MPI routine Output Parameters: . errorclass - Error class associated with 'errorcode' .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_Error_class(int errorcode, int *errorclass) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ERROR_CLASS); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ERROR_CLASS); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(errorclass, "errorclass", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ /* We include the dynamic bit because this is needed to fully * describe the dynamic error classes */ *errorclass = errorcode & (ERROR_CLASS_MASK | ERROR_DYN_MASK); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ERROR_CLASS); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_error_class", "**mpi_error_class %d %p", errorcode, errorclass); } mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Error_string - Return a string for a given error code Input Parameters: . errorcode - Error code returned by an MPI routine or an MPI error class Output Parameters: + string - Text that corresponds to the errorcode - resultlen - Length of string Notes: Error codes are the values return by MPI routines (in C) or in the 'ierr' argument (in Fortran). These can be converted into error classes with the routine 'MPI_Error_class'. .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_ARG @*/ int MPI_Error_string(int errorcode, char *string, int *resultlen) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ERROR_STRING); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ERROR_STRING); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(string, "string", mpi_errno); MPIR_ERRTEST_ARGNULL(resultlen, "resultlen", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Err_get_string(errorcode, string, MPI_MAX_ERROR_STRING, NULL); *resultlen = (int) strlen(string); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ERROR_STRING); 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_error_string", "**mpi_error_string %d %s %p", errorcode, string, resultlen); } mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Status_set_cancelled - Sets the cancelled state associated with a Status object Input Parameters: + status - status to associate cancel flag with (Status) - flag - if true indicates request was cancelled (logical) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_ARG @*/ int MPI_Status_set_cancelled(MPI_Status *status, int flag) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_Status_set_cancelled"; #endif int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_STATUS_SET_CANCELLED); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_STATUS_SET_CANCELLED); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL( status, "status", mpi_errno ); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_STATUS_SET_CANCEL_BIT(*status, flag ? TRUE : FALSE); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_STATUS_SET_CANCELLED); 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_status_set_cancelled", "**mpi_status_set_cancelled %p %d", status, flag); } mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno ); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Comm_create_keyval - Create a new attribute key Input Parameters: + comm_copy_attr_fn - Copy callback function for 'keyval' . comm_delete_attr_fn - Delete callback function for 'keyval' - extra_state - Extra state for callback functions Output Parameters: . comm_keyval - key value for future access (integer) Notes: Key values are global (available for any and all communicators). Default copy and delete functions are available. These are + MPI_COMM_NULL_COPY_FN - empty copy function . MPI_COMM_NULL_DELETE_FN - empty delete function - MPI_COMM_DUP_FN - simple dup function There are subtle differences between C and Fortran that require that the copy_fn be written in the same language from which 'MPI_Comm_create_keyval' is called. This should not be a problem for most users; only programmers using both Fortran and C in the same program need to be sure that they follow this rule. .N AttrErrReturn .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .seealso MPI_Comm_free_keyval @*/ int MPI_Comm_create_keyval(MPI_Comm_copy_attr_function *comm_copy_attr_fn, MPI_Comm_delete_attr_function *comm_delete_attr_fn, int *comm_keyval, void *extra_state) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CREATE_KEYVAL); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CREATE_KEYVAL); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(comm_keyval, "comm_keyval", mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Comm_create_keyval_impl(comm_copy_attr_fn, comm_delete_attr_fn, comm_keyval, extra_state); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CREATE_KEYVAL); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_comm_create_keyval", "**mpi_comm_create_keyval %p %p %p %p", comm_copy_attr_fn, comm_delete_attr_fn, comm_keyval, extra_state); } # endif mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
int MPIR_Finalize_async_thread(void) { int mpi_errno = MPI_SUCCESS; #if MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE MPIR_Request *request_ptr = NULL; MPI_Request request; MPI_Status status; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD); mpi_errno = MPID_Isend(NULL, 0, MPI_CHAR, 0, WAKE_TAG, progress_comm_ptr, MPIR_CONTEXT_INTRA_PT2PT, &request_ptr); MPIR_Assert(!mpi_errno); request = request_ptr->handle; mpi_errno = MPIR_Wait_impl(&request, &status); MPIR_Assert(!mpi_errno); /* XXX DJG why is this unlock/lock necessary? Should we just YIELD here or later? */ MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_Thread_mutex_lock(&progress_mutex, &mpi_errno); MPIR_Assert(!mpi_errno); while (!progress_thread_done) { MPID_Thread_cond_wait(&progress_cond, &progress_mutex, &mpi_errno); MPIR_Assert(!mpi_errno); } MPID_Thread_mutex_unlock(&progress_mutex, &mpi_errno); MPIR_Assert(!mpi_errno); mpi_errno = MPIR_Comm_free_impl(progress_comm_ptr); MPIR_Assert(!mpi_errno); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_Thread_cond_destroy(&progress_cond, &mpi_errno); MPIR_Assert(!mpi_errno); MPID_Thread_mutex_destroy(&progress_mutex, &mpi_errno); MPIR_Assert(!mpi_errno); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD); #endif /* MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE */ return mpi_errno; }
/*@ MPI_T_category_get_num - Get the number of categories Output Parameters: . num_cat - current number of categories (integer) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED @*/ int MPI_T_category_get_num(int *num_cat) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_CATEGORY_GET_NUM); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_CATEGORY_GET_NUM); /* Validate parameters */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(num_cat, "num_cat", mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ *num_cat = utarray_len(cat_table); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_CATEGORY_GET_NUM); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; #ifdef HAVE_ERROR_CHECKING fn_fail: /* --BEGIN ERROR HANDLING-- */ { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_t_category_get_num", "**mpi_t_category_get_num %p", num_cat); } mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ #endif }
/*@ MPI_T_cvar_read - Read the value of a control variable Input Parameters: . handle - handle to the control variable to be read (handle) Output Parameters: . buf - initial address of storage location for variable value .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_INVALID_HANDLE @*/ int MPI_T_cvar_read(MPI_T_cvar_handle handle, void *buf) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_CVAR_READ); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_CVAR_READ); /* Validate parameters */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_CVAR_HANDLE(handle, mpi_errno); MPIR_ERRTEST_ARGNULL(buf, "buf", mpi_errno); } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_T_cvar_read_impl(handle, buf); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_CVAR_READ); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_t_cvar_read", "**mpi_t_cvar_read %p %p", handle, buf); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_T_pvar_session_create - Create a new session for accessing performance variables Output Parameters: . session - identifier of performance session (handle) .N ThreadSafe .N Errors .N MPI_SUCCESS .N MPI_T_ERR_NOT_INITIALIZED .N MPI_T_ERR_OUT_OF_SESSIONS @*/ int MPI_T_pvar_session_create(MPI_T_pvar_session *session) { int mpi_errno = MPI_SUCCESS; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_T_PVAR_SESSION_CREATE); MPIR_ERRTEST_MPIT_INITIALIZED(mpi_errno); MPIR_T_THREAD_CS_ENTER(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_T_PVAR_SESSION_CREATE); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_ARGNULL(session, "session", mpi_errno); } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_T_pvar_session_create_impl(session); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_T_PVAR_SESSION_CREATE); MPIR_T_THREAD_CS_EXIT(); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_t_pvar_session_create", "**mpi_t_pvar_session_create %p", session); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
int MPIR_Get_intercomm_contextid_nonblock(MPIR_Comm * comm_ptr, MPIR_Comm * newcommp, MPIR_Request ** req) { int mpi_errno = MPI_SUCCESS; int tag; MPIR_Sched_t s; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID_NONBLOCK); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID_NONBLOCK); /* do as much local setup as possible */ if (!comm_ptr->local_comm) { mpi_errno = MPII_Setup_intercomm_localcomm(comm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } /* now create a schedule */ mpi_errno = MPIR_Sched_next_tag(comm_ptr, &tag); if (mpi_errno) MPIR_ERR_POP(mpi_errno); mpi_errno = MPIR_Sched_create(&s); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* add some entries to it */ /* first get a context ID over the local comm */ mpi_errno = sched_get_cid_nonblock(comm_ptr, newcommp, &newcommp->recvcontext_id, &newcommp->context_id, s, MPIR_COMM_KIND__INTERCOMM); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* finally, kick off the schedule and give the caller a request */ mpi_errno = MPIR_Sched_start(&s, comm_ptr, tag, req); if (mpi_errno) MPIR_ERR_POP(mpi_errno); fn_fail: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_GET_INTERCOMM_CONTEXTID_NONBLOCK); return mpi_errno; }