int MPIDI_CH3_RecvRndv( MPIDI_VC_t * vc, MPID_Request *rreq )
{
int mpi_errno = MPI_SUCCESS;
/* A rendezvous request-to-send (RTS) message has arrived. We need
to send a CTS message to the remote process. */
MPID_Request * cts_req;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_rndv_clr_to_send_t * cts_pkt = &upkt.rndv_clr_to_send;
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,
"rndv RTS in the request, sending rndv CTS");
MPIDI_Pkt_init(cts_pkt, MPIDI_CH3_PKT_RNDV_CLR_TO_SEND);
cts_pkt->sender_req_id = rreq->dev.sender_req_id;
cts_pkt->receiver_req_id = rreq->handle;
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, cts_pkt, sizeof(*cts_pkt), &cts_req);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER, "**ch3|ctspkt");
}
if (cts_req != NULL)
{
/* FIXME: Ideally we could specify that a req not be returned.
This would avoid our having to decrement the
reference count on a req we don't want/need. */
MPID_Request_release(cts_req);
}
fn_fail:
return mpi_errno;
}
void MPIR_CommL_forget( MPID_Comm *comm_ptr )
{
#if defined(FINEGRAIN_MPI) /* FG: TODO Temporary bypass */
return;
#endif
MPID_Comm *p, *prev;
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Forgetting communicator %p from remember list",comm_ptr);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
p = MPIR_All_communicators.head;
prev = 0;
while (p) {
if (p == comm_ptr) {
if (prev) prev->comm_next = p->comm_next;
else MPIR_All_communicators.head = p->comm_next;
break;
}
if (p == p->comm_next) {
MPL_internal_error_printf( "Mangled pointers to communicators - next is itself for %p\n", p );
break;
}
prev = p;
p = p->comm_next;
}
/* Record a change to the list */
MPIR_All_communicators.sequence_number++;
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
}
int MPIDI_CH3I_Progress_register_hook(int (*progress_fn)(int*), int *id)
{
int mpi_errno = MPI_SUCCESS;
int i;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3I_PROGRESS_REGISTER_HOOK);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3I_PROGRESS_REGISTER_HOOK);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
for (i = 0; i < MAX_PROGRESS_HOOKS; i++) {
if (progress_hooks[i].func_ptr == NULL) {
progress_hooks[i].func_ptr = progress_fn;
progress_hooks[i].active = FALSE;
break;
}
}
if (i >= MAX_PROGRESS_HOOKS) {
return MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
"MPIDI_CH3I_Progress_register_hook", __LINE__,
MPI_ERR_INTERN, "**progresshookstoomany", 0 );
}
(*id) = i;
fn_exit:
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3I_PROGRESS_REGISTER_HOOK);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int
MPIR_Attr_delete_c_proxy(
MPI_Comm_delete_attr_function* user_function,
int handle,
int keyval,
MPIR_AttrType attrib_type,
void* attrib,
void* extra_state
)
{
void *attrib_val = NULL;
int ret;
/* Make sure that the attribute value is delieverd as a pointer */
if (MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT))
attrib_val = &attrib;
else
attrib_val = attrib;
/* user functions might call other MPI functions, so we need to
* release the lock here. This is safe to do as GLOBAL is not at
* all recursive in our implementation. */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
ret = user_function(handle, keyval, attrib_val, extra_state);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return ret;
}
/* This routine is used to establish a queue of send requests to allow the
debugger easier access to the active requests. Some devices may be able
to provide this information without requiring this separate queue. */
void MPIR_Sendq_remember( MPID_Request *req,
int rank, int tag, int context_id )
{
MPIR_Sendq *p;
MPID_THREAD_CS_ENTER(POBJ, req->pobj_mutex);
if (pool) {
p = pool;
pool = p->next;
}
else {
p = (MPIR_Sendq *)MPIU_Malloc( sizeof(MPIR_Sendq) );
if (!p) {
/* Just ignore it */
req->dbg_next = NULL;
goto fn_exit;
}
}
p->sreq = req;
p->tag = tag;
p->rank = rank;
p->context_id = context_id;
p->next = MPIR_Sendq_head;
p->prev = NULL;
MPIR_Sendq_head = p;
if (p->next) p->next->prev = p;
req->dbg_next = p;
fn_exit:
MPID_THREAD_CS_EXIT(POBJ, req->pobj_mutex);
}
/*@
MPIDI_CH3U_VC_SendClose - Initiate a close on a virtual connection
Input Parameters:
+ vc - Virtual connection to close
- i - rank of virtual connection within a process group (used for debugging)
Notes:
The current state of this connection must be either 'MPIDI_VC_STATE_ACTIVE'
or 'MPIDI_VC_STATE_REMOTE_CLOSE'.
@*/
int MPIDI_CH3U_VC_SendClose( MPIDI_VC_t *vc, int rank )
{
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_close_t * close_pkt = &upkt.close;
MPIR_Request * sreq;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3U_VC_SENDCLOSE);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3U_VC_SENDCLOSE);
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
MPIR_Assert( vc->state == MPIDI_VC_STATE_ACTIVE ||
vc->state == MPIDI_VC_STATE_REMOTE_CLOSE );
MPIDI_Pkt_init(close_pkt, MPIDI_CH3_PKT_CLOSE);
close_pkt->ack = (vc->state == MPIDI_VC_STATE_ACTIVE) ? FALSE : TRUE;
/* MT: this is not thread safe, the POBJ CS is scoped to the vc and
* doesn't protect this global correctly */
MPIDI_Outstanding_close_ops += 1;
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_DISCONNECT,TYPICAL,(MPL_DBG_FDEST,
"sending close(%s) on vc (pg=%p) %p to rank %d, ops = %d",
close_pkt->ack ? "TRUE" : "FALSE", vc->pg, vc,
rank, MPIDI_Outstanding_close_ops));
/*
* A close packet acknowledging this close request could be
* received during iStartMsg, therefore the state must
* be changed before the close packet is sent.
*/
if (vc->state == MPIDI_VC_STATE_ACTIVE) {
MPIDI_CHANGE_VC_STATE(vc, LOCAL_CLOSE);
}
else {
MPIR_Assert( vc->state == MPIDI_VC_STATE_REMOTE_CLOSE );
MPIDI_CHANGE_VC_STATE(vc, CLOSE_ACKED);
}
mpi_errno = MPIDI_CH3_iStartMsg(vc, close_pkt, sizeof(*close_pkt), &sreq);
MPIR_ERR_CHKANDJUMP(mpi_errno, mpi_errno, MPI_ERR_OTHER, "**ch3|send_close_ack");
if (sreq != NULL) {
/* There is still another reference being held by the channel. It
will not be released until the pkt is actually sent. */
MPIR_Request_free(sreq);
}
fn_exit:
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3U_VC_SENDCLOSE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
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-- */
}
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;
}
/* MPIDI_CH3_EagerNoncontigSend - Eagerly send noncontiguous data */
int MPIDI_CH3_EagerNoncontigSend( MPID_Request **sreq_p,
MPIDI_CH3_Pkt_type_t reqtype,
const void * buf, MPI_Aint count,
MPI_Datatype datatype, MPIDI_msg_sz_t data_sz,
int rank,
int tag, MPID_Comm * comm,
int context_offset )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_VC_t * vc;
MPID_Request *sreq = *sreq_p;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_send_t * const eager_pkt = &upkt.eager_send;
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"sending non-contiguous eager message, data_sz=" MPIDI_MSG_SZ_FMT,
data_sz));
sreq->dev.OnDataAvail = 0;
sreq->dev.OnFinal = 0;
MPIDI_Pkt_init(eager_pkt, reqtype);
eager_pkt->match.parts.rank = comm->rank;
eager_pkt->match.parts.tag = tag;
eager_pkt->match.parts.context_id = comm->context_id + context_offset;
eager_pkt->sender_req_id = MPI_REQUEST_NULL;
eager_pkt->data_sz = data_sz;
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(eager_pkt, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
MPIU_DBG_MSGPKT(vc,tag,eager_pkt->match.parts.context_id,rank,data_sz,
"Eager");
sreq->dev.segment_ptr = MPID_Segment_alloc( );
MPIR_ERR_CHKANDJUMP1((sreq->dev.segment_ptr == NULL), mpi_errno, MPI_ERR_OTHER, "**nomem", "**nomem %s", "MPID_Segment_alloc");
MPID_Segment_init(buf, count, datatype, sreq->dev.segment_ptr, 0);
sreq->dev.segment_first = 0;
sreq->dev.segment_size = data_sz;
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = vc->sendNoncontig_fn(vc, sreq, eager_pkt,
sizeof(MPIDI_CH3_Pkt_eager_send_t));
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
fn_exit:
return mpi_errno;
fn_fail:
*sreq_p = NULL;
goto fn_exit;
}
int MPIDI_CH3_GetParentPort(char ** parent_port)
{
int mpi_errno = MPI_SUCCESS;
int pmi_errno;
char val[MPIDI_MAX_KVS_VALUE_LEN];
if (parent_port_name == NULL)
{
char *kvsname = NULL;
/* We can always use PMI_KVS_Get on our own process group */
MPIDI_PG_GetConnKVSname( &kvsname );
#ifdef USE_PMI2_API
{
int vallen = 0;
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
pmi_errno = PMI2_KVS_Get(kvsname, PMI2_ID_NULL, PARENT_PORT_KVSKEY, val, sizeof(val), &vallen);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
if (pmi_errno)
MPIR_ERR_SETANDJUMP1(mpi_errno, MPI_ERR_OTHER, "**pmi_kvsget", "**pmi_kvsget %s", PARENT_PORT_KVSKEY);
}
#else
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
pmi_errno = PMI_KVS_Get( kvsname, PARENT_PORT_KVSKEY, val, sizeof(val));
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
if (pmi_errno) {
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_FATAL, FCNAME, __LINE__, MPI_ERR_OTHER, "**pmi_kvsget", "**pmi_kvsget %d", pmi_errno);
goto fn_exit;
}
#endif
parent_port_name = MPL_strdup(val);
if (parent_port_name == NULL) {
MPIR_ERR_POP(mpi_errno); /* FIXME DARIUS */
}
}
*parent_port = parent_port_name;
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
void MPIR_Sendq_forget( MPID_Request *req )
{
MPIR_Sendq *p, *prev;
MPID_THREAD_CS_ENTER(POBJ, req->pobj_mutex);
p = req->dbg_next;
if (!p) {
/* Just ignore it */
MPID_THREAD_CS_EXIT(POBJ, req->pobj_mutex);
return;
}
prev = p->prev;
if (prev != NULL) prev->next = p->next;
else MPIR_Sendq_head = p->next;
if (p->next != NULL) p->next->prev = prev;
/* Return this element to the pool */
p->next = pool;
pool = p;
MPID_THREAD_CS_EXIT(POBJ, req->pobj_mutex);
}
/*@
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_Info_create - Creates a new info object
Output Parameters:
. info - info object created (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_OTHER
@*/
int MPI_Info_create( MPI_Info *info )
{
MPID_Info *info_ptr;
static const char FCNAME[] = "MPI_Info_create";
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_INFO_CREATE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_INFO_CREATE);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(info, "info", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIU_Info_alloc(&info_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
*info = info_ptr->handle;
/* (info_ptr)->cookie = MPIR_INFO_COOKIE; */
/* this is the first structure in this linked list. it is
always kept empty. new (key,value) pairs are added after it. */
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_INFO_CREATE);
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_info_create",
"**mpi_info_create %p", info);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Cancel - Cancels a communication request
Input Parameters:
. request - communication request (handle)
Notes:
The primary expected use of 'MPI_Cancel' is in multi-buffering
schemes, where speculative 'MPI_Irecvs' are made. When the computation
completes, some of these receive requests may remain; using 'MPI_Cancel' allows
the user to cancel these unsatisfied requests.
Cancelling a send operation is much more difficult, in large part because the
send will usually be at least partially complete (the information on the tag,
size, and source are usually sent immediately to the destination).
Users are
advised that cancelling a send, while a local operation (as defined by the MPI
standard), is likely to be expensive (usually generating one or more internal
messages).
.N ThreadSafe
.N Fortran
.N NULL
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_REQUEST
.N MPI_ERR_ARG
@*/
int MPI_Cancel(MPI_Request *request)
{
int mpi_errno = MPI_SUCCESS;
MPID_Request * request_ptr;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_CANCEL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_CANCEL);
/* Convert MPI object handles to object pointers */
MPID_Request_get_ptr( *request, request_ptr );
/* Validate parameters if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate request_ptr */
MPID_Request_valid_ptr( request_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Cancel_impl(request_ptr);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_CANCEL);
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_cancel",
"**mpi_cancel %p", request);
}
# endif
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
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
}
int MPIDI_CH3_EagerContigSend( MPID_Request **sreq_p,
MPIDI_CH3_Pkt_type_t reqtype,
const void * buf, MPIDI_msg_sz_t data_sz, int rank,
int tag, MPID_Comm * comm, int context_offset )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_VC_t * vc;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_send_t * const eager_pkt = &upkt.eager_send;
MPID_Request *sreq = *sreq_p;
MPL_IOV iov[2];
MPIDI_Pkt_init(eager_pkt, reqtype);
eager_pkt->match.parts.rank = comm->rank;
eager_pkt->match.parts.tag = tag;
eager_pkt->match.parts.context_id = comm->context_id + context_offset;
eager_pkt->sender_req_id = MPI_REQUEST_NULL;
eager_pkt->data_sz = data_sz;
iov[0].MPL_IOV_BUF = (MPL_IOV_BUF_CAST)eager_pkt;
iov[0].MPL_IOV_LEN = sizeof(*eager_pkt);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"sending contiguous eager message, data_sz=" MPIDI_MSG_SZ_FMT,
data_sz));
iov[1].MPL_IOV_BUF = (MPL_IOV_BUF_CAST) buf;
iov[1].MPL_IOV_LEN = data_sz;
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(eager_pkt, seqnum);
MPIU_DBG_MSGPKT(vc,tag,eager_pkt->match.parts.context_id,rank,data_sz,"EagerContig");
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsgv(vc, iov, 2, sreq_p);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**ch3|eagermsg");
}
sreq = *sreq_p;
if (sreq != NULL)
{
MPIDI_Request_set_seqnum(sreq, seqnum);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
}
fn_fail:
return mpi_errno;
}
/*@
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-- */
}
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;
}
static int getConnInfoKVS( int rank, char *buf, int bufsize, MPIDI_PG_t *pg )
{
#ifdef USE_PMI2_API
char key[MPIDI_MAX_KVS_KEY_LEN];
int mpi_errno = MPI_SUCCESS, rc;
int vallen;
rc = MPL_snprintf(key, MPIDI_MAX_KVS_KEY_LEN, "P%d-businesscard", rank );
if (rc < 0 || rc > MPIDI_MAX_KVS_KEY_LEN) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
mpi_errno = PMI2_KVS_Get(pg->connData, PMI2_ID_NULL, key, buf, bufsize, &vallen);
if (mpi_errno) {
MPIDI_PG_CheckForSingleton();
mpi_errno = PMI2_KVS_Get(pg->connData, PMI2_ID_NULL, key, buf, bufsize, &vallen);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
#else
char key[MPIDI_MAX_KVS_KEY_LEN];
int mpi_errno = MPI_SUCCESS, rc, pmi_errno;
rc = MPL_snprintf(key, MPIDI_MAX_KVS_KEY_LEN, "P%d-businesscard", rank );
if (rc < 0 || rc > MPIDI_MAX_KVS_KEY_LEN) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
pmi_errno = PMI_KVS_Get(pg->connData, key, buf, bufsize );
if (pmi_errno) {
MPIDI_PG_CheckForSingleton();
pmi_errno = PMI_KVS_Get(pg->connData, key, buf, bufsize );
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
if (pmi_errno) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**pmi_kvs_get");
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
#endif
}
/*@
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_Add_error_string - Associates an error string with an MPI error code or
class
Input Parameters:
+ errorcode - error code or class (integer)
- string - text corresponding to errorcode (string)
Notes:
The string must be no more than 'MPI_MAX_ERROR_STRING' characters long.
The length of the string is as defined in the calling language.
The length of the string does not include the null terminator in C or C++.
Note that the string is 'const' even though the MPI standard does not
specify it that way.
According to the MPI-2 standard, it is erroneous to call 'MPI_Add_error_string'
for an error code or class with a value less than or equal
to 'MPI_ERR_LASTCODE'. Thus, you cannot replace the predefined error messages
with this routine.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Add_error_string(int errorcode, const char *string)
{
static const char FCNAME[] = "MPI_Add_error_string";
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ADD_ERROR_STRING);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_ADD_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);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Err_set_msg( errorcode, (const char *)string );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_ADD_ERROR_STRING);
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_string",
"**mpi_add_error_string %d %s", errorcode, string);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/* Send a zero-sized message with eager synchronous. This is a temporary
routine, as we may want to replace this with a counterpart to the
Eager Short message */
int MPIDI_CH3_EagerSyncZero(MPIR_Request **sreq_p, int rank, int tag,
MPIR_Comm * comm, int context_offset )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_sync_send_t * const es_pkt = &upkt.eager_sync_send;
MPIDI_VC_t * vc;
MPIR_Request *sreq = *sreq_p;
MPL_DBG_MSG(MPIDI_CH3_DBG_OTHER,VERBOSE,"sending zero length message");
/* MT FIXME what are the two operations we are waiting for? the send and
* the sync response? */
MPIR_cc_set(&sreq->cc, 2);
MPIDI_Request_set_msg_type(sreq, MPIDI_REQUEST_EAGER_MSG);
sreq->dev.OnDataAvail = 0;
MPIDI_Pkt_init(es_pkt, MPIDI_CH3_PKT_EAGER_SYNC_SEND);
es_pkt->match.parts.rank = comm->rank;
es_pkt->match.parts.tag = tag;
es_pkt->match.parts.context_id = comm->context_id + context_offset;
es_pkt->sender_req_id = sreq->handle;
es_pkt->data_sz = 0;
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(es_pkt, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
MPL_DBG_MSGPKT(vc,tag,es_pkt->match.parts.context_id,rank,(intptr_t)0,"EagerSync0");
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iSend(vc, sreq, es_pkt, sizeof(*es_pkt));
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPIR_Request_free(sreq);
*sreq_p = NULL;
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**ch3|eagermsg");
}
/* --END ERROR HANDLING-- */
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
static void progress_fn(void * data)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Request *request_ptr = NULL;
MPI_Request request;
MPI_Status status;
/* Explicitly add CS_ENTER/EXIT since this thread is created from
* within an internal function and will call NMPI functions
* directly. */
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
/* FIXME: We assume that waiting on some request forces progress
* on all requests. With fine-grained threads, will this still
* work as expected? We can imagine an approach where a request on
* a non-conflicting communicator would not touch the remaining
* requests to avoid locking issues. Once the fine-grained threads
* code is fully functional, we need to revisit this and, if
* appropriate, either change what we do in this thread, or delete
* this comment. */
mpi_errno = MPID_Irecv(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);
/* Send a signal to the main thread saying we are done */
MPID_Thread_mutex_lock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
progress_thread_done = 1;
MPID_Thread_mutex_unlock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_Thread_cond_signal(&progress_cond, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return;
}
int MPIDI_CH3I_Progress_deactivate_hook(int id)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_Assert(id >= 0 && id < MAX_PROGRESS_HOOKS &&
progress_hooks[id].active == TRUE && progress_hooks[id].func_ptr != NULL);
progress_hooks[id].active = FALSE;
fn_exit:
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_NS_Lookup( MPID_NS_Handle handle, const MPID_Info *info_ptr,
const char service_name[], char port[] )
{
int mpi_errno = MPI_SUCCESS;
int rc;
MPIU_UNREFERENCED_ARG(info_ptr);
MPIU_UNREFERENCED_ARG(handle);
#ifdef USE_PMI2_API
/* release the global CS for PMI calls */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
rc = PMI2_Nameserv_lookup(service_name, info_ptr, port, MPI_MAX_PORT_NAME);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
#else
rc = PMI_Lookup_name( service_name, port );
#endif
MPIR_ERR_CHKANDJUMP1(rc, mpi_errno, MPI_ERR_NAME, "**namepubnotfound", "**namepubnotfound %s", service_name);
fn_fail:
return mpi_errno;
}
int MPID_NS_Unpublish( MPID_NS_Handle handle, const MPID_Info *info_ptr,
const char service_name[] )
{
int mpi_errno = MPI_SUCCESS;
int rc;
MPIU_UNREFERENCED_ARG(info_ptr);
MPIU_UNREFERENCED_ARG(handle);
#ifdef USE_PMI2_API
/* release the global CS for PMI calls */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
rc = PMI2_Nameserv_unpublish(service_name, info_ptr);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
#else
rc = PMI_Unpublish_name( service_name );
#endif
MPIR_ERR_CHKANDJUMP1(rc, mpi_errno, MPI_ERR_SERVICE, "**namepubnotunpub", "**namepubnotunpub %s", service_name);
fn_fail:
return mpi_errno;
}
void MPIR_CommL_remember( MPID_Comm *comm_ptr )
{
#if defined(FINEGRAIN_MPI) /* FG: TODO Temporary bypass */
return;
#endif
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Adding communicator %p to remember list",comm_ptr);
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Remember list structure address is %p",&MPIR_All_communicators);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
if (comm_ptr == MPIR_All_communicators.head) {
MPL_internal_error_printf( "Internal error: communicator is already on free list\n" );
return;
}
comm_ptr->comm_next = MPIR_All_communicators.head;
MPIR_All_communicators.head = comm_ptr;
MPIR_All_communicators.sequence_number++;
MPIU_DBG_MSG_P(COMM,VERBOSE,
"master head is %p", MPIR_All_communicators.head );
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
}
/*
* These routines are called when a receive matches an eager sync send
*/
int MPIDI_CH3_EagerSyncAck( MPIDI_VC_t *vc, MPIR_Request *rreq )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_sync_ack_t * const esa_pkt = &upkt.eager_sync_ack;
MPIR_Request * esa_req;
MPL_DBG_MSG(MPIDI_CH3_DBG_OTHER,VERBOSE,"sending eager sync ack");
MPIDI_Pkt_init(esa_pkt, MPIDI_CH3_PKT_EAGER_SYNC_ACK);
esa_pkt->sender_req_id = rreq->dev.sender_req_id;
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, esa_pkt, sizeof(*esa_pkt), &esa_req);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_POP(mpi_errno);
}
if (esa_req != NULL)
{
MPIR_Request_free(esa_req);
}
fn_fail:
return mpi_errno;
}
/*@
MPI_Reduce_local - Applies a reduction operator to local arguments.
Input Parameters:
+ inbuf - address of the input buffer (choice)
. count - number of elements in each buffer (integer)
. datatype - data type of elements in the buffers (handle)
- op - reduction operation (handle)
Output Parameters:
. inoutbuf - address of input-output buffer (choice)
.N ThreadSafe
.N Fortran
.N collops
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_BUFFER
.N MPI_ERR_BUFFER_ALIAS
@*/
int MPI_Reduce_local(const void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op)
{
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_REDUCE_LOCAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_REDUCE_LOCAL);
/* Validate parameters */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_OP(op, mpi_errno);
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {
MPID_Op *op_ptr;
MPID_Op_get_ptr(op, op_ptr);
MPID_Op_valid_ptr( op_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {
mpi_errno = (*MPIR_OP_HDL_TO_DTYPE_FN(op))(datatype);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
if (count != 0) {
MPIR_ERRTEST_ALIAS_COLL(inbuf, inoutbuf, mpi_errno);
}
MPIR_ERRTEST_NAMED_BUF_INPLACE(inbuf, "inbuf", count, mpi_errno);
MPIR_ERRTEST_NAMED_BUF_INPLACE(inoutbuf, "inoutbuf", count, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Reduce_local_impl(inbuf, inoutbuf, count, datatype, op);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_REDUCE_LOCAL);
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_reduce_local",
"**mpi_reduce_local %p %p %d %D %O", inbuf, inoutbuf, count, datatype, op);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}