int MPII_Win_get_attr( MPI_Win win, int win_keyval, void *attribute_val,
int *flag, MPIR_Attr_type outAttrType )
{
int mpi_errno = MPI_SUCCESS;
MPIR_Win *win_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_WIN_GET_ATTR);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_WIN_GET_ATTR);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_WIN(win, mpi_errno);
MPIR_ERRTEST_KEYVAL(win_keyval, MPIR_WIN, "window", mpi_errno);
# ifdef NEEDS_POINTER_ALIGNMENT_ADJUST
/* A common user error is to pass the address of a 4-byte
int when the address of a pointer (or an address-sized int)
should have been used. We can test for this specific
case. Note that this code assumes sizeof(intptr_t) is
a power of 2. */
if ((intptr_t)attribute_val & (sizeof(intptr_t)-1)) {
MPIR_ERR_SETANDSTMT(mpi_errno,MPI_ERR_ARG,goto fn_fail,"**attrnotptr");
}
# endif
}
MPID_END_ERROR_CHECKS;
}
/*@
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_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_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_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_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_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_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;
}
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_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_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_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-- */
}
/*@
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_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-- */
}
