/* MPIDI_CH3_SendNoncontig_iov - Sends a message by loading an
IOV and calling iSendv. The caller must initialize
sreq->dev.segment as well as segment_first and segment_size. */
int MPIDI_CH3_SendNoncontig_iov( MPIDI_VC_t *vc, MPID_Request *sreq,
void *header, MPIDI_msg_sz_t hdr_sz )
{
int mpi_errno = MPI_SUCCESS;
int iov_n;
MPL_IOV iov[MPL_IOV_LIMIT];
MPIDI_STATE_DECL(MPID_STATE_MPIDI_CH3_SENDNONCONTIG_IOV);
MPIDI_FUNC_ENTER(MPID_STATE_MPIDI_CH3_SENDNONCONTIG_IOV);
iov[0].MPL_IOV_BUF = header;
iov[0].MPL_IOV_LEN = hdr_sz;
iov_n = MPL_IOV_LIMIT - 1;
if (sreq->dev.ext_hdr_sz > 0) {
/* When extended packet header exists, here we leave one IOV slot
* before loading data to IOVs, so that there will be enough
* IOVs for hdr/ext_hdr/data. */
iov_n--;
}
mpi_errno = MPIDI_CH3U_Request_load_send_iov(sreq, &iov[1], &iov_n);
if (mpi_errno == MPI_SUCCESS)
{
iov_n += 1;
/* Note this routine is invoked withing a CH3 critical section */
/* MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex); */
mpi_errno = MPIDI_CH3_iSendv(vc, sreq, iov, iov_n);
/* MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex); */
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPID_Request_release(sreq);
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**ch3|eagermsg");
}
/* --END ERROR HANDLING-- */
/* Note that in the non-blocking case, we need to add a ref to the
datatypes */
}
else
{
/* --BEGIN ERROR HANDLING-- */
MPID_Request_release(sreq);
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**ch3|loadsendiov");
/* --END ERROR HANDLING-- */
}
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPIDI_CH3_SENDNONCONTIG_IOV);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_nem_tcp_get_business_card (int my_rank, char **bc_val_p, int *val_max_sz_p)
{
int mpi_errno = MPI_SUCCESS;
int str_errno = MPIU_STR_SUCCESS;
MPIDU_Sock_ifaddr_t ifaddr;
char ifname[MAX_HOST_DESCRIPTION_LEN];
int ret;
struct sockaddr_in sock_id;
socklen_t len;
MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_TCP_GET_BUSINESS_CARD);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_TCP_GET_BUSINESS_CARD);
mpi_errno = GetSockInterfaceAddr(my_rank, ifname, sizeof(ifname), &ifaddr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
str_errno = MPIU_Str_add_string_arg(bc_val_p, val_max_sz_p, MPIDI_CH3I_HOST_DESCRIPTION_KEY, ifname);
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPIU_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
len = sizeof(sock_id);
ret = getsockname (MPID_nem_tcp_g_lstn_sc.fd, (struct sockaddr *)&sock_id, &len);
MPIR_ERR_CHKANDJUMP1 (ret == -1, mpi_errno, MPI_ERR_OTHER, "**getsockname", "**getsockname %s", MPIU_Strerror (errno));
str_errno = MPIU_Str_add_int_arg (bc_val_p, val_max_sz_p, MPIDI_CH3I_PORT_KEY, ntohs(sock_id.sin_port));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPIU_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
if (ifaddr.len > 0 && ifaddr.type == AF_INET)
{
unsigned char *p;
p = (unsigned char *)(ifaddr.ifaddr);
MPL_snprintf( ifname, sizeof(ifname), "%u.%u.%u.%u", p[0], p[1], p[2], p[3] );
MPIU_DBG_MSG_S(CH3_CONNECT,VERBOSE,"ifname = %s",ifname );
str_errno = MPIU_Str_add_string_arg(bc_val_p, val_max_sz_p, MPIDI_CH3I_IFNAME_KEY, ifname);
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPIU_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
}
/* printf("MPID_nem_tcp_get_business_card. port=%d\n", sock_id.sin_port); */
fn_exit:
/* fprintf(stdout, "MPID_nem_tcp_get_business_card Exit, mpi_errno=%d\n", mpi_errno); fflush(stdout); */
MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_TCP_GET_BUSINESS_CARD);
return mpi_errno;
fn_fail:
goto fn_exit;
}
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
}
int MPID_Win_create(void *base, MPI_Aint size, int disp_unit, MPIR_Info * info,
MPIR_Comm * comm_ptr, MPIR_Win ** win_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPID_WIN_CREATE);
MPIR_FUNC_VERBOSE_RMA_ENTER(MPID_STATE_MPID_WIN_CREATE);
/* Check to make sure the communicator hasn't already been revoked */
if (comm_ptr->revoked) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPIX_ERR_REVOKED, "**revoked");
}
mpi_errno =
win_init(size, disp_unit, MPI_WIN_FLAVOR_CREATE, MPI_WIN_UNIFIED, info, comm_ptr, win_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
(*win_ptr)->base = base;
mpi_errno = MPIDI_CH3U_Win_fns.create(base, size, disp_unit, info, comm_ptr, win_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
fn_fail:
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPID_WIN_CREATE);
return mpi_errno;
}
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;
}
int MPIDI_CH3U_Init_sock(int has_parent, MPIDI_PG_t *pg_p, int pg_rank,
char **bc_val_p, int *val_max_sz_p)
{
int mpi_errno = MPI_SUCCESS;
int pg_size;
int p;
/* FIXME: Why are these unused? */
MPL_UNREFERENCED_ARG(has_parent);
MPL_UNREFERENCED_ARG(pg_rank);
/*
* Initialize the VCs associated with this process group (and thus
* MPI_COMM_WORLD)
*/
/* FIXME: Get the size from the process group */
pg_size = MPIDI_PG_Get_size(pg_p);
/* FIXME: This should probably be the same as MPIDI_VC_InitSock. If
not, why not? */
/* FIXME: Note that MPIDI_CH3_VC_Init sets state, sendq_head and tail.
so this should be MPIDI_CH3_VC_Init( &pg_p->vct[p] );
followed by MPIDI_VC_InitSock( ditto );
In fact, there should be a single VC_Init call here */
/* FIXME: Why isn't this MPIDI_VC_Init( vc, NULL, 0 )? */
for (p = 0; p < pg_size; p++)
{
MPIDI_CH3I_VC *vcch = &pg_p->vct[p].ch;
vcch->sendq_head = NULL;
vcch->sendq_tail = NULL;
vcch->state = MPIDI_CH3I_VC_STATE_UNCONNECTED;
vcch->sock = MPIDI_CH3I_SOCK_INVALID_SOCK;
vcch->conn = NULL;
}
mpi_errno = MPIDI_CH3U_Get_business_card_sock(pg_rank,
bc_val_p, val_max_sz_p);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER, "**init_buscard");
}
fn_exit:
return mpi_errno;
fn_fail:
/* FIXME: This doesn't belong here, since the pg is not created in
this routine */
/* --BEGIN ERROR HANDLING-- */
if (pg_p != NULL)
{
MPIDI_PG_Destroy(pg_p);
}
goto fn_exit;
/* --END ERROR HANDLING-- */
}
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;
}
/* 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;
}
int MPID_nem_mxm_get_business_card(int my_rank, char **bc_val_p, int *val_max_sz_p)
{
int mpi_errno = MPI_SUCCESS;
int str_errno = MPL_STR_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MXM_GET_BUSINESS_CARD);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MXM_GET_BUSINESS_CARD);
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, MXM_MPICH_ENDPOINT_KEY,
_mxm_obj.mxm_ep_addr, _mxm_obj.mxm_ep_addr_size);
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
fn_exit:
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MXM_GET_BUSINESS_CARD);
return mpi_errno;
fn_fail:
goto fn_exit;
}
static int mpi_to_pmi_keyvals( MPIR_Info *info_ptr, PMI_keyval_t **kv_ptr,
int *nkeys_ptr )
{
char key[MPI_MAX_INFO_KEY];
PMI_keyval_t *kv = 0;
int i, nkeys = 0, vallen, flag, mpi_errno=MPI_SUCCESS;
if (!info_ptr || info_ptr->handle == MPI_INFO_NULL) {
goto fn_exit;
}
MPIR_Info_get_nkeys_impl( info_ptr, &nkeys );
if (nkeys == 0) {
goto fn_exit;
}
kv = (PMI_keyval_t *)MPL_malloc( nkeys * sizeof(PMI_keyval_t) );
if (!kv) { MPIR_ERR_POP(mpi_errno); }
for (i=0; i<nkeys; i++) {
mpi_errno = MPIR_Info_get_nthkey_impl( info_ptr, i, key );
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
MPIR_Info_get_valuelen_impl( info_ptr, key, &vallen, &flag );
MPIR_ERR_CHKANDJUMP1(!flag, mpi_errno, MPI_ERR_OTHER,"**infonokey", "**infonokey %s", key);
kv[i].key = MPL_strdup(key);
kv[i].val = MPL_malloc( vallen + 1 );
if (!kv[i].key || !kv[i].val) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem" );
}
MPIR_Info_get_impl( info_ptr, key, vallen+1, kv[i].val, &flag );
MPIR_ERR_CHKANDJUMP1(!flag, mpi_errno, MPI_ERR_OTHER,"**infonokey", "**infonokey %s", key);
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_OTHER,TERSE,(MPL_DBG_FDEST,"key: <%s>, value: <%s>\n", kv[i].key, kv[i].val));
}
fn_fail:
fn_exit:
*kv_ptr = kv;
*nkeys_ptr = nkeys;
return mpi_errno;
}
int MPIDI_PG_To_string(MPIDI_PG_t *pg_ptr, char **str_ptr, int *lenStr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_PG_TO_STRING);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_PG_TO_STRING);
/* Replace this with the new string */
if (pg_ptr->connInfoToString) {
(*pg_ptr->connInfoToString)( str_ptr, lenStr, pg_ptr );
}
else {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_INTERN,"**noConnInfoToString");
}
/*printf( "PgToString: Pg string is %s\n", *str_ptr ); fflush(stdout);*/
fn_exit:
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_PG_TO_STRING);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPII_Genutil_sched_start(MPII_Genutil_sched_t * sched, MPIR_Comm * comm, MPIR_Request ** req)
{
int mpi_errno = MPI_SUCCESS;
int is_complete;
int made_progress;
MPIR_Request *reqp;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPII_GENUTIL_SCHED_START);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPII_GENUTIL_SCHED_START);
/* Create a request */
reqp = MPIR_Request_create(MPIR_REQUEST_KIND__COLL);
if (!reqp)
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
*req = reqp;
MPIR_Request_add_ref(reqp);
/* Make some progress */
mpi_errno = MPII_Genutil_sched_poke(sched, &is_complete, &made_progress);
if (is_complete) {
MPID_Request_complete(reqp);
goto fn_exit;
}
/* Enqueue schedule and activate progress hook if not already activated */
reqp->u.nbc.coll.sched = (void *) sched;
if (coll_queue.head == NULL)
MPID_Progress_activate_hook(MPII_Genutil_progress_hook_id);
DL_APPEND(coll_queue.head, &(reqp->u.nbc.coll));
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPII_GENUTIL_SCHED_START);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/* MPIDI_CH3_RndvSend - Send a request to perform a rendezvous send */
int MPIDI_CH3_RndvSend( MPIR_Request **sreq_p, const void * buf, MPI_Aint count,
MPI_Datatype datatype, int dt_contig, intptr_t data_sz,
MPI_Aint dt_true_lb,
int rank,
int tag, MPIR_Comm * comm, int context_offset )
{
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_rndv_req_to_send_t * const rts_pkt = &upkt.rndv_req_to_send;
MPIDI_VC_t * vc;
MPIR_Request * rts_sreq;
MPIR_Request *sreq =*sreq_p;
int mpi_errno = MPI_SUCCESS;
MPL_DBG_MSG_D(MPIDI_CH3_DBG_OTHER,VERBOSE,
"sending rndv RTS, data_sz=%" PRIdPTR, data_sz);
sreq->dev.OnDataAvail = 0;
sreq->dev.partner_request = NULL;
MPIDI_Pkt_init(rts_pkt, MPIDI_CH3_PKT_RNDV_REQ_TO_SEND);
rts_pkt->match.parts.rank = comm->rank;
rts_pkt->match.parts.tag = tag;
rts_pkt->match.parts.context_id = comm->context_id + context_offset;
rts_pkt->sender_req_id = sreq->handle;
rts_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(rts_pkt, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
MPL_DBG_MSGPKT(vc,tag,rts_pkt->match.parts.context_id,rank,data_sz,"Rndv");
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, rts_pkt, sizeof(*rts_pkt), &rts_sreq);
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|rtspkt");
}
/* --END ERROR HANDLING-- */
if (rts_sreq != NULL)
{
if (rts_sreq->status.MPI_ERROR != MPI_SUCCESS)
{
MPIR_Request_free(sreq);
*sreq_p = NULL;
mpi_errno = rts_sreq->status.MPI_ERROR;
MPIR_Request_free(rts_sreq);
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**ch3|rtspkt");
}
MPIR_Request_free(rts_sreq);
}
/* FIXME: fill temporary IOV or pack temporary buffer after send to hide
some latency. This requires synchronization
because the CTS packet could arrive and be processed before the above
iStartmsg completes (depending on the progress
engine, threads, etc.). */
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Unpublish_name - Unpublish a service name published with
MPI_Publish_name
Input Parameters:
+ service_name - a service name (string)
. info - implementation-specific information (handle)
- port_name - a port name (string)
.N ThreadSafeNoUpdate
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_INFO
.N MPI_ERR_ARG
.N MPI_ERR_OTHER
@*/
int MPI_Unpublish_name(const char *service_name, MPI_Info info, const char *port_name)
{
static const char FCNAME[] = "MPI_Unpublish_name";
int mpi_errno = MPI_SUCCESS;
MPID_Info *info_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_UNPUBLISH_NAME);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_UNPUBLISH_NAME);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_INFO_OR_NULL(info, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Info_get_ptr( info, info_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate info_ptr (only if not null) */
if (info_ptr)
MPID_Info_valid_ptr( info_ptr, mpi_errno );
MPIR_ERRTEST_ARGNULL( service_name, "service_name", mpi_errno );
MPIR_ERRTEST_ARGNULL( port_name, "port_name", mpi_errno );
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
# ifdef HAVE_NAMEPUB_SERVICE
{
/* The standard leaves explicitly undefined what happens if the code
attempts to unpublish a name that is not published. In this case,
MPI_Unpublish_name could be called before a name service structure
is allocated. */
if (!MPIR_Namepub)
{
mpi_errno = MPID_NS_Create( info_ptr, &MPIR_Namepub );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIR_Add_finalize( (int (*)(void*))MPID_NS_Free, &MPIR_Namepub, 9 );
}
mpi_errno = MPID_NS_Unpublish( MPIR_Namepub, info_ptr,
(const char *)service_name );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
# else
{
/* No name publishing service available */
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nonamepub");
}
# endif
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_UNPUBLISH_NAME);
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_unpublish_name",
"**mpi_unpublish_name %s %I %s", service_name, info, port_name);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Alltoallv - Sends data from all to all processes; each process may
send a different amount of data and provide displacements for the input
and output data.
Input Parameters:
+ sendbuf - starting address of send buffer (choice)
. sendcounts - integer array equal to the group size
specifying the number of elements to send to each processor
. sdispls - integer array (of length group size). Entry
'j' specifies the displacement (relative to sendbuf from
which to take the outgoing data destined for process 'j'
. sendtype - data type of send buffer elements (handle)
. recvcounts - integer array equal to the group size
specifying the maximum number of elements that can be received from
each processor
. rdispls - integer array (of length group size). Entry
'i' specifies the displacement (relative to recvbuf at
which to place the incoming data from process 'i'
. recvtype - data type of receive buffer elements (handle)
- comm - communicator (handle)
Output Parameters:
. recvbuf - address of receive buffer (choice)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_BUFFER
@*/
int MPI_Alltoallv(const void *sendbuf, const int *sendcounts,
const int *sdispls, MPI_Datatype sendtype, void *recvbuf,
const int *recvcounts, const int *rdispls, MPI_Datatype recvtype,
MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLTOALLV);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLTOALLV);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL;
int i, comm_size;
int check_send = (comm_ptr->comm_kind == MPID_INTRACOMM && sendbuf != MPI_IN_PLACE);
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (comm_ptr->comm_kind == MPID_INTRACOMM) {
comm_size = comm_ptr->local_size;
if (sendbuf != MPI_IN_PLACE && sendtype == recvtype && sendcounts == recvcounts)
MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno);
} else
comm_size = comm_ptr->remote_size;
if (comm_ptr->comm_kind == MPID_INTERCOMM && sendbuf == MPI_IN_PLACE) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace");
}
for (i=0; i<comm_size; i++) {
if (check_send) {
MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
}
MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
}
if (check_send && HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
for (i=0; i<comm_size && check_send; i++) {
if (sendcounts[i] > 0) {
MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno);
}
}
for (i=0; i<comm_size; i++) {
if (recvcounts[i] > 0) {
MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno);
MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno);
break;
}
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Alltoallv_impl(sendbuf, sendcounts, sdispls,
sendtype, recvbuf, recvcounts,
rdispls, recvtype, comm_ptr, &errflag);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLTOALLV);
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_alltoallv",
"**mpi_alltoallv %p %p %p %D %p %p %p %D %C", sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPID_Send(const void * buf, MPI_Aint count, MPI_Datatype datatype, int rank,
int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPIDI_msg_sz_t data_sz;
int dt_contig;
MPI_Aint dt_true_lb;
MPID_Datatype * dt_ptr;
MPID_Request * sreq = NULL;
MPIDI_VC_t * vc;
#if defined(MPID_USE_SEQUENCE_NUMBERS)
MPID_Seqnum_t seqnum;
#endif
int eager_threshold = -1;
int mpi_errno = MPI_SUCCESS;
#if defined(FINEGRAIN_MPI)
int destpid=-1, destworldrank=-1;
#endif
MPIDI_STATE_DECL(MPID_STATE_MPID_SEND);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_SEND);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"rank=%d, tag=%d, context=%d",
rank, tag, comm->context_id + context_offset));
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked &&
MPIR_AGREE_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask) &&
MPIR_SHRINK_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask)) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
#if defined(FINEGRAIN_MPI)
MPIDI_Comm_get_pid_worldrank(comm, rank, &destpid, &destworldrank);
if (COMPARE_RANKS(rank,comm,destpid) && comm->comm_kind != MPID_INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(&buf, count, datatype, rank, tag, comm,
context_offset, MPIDI_REQUEST_TYPE_SEND,
&sreq);
if (rank == comm->rank)
{
printf("my_fgrank=%d: %s, self send DEADLOCK\n", my_fgrank, __FUNCTION__);
if (sreq != NULL && sreq->cc != 0) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,
"**dev|selfsenddeadlock");
}
}
#else
if (rank == comm->rank && comm->comm_kind != MPID_INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(buf, count, datatype, rank, tag, comm,
context_offset, MPIDI_REQUEST_TYPE_SEND,
&sreq);
/* In the single threaded case, sending to yourself will cause
deadlock. Note that in the runtime-thread case, this check
will not be made (long-term FIXME) */
# ifndef MPICH_IS_THREADED
{
if (sreq != NULL && MPID_cc_get(sreq->cc) != 0) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,
"**dev|selfsenddeadlock");
}
}
# endif
#endif
if (mpi_errno != MPI_SUCCESS) { MPIR_ERR_POP(mpi_errno); }
goto fn_exit;
}
if (rank == MPI_PROC_NULL)
{
goto fn_exit;
}
#if defined(FINEGRAIN_MPI)
MPIDI_Comm_get_vc_set_active_direct(comm, destpid, &vc);
#else
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
#endif
MPIR_ERR_CHKANDJUMP1(vc->state == MPIDI_VC_STATE_MORIBUND, mpi_errno, MPIX_ERR_PROC_FAILED, "**comm_fail", "**comm_fail %d", rank);
#ifdef ENABLE_COMM_OVERRIDES
if (vc->comm_ops && vc->comm_ops->send)
{
mpi_errno = vc->comm_ops->send( vc, buf, count, datatype, rank, tag, comm, context_offset, &sreq);
goto fn_exit;
}
#endif
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr,
dt_true_lb);
if (data_sz == 0)
{
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_send_t * const eager_pkt = &upkt.eager_send;
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,"sending zero length message");
MPIDI_Pkt_init(eager_pkt, MPIDI_CH3_PKT_EAGER_SEND);
#if defined(FINEGRAIN_MPI)
eager_pkt->match.parts.dest_rank = destworldrank;
#endif
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 = 0;
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(eager_pkt, seqnum);
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, eager_pkt, sizeof(*eager_pkt), &sreq);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**ch3|eagermsg");
}
/* --END ERROR HANDLING-- */
if (sreq != NULL)
{
MPIDI_Request_set_seqnum(sreq, seqnum);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
/* sreq->comm = comm;
MPIR_Comm_add_ref(comm); -- not necessary for blocking functions */
}
goto fn_exit;
}
MPIDI_CH3_GET_EAGER_THRESHOLD(&eager_threshold, comm, vc);
/* FIXME: flow control: limit number of outstanding eager messages
containing data and need to be buffered by the receiver */
#ifdef USE_EAGER_SHORT
if (dt_contig && data_sz <= MPIDI_EAGER_SHORT_SIZE) {
mpi_errno = MPIDI_CH3_EagerContigShortSend( &sreq,
MPIDI_CH3_PKT_EAGERSHORT_SEND,
(char *)buf + dt_true_lb,
data_sz, rank, tag, comm,
context_offset );
}
else
#endif
if (data_sz + sizeof(MPIDI_CH3_Pkt_eager_send_t) <= eager_threshold)
{
if (dt_contig)
{
mpi_errno = MPIDI_CH3_EagerContigSend( &sreq,
MPIDI_CH3_PKT_EAGER_SEND,
(char *)buf + dt_true_lb,
data_sz, rank, tag, comm,
context_offset );
}
else
{
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
mpi_errno = MPIDI_CH3_EagerNoncontigSend( &sreq,
MPIDI_CH3_PKT_EAGER_SEND,
buf, count, datatype,
data_sz, rank, tag,
comm, context_offset );
}
}
else
{
/*@
MPI_Fetch_and_op - Perform one-sided read-modify-write.
Accumulate one element of type datatype from the origin buffer (origin_addr) to
the buffer at offset target_disp, in the target window specified by target_rank
and win, using the operation op and return in the result buffer result_addr the
content of the target buffer before the accumulation.
Input Parameters:
+ origin_addr - initial address of buffer (choice)
. result_addr - initial address of result buffer (choice)
. datatype - datatype of the entry in origin, result, and target buffers (handle)
. target_rank - rank of target (nonnegative integer)
. target_disp - displacement from start of window to beginning of target buffer (non-negative integer)
. op - reduce operation (handle)
- win - window object (handle)
Notes:
This operations is atomic with respect to other "accumulate" operations.
The generic functionality of 'MPI_Get_accumulate' might limit the performance of
fetch-and-increment or fetch-and-add calls that might be supported by special
hardware operations. 'MPI_Fetch_and_op' thus allows for a fast implementation
of a commonly used subset of the functionality of 'MPI_Get_accumulate'.
The origin and result buffers (origin_addr and result_addr) must be disjoint.
Any of the predefined operations for 'MPI_Reduce', as well as 'MPI_NO_OP' or
'MPI_REPLACE', can be specified as op; user-defined functions cannot be used. The
datatype argument must be a predefined datatype.
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
.N MPI_ERR_COUNT
.N MPI_ERR_OP
.N MPI_ERR_RANK
.N MPI_ERR_TYPE
.N MPI_ERR_WIN
.seealso: MPI_Get_accumulate
@*/
int MPI_Fetch_and_op(const void *origin_addr, void *result_addr,
MPI_Datatype datatype, int target_rank, MPI_Aint target_disp,
MPI_Op op, MPI_Win win)
{
static const char FCNAME[] = "MPI_Fetch_and_op";
int mpi_errno = MPI_SUCCESS;
MPIR_Win *win_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_FETCH_AND_OP);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_RMA_ENTER(MPID_STATE_MPI_FETCH_AND_OP);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_WIN(win, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Win_get_ptr( win, win_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Comm *comm_ptr;
/* Validate win_ptr */
MPIR_Win_valid_ptr( win_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
if (op != MPI_NO_OP) {
/* NOTE: when op is MPI_NO_OP, origin_addr is allowed to be NULL.
* In such case, MPI_Fetch_and_op equals to an atomic GET. */
MPIR_ERRTEST_ARGNULL(origin_addr, "origin_addr", mpi_errno);
}
MPIR_ERRTEST_ARGNULL(result_addr, "result_addr", mpi_errno);
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
if (!MPIR_DATATYPE_IS_PREDEFINED(datatype))
{
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_TYPE, "**typenotpredefined");
}
if (win_ptr->create_flavor != MPI_WIN_FLAVOR_DYNAMIC)
MPIR_ERRTEST_DISP(target_disp, mpi_errno);
comm_ptr = win_ptr->comm_ptr;
MPIR_ERRTEST_SEND_RANK(comm_ptr, target_rank, mpi_errno);
MPIR_ERRTEST_OP_GACC(op, mpi_errno);
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN)
{
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OP, "**opnotpredefined");
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Fetch_and_op(origin_addr,
result_addr, datatype,
target_rank, target_disp,
op, win_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_RMA_EXIT(MPID_STATE_MPI_FETCH_AND_OP);
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_fetch_and_op",
"**mpi_fetch_and_op %p %p %D %d %d %O %W", origin_addr,
result_addr, datatype, target_rank, target_disp, op, win);
}
# endif
mpi_errno = MPIR_Err_return_win( win_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPID_Mprobe(int source, int tag, MPID_Comm *comm, int context_offset,
MPID_Request **message, MPI_Status *status)
{
int mpi_errno = MPI_SUCCESS;
MPID_Progress_state progress_state;
int found = FALSE;
int context_id = comm->recvcontext_id + context_offset;
*message = NULL;
if (source == MPI_PROC_NULL)
{
MPIR_Status_set_procnull(status);
found = TRUE;
*message = NULL; /* should be interpreted as MPI_MESSAGE_NO_PROC */
goto fn_exit;
}
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
#ifdef ENABLE_COMM_OVERRIDES
if (MPIDI_Anysource_improbe_fn) {
if (source == MPI_ANY_SOURCE) {
/* if it's anysource, loop while checking the shm recv
queue and improbing the netmod, then do a progress
test to make some progress. */
do {
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_MSGQ_MUTEX);
*message = MPIDI_CH3U_Recvq_FDU_matchonly(source, tag, context_id, comm,&found);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_MSGQ_MUTEX);
if (found) goto fn_exit;
mpi_errno = MPIDI_Anysource_improbe_fn(tag, comm, context_offset, &found, message, status);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
if (found) goto fn_exit;
MPID_THREAD_CS_YIELD(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
/* FIXME could this be replaced with a progress_wait? */
mpi_errno = MPIDI_CH3_Progress_test();
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
} while (1);
}
else {
/* it's not anysource, see if this is for the netmod */
MPIDI_VC_t * vc;
MPIDI_Comm_get_vc_set_active(comm, source, &vc);
if (vc->comm_ops && vc->comm_ops->improbe) {
/* netmod has overridden improbe */
do {
mpi_errno = vc->comm_ops->improbe(vc, source, tag, comm, context_offset, &found,
message, status);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
if (found) goto fn_exit;
MPID_THREAD_CS_YIELD(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
/* FIXME could this be replaced with a progress_wait? */
mpi_errno = MPIDI_CH3_Progress_test();
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
} while (1);
}
/* fall-through to shm case */
}
}
#endif
/* Inefficient implementation: we poll the unexpected queue looking for a
* matching request, interleaved with calls to progress. If there are many
* non-matching unexpected messages in the queue then we will end up
* needlessly scanning the UQ.
*
* A smarter implementation would enqueue a partial request (one lacking the
* recv buffer triple) onto the PQ. Unfortunately, this is a lot harder to
* do than it seems at first because of the spread-out nature of callers to
* various CH3U_Recvq routines and especially because of the enqueue/dequeue
* hooks for native MX tag matching support. */
MPIDI_CH3_Progress_start(&progress_state);
do
{
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_MSGQ_MUTEX);
*message = MPIDI_CH3U_Recvq_FDU_matchonly(source, tag, context_id, comm, &found);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_MSGQ_MUTEX);
if (found)
break;
mpi_errno = MPIDI_CH3_Progress_wait(&progress_state);
}
while(mpi_errno == MPI_SUCCESS);
MPIDI_CH3_Progress_end(&progress_state);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
if (*message) {
(*message)->kind = MPID_REQUEST_MPROBE;
MPIR_Request_extract_status((*message), status);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_Rsend(const void * buf, int count, MPI_Datatype datatype, int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPIDI_msg_sz_t data_sz;
int dt_contig;
MPI_Aint dt_true_lb;
MPID_Datatype * dt_ptr;
MPID_Request * sreq = NULL;
MPIDI_VC_t * vc;
#if defined(MPID_USE_SEQUENCE_NUMBERS)
MPID_Seqnum_t seqnum;
#endif
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_RSEND);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_RSEND);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"rank=%d, tag=%d, context=%d",
rank, tag, comm->context_id + context_offset));
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked &&
MPIR_AGREE_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask) &&
MPIR_SHRINK_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask)) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
if (rank == comm->rank && comm->comm_kind != MPID_INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(buf, count, datatype, rank, tag, comm, context_offset, MPIDI_REQUEST_TYPE_RSEND, &sreq);
goto fn_exit;
}
if (rank == MPI_PROC_NULL)
{
goto fn_exit;
}
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
#ifdef ENABLE_COMM_OVERRIDES
if (vc->comm_ops && vc->comm_ops->rsend)
{
mpi_errno = vc->comm_ops->rsend( vc, buf, count, datatype, rank, tag, comm, context_offset, &sreq);
goto fn_exit;
}
#endif
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr, dt_true_lb);
if (data_sz == 0)
{
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_ready_send_t * const ready_pkt = &upkt.ready_send;
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,"sending zero length message");
MPIDI_Pkt_init(ready_pkt, MPIDI_CH3_PKT_READY_SEND);
ready_pkt->match.parts.rank = comm->rank;
ready_pkt->match.parts.tag = tag;
ready_pkt->match.parts.context_id = comm->context_id + context_offset;
ready_pkt->sender_req_id = MPI_REQUEST_NULL;
ready_pkt->data_sz = data_sz;
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(ready_pkt, seqnum);
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, ready_pkt, sizeof(*ready_pkt), &sreq);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**ch3|eagermsg", 0);
goto fn_exit;
}
/* --END ERROR HANDLING-- */
if (sreq != NULL)
{
MPIDI_Request_set_seqnum(sreq, seqnum);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_RSEND);
/* sreq->comm = comm;
MPIR_Comm_add_ref(comm); -- not needed for blocking operations */
}
goto fn_exit;
}
if (vc->ready_eager_max_msg_sz < 0 || data_sz + sizeof(MPIDI_CH3_Pkt_ready_send_t) <= vc->ready_eager_max_msg_sz) {
if (dt_contig)
{
mpi_errno = MPIDI_CH3_EagerContigSend( &sreq,
MPIDI_CH3_PKT_READY_SEND,
(char *)buf + dt_true_lb,
data_sz, rank, tag, comm,
context_offset );
}
else
{
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
mpi_errno = MPIDI_CH3_EagerNoncontigSend( &sreq,
MPIDI_CH3_PKT_READY_SEND,
buf, count, datatype,
data_sz, rank, tag,
comm, context_offset );
}
} else {
int MPID_Issend(const void * buf, int count, MPI_Datatype datatype, int rank, int tag, MPIR_Comm * comm, int context_offset,
MPIR_Request ** request)
{
intptr_t data_sz;
int dt_contig;
MPI_Aint dt_true_lb;
MPIR_Datatype* dt_ptr;
MPIR_Request * sreq;
MPIDI_VC_t * vc=0;
#if defined(MPID_USE_SEQUENCE_NUMBERS)
MPID_Seqnum_t seqnum;
#endif
int eager_threshold = -1;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPID_ISSEND);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPID_ISSEND);
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_OTHER,VERBOSE,(MPL_DBG_FDEST,
"rank=%d, tag=%d, context=%d",
rank, tag, comm->context_id + context_offset));
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked &&
MPIR_AGREE_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_TAG_COLL_BIT) &&
MPIR_SHRINK_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_TAG_COLL_BIT)) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
if (rank == comm->rank && comm->comm_kind != MPIR_COMM_KIND__INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(buf, count, datatype, rank, tag, comm, context_offset, MPIDI_REQUEST_TYPE_SSEND, &sreq);
goto fn_exit;
}
if (rank != MPI_PROC_NULL)
{
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
/* this needs to come before the sreq is created, since the override */
/* function is responsible for creating its own request */
#ifdef ENABLE_COMM_OVERRIDES
if (vc->comm_ops && vc->comm_ops->issend)
{
mpi_errno = vc->comm_ops->issend( vc, buf, count, datatype, rank, tag, comm, context_offset, &sreq);
goto fn_exit;
}
#endif
}
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SSEND);
if (rank == MPI_PROC_NULL)
{
MPIR_Object_set_ref(sreq, 1);
MPIR_cc_set(&sreq->cc, 0);
goto fn_exit;
}
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr, dt_true_lb);
if (data_sz == 0)
{
mpi_errno = MPIDI_CH3_EagerSyncZero( &sreq, rank, tag, comm,
context_offset );
goto fn_exit;
}
MPIDI_CH3_GET_EAGER_THRESHOLD(&eager_threshold, comm, vc);
if (data_sz + sizeof(MPIDI_CH3_Pkt_eager_sync_send_t) <= eager_threshold)
{
mpi_errno = MPIDI_CH3_EagerSyncNoncontigSend( &sreq, buf, count,
datatype, data_sz,
dt_contig, dt_true_lb,
rank, tag, comm,
context_offset );
/* If we're not complete and this is a derived datatype
* communication, then add a reference to the datatype */
if (sreq && (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)) {
sreq->dev.datatype_ptr = dt_ptr;
MPIR_Datatype_ptr_add_ref(dt_ptr);
}
}
else
{
/* Note that the sreq was created above */
MPIDI_Request_set_msg_type(sreq, MPIDI_REQUEST_RNDV_MSG);
mpi_errno = vc->rndvSend_fn( &sreq, buf, count, datatype, dt_contig,
data_sz, dt_true_lb, rank, tag, comm,
context_offset );
/* FIXME: fill temporary IOV or pack temporary buffer after send to
hide some latency. This requires synchronization
because the CTS packet could arrive and be processed before the
above iStartmsg completes (depending on the progress
engine, threads, etc.). */
if (sreq && dt_ptr != NULL)
{
sreq->dev.datatype_ptr = dt_ptr;
MPIR_Datatype_ptr_add_ref(dt_ptr);
}
}
fn_exit:
*request = sreq;
MPL_DBG_STMT(MPIDI_CH3_DBG_OTHER,VERBOSE,
{
if (sreq != NULL) {
MPL_DBG_MSG_P(MPIDI_CH3_DBG_OTHER,VERBOSE,
"request allocated, handle=0x%08x", sreq->handle);
}
}
)
/*@
MPI_Ialltoallw - Nonblocking generalized all-to-all communication allowing
different datatypes, counts, and displacements for each partner
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. sendcounts - non-negative integer array (of length group size) specifying the number of elements to send to each processor
. sdispls - integer array (of length group size). Entry j specifies the displacement relative to sendbuf from which to take the outgoing data destined for process j
. sendtypes - array of datatypes (of length group size). Entry j specifies the type of data to send to process j (array of handles)
. recvcounts - non-negative integer array (of length group size) specifying the number of elements that can be received from each processor
. rdispls - integer array (of length group size). Entry i specifies the displacement relative to recvbuf at which to place the incoming data from process i
. recvtypes - array of datatypes (of length group size). Entry i specifies the type of data received from process i (array of handles)
- comm - communicator (handle)
Output Parameters:
+ recvbuf - starting address of the receive buffer (choice)
- request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[],
const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[],
const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm,
MPI_Request *request)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Request *request_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IALLTOALLW);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IALLTOALLW);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (sendbuf != MPI_IN_PLACE) {
MPIR_ERRTEST_ARGNULL(sendcounts,"sendcounts", mpi_errno);
MPIR_ERRTEST_ARGNULL(sdispls,"sdispls", mpi_errno);
MPIR_ERRTEST_ARGNULL(sendtypes,"sendtypes", mpi_errno);
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM &&
sendcounts == recvcounts &&
sendtypes == recvtypes)
MPIR_ERRTEST_ALIAS_COLL(sendbuf,recvbuf,mpi_errno);
}
MPIR_ERRTEST_ARGNULL(recvcounts,"recvcounts", mpi_errno);
MPIR_ERRTEST_ARGNULL(rdispls,"rdispls", mpi_errno);
MPIR_ERRTEST_ARGNULL(recvtypes,"recvtypes", mpi_errno);
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM && sendbuf == MPI_IN_PLACE) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace");
}
MPIR_ERRTEST_ARGNULL(request,"request", mpi_errno);
/* TODO more checks may be appropriate (counts, in_place, etc) */
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Ialltoallw(sendbuf, sendcounts, sdispls, sendtypes, recvbuf,
recvcounts, rdispls, recvtypes, comm_ptr, &request_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* return the handle of the request to the user */
if(request_ptr)
*request = request_ptr->handle;
else *request = MPI_REQUEST_NULL;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IALLTOALLW);
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_ialltoallw", "**mpi_ialltoallw %p %p %p %p %p %p %p %p %C %p", sendbuf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, comm, request);
}
# endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIDI_CH3_iStartMsgv(MPIDI_VC_t * vc, MPL_IOV * iov, int n_iov, MPIR_Request ** sreq_ptr)
{
MPIR_Request *sreq = NULL;
MPIDI_CH3I_VC *vcch = &vc->ch;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3_ISTARTMSGV);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3_ISTARTMSGV);
MPIR_Assert(n_iov <= MPL_IOV_LIMIT);
/* The SOCK channel uses a fixed length header, the size of which is the
* maximum of all possible packet headers */
iov[0].MPL_IOV_LEN = sizeof(MPIDI_CH3_Pkt_t);
MPL_DBG_STMT(MPIDI_CH3_DBG_CHANNEL, VERBOSE,
MPIDI_DBG_Print_packet((MPIDI_CH3_Pkt_t *) iov[0].MPL_IOV_BUF));
if (vcch->state == MPIDI_CH3I_VC_STATE_CONNECTED) { /* MT */
/* Connection already formed. If send queue is empty attempt to send
* data, queuing any unsent data. */
if (MPIDI_CH3I_SendQ_empty(vcch)) { /* MT */
int rc;
size_t nb;
MPL_DBG_MSG(MPIDI_CH3_DBG_CHANNEL, VERBOSE, "send queue empty, attempting to write");
MPL_DBG_PKT(vcch->conn, (MPIDI_CH3_Pkt_t *) iov[0].MPL_IOV_BUF, "isend");
/* MT - need some signalling to lock down our right to use the
* channel, thus insuring that the progress engine does
* also try to write */
rc = MPIDI_CH3I_Sock_writev(vcch->sock, iov, n_iov, &nb);
if (rc == MPI_SUCCESS) {
int offset = 0;
MPL_DBG_MSG_D(MPIDI_CH3_DBG_CHANNEL, VERBOSE,
"wrote %ld bytes", (unsigned long) nb);
while (offset < n_iov) {
if (nb >= (int) iov[offset].MPL_IOV_LEN) {
nb -= iov[offset].MPL_IOV_LEN;
offset++;
} else {
MPL_DBG_MSG(MPIDI_CH3_DBG_CHANNEL, VERBOSE,
"partial write, request enqueued at head");
sreq = create_request(iov, n_iov, offset, nb);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_CH3I_SendQ_enqueue_head(vcch, sreq);
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_CHANNEL, VERBOSE,
(MPL_DBG_FDEST, "posting writev, vc=0x%p, sreq=0x%08x", vc,
sreq->handle));
vcch->conn->send_active = sreq;
mpi_errno =
MPIDI_CH3I_Sock_post_writev(vcch->conn->sock, sreq->dev.iov + offset,
sreq->dev.iov_count - offset, NULL);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS) {
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_FATAL, __func__, __LINE__,
MPI_ERR_OTHER, "**ch3|sock|postwrite",
"ch3|sock|postwrite %p %p %p", sreq,
vcch->conn, vc);
}
/* --END ERROR HANDLING-- */
break;
}
}
if (offset == n_iov) {
MPL_DBG_MSG(MPIDI_CH3_DBG_CHANNEL, VERBOSE, "entire write complete");
}
}
/* --BEGIN ERROR HANDLING-- */
else {
MPL_DBG_MSG_D(MPIDI_CH3_DBG_CHANNEL, TYPICAL,
"ERROR - MPIDI_CH3I_Sock_writev failed, rc=%d", rc);
sreq = MPIR_Request_create(MPIR_REQUEST_KIND__SEND);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIR_cc_set(&(sreq->cc), 0);
sreq->status.MPI_ERROR = MPIR_Err_create_code(rc,
MPIR_ERR_RECOVERABLE, __func__,
__LINE__, MPI_ERR_INTERN,
"**ch3|sock|writefailed",
"**ch3|sock|writefailed %d", rc);
/* Make sure that the caller sees this error */
mpi_errno = sreq->status.MPI_ERROR;
}
/* --END ERROR HANDLING-- */
} else {
MPL_DBG_MSG(MPIDI_CH3_DBG_CHANNEL, VERBOSE, "send in progress, request enqueued");
sreq = create_request(iov, n_iov, 0, 0);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_CH3I_SendQ_enqueue(vcch, sreq);
}
} else if (vcch->state == MPIDI_CH3I_VC_STATE_CONNECTING) {
MPL_DBG_VCUSE(vc, "connecting. enqueuing request");
/* queue the data so it can be sent after the connection is formed */
sreq = create_request(iov, n_iov, 0, 0);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_CH3I_SendQ_enqueue(vcch, sreq);
} else if (vcch->state == MPIDI_CH3I_VC_STATE_UNCONNECTED) {
MPL_DBG_VCUSE(vc, "unconnected. posting connect and enqueuing request");
/* queue the data so it can be sent after the connection is formed */
sreq = create_request(iov, n_iov, 0, 0);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_CH3I_SendQ_enqueue(vcch, sreq);
/* Form a new connection */
MPIDI_CH3I_VC_post_connect(vc);
} else if (vcch->state != MPIDI_CH3I_VC_STATE_FAILED) {
/* Unable to send data at the moment, so queue it for later */
MPL_DBG_VCUSE(vc, "forming connection, request enqueued");
sreq = create_request(iov, n_iov, 0, 0);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_CH3I_SendQ_enqueue(vcch, sreq);
}
/* --BEGIN ERROR HANDLING-- */
else {
/* Connection failed, so allocate a request and return an error. */
MPL_DBG_VCUSE(vc, "ERROR - connection failed");
sreq = MPIR_Request_create(MPIR_REQUEST_KIND__SEND);
if (sreq == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIR_cc_set(&(sreq->cc), 0);
sreq->status.MPI_ERROR = MPIR_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, __func__, __LINE__,
MPI_ERR_INTERN, "**ch3|sock|connectionfailed",
0);
/* Make sure that the caller sees this error */
mpi_errno = sreq->status.MPI_ERROR;
}
/* --END ERROR HANDLING-- */
fn_fail:
*sreq_ptr = sreq;
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3_ISTARTMSGV);
return mpi_errno;
}
int MPID_Ssend(const void * buf, MPI_Aint count, MPI_Datatype datatype, int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPIDI_msg_sz_t data_sz;
int dt_contig;
MPI_Aint dt_true_lb;
MPID_Datatype * dt_ptr;
MPID_Request * sreq = NULL;
MPIDI_VC_t * vc;
#if defined(MPID_USE_SEQUENCE_NUMBERS)
MPID_Seqnum_t seqnum;
#endif
int eager_threshold = -1;
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_SSEND);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_SSEND);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"rank=%d, tag=%d, context=%d",
rank, tag, comm->context_id + context_offset));
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked &&
MPIR_AGREE_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask) &&
MPIR_SHRINK_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask)) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
if (rank == comm->rank && comm->comm_kind != MPID_INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(buf, count, datatype, rank, tag, comm,
context_offset, MPIDI_REQUEST_TYPE_SSEND,
&sreq);
/* In the single threaded case, sending to yourself will cause
deadlock. Note that in the runtime-thread case, this check
will not be made (long-term FIXME) */
# ifndef MPICH_IS_THREADED
{
/* --BEGIN ERROR HANDLING-- */
if (sreq != NULL && MPID_cc_get(sreq->cc) != 0)
{
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**dev|selfsenddeadlock", 0);
goto fn_exit;
}
/* --END ERROR HANDLING-- */
}
# endif
goto fn_exit;
}
if (rank == MPI_PROC_NULL)
{
goto fn_exit;
}
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
#ifdef ENABLE_COMM_OVERRIDES
if (vc->comm_ops && vc->comm_ops->ssend)
{
mpi_errno = vc->comm_ops->ssend( vc, buf, count, datatype, rank, tag, comm, context_offset, &sreq);
goto fn_exit;
}
#endif
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr, dt_true_lb);
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SSEND);
if (data_sz == 0)
{
mpi_errno = MPIDI_CH3_EagerSyncZero( &sreq, rank, tag, comm,
context_offset );
goto fn_exit;
}
MPIDI_CH3_GET_EAGER_THRESHOLD(&eager_threshold, comm, vc);
if (data_sz + sizeof(MPIDI_CH3_Pkt_eager_sync_send_t) <= eager_threshold)
{
mpi_errno = MPIDI_CH3_EagerSyncNoncontigSend( &sreq, buf, count,
datatype, data_sz,
dt_contig, dt_true_lb,
rank, tag, comm,
context_offset );
}
else
{
/* Note that the sreq was created above */
mpi_errno = vc->rndvSend_fn( &sreq, buf, count, datatype, dt_contig,
data_sz, dt_true_lb, rank, tag, comm,
context_offset );
/* Note that we don't increase the ref cound on the datatype
because this is a blocking call, and the calling routine
must wait until sreq completes */
}
fn_fail:
fn_exit:
*request = sreq;
MPIU_DBG_STMT(CH3_OTHER,VERBOSE,{if (sreq!=NULL) {
MPIU_DBG_MSG_P(CH3_OTHER,VERBOSE,
"request allocated, handle=0x%08x", sreq->handle);}});
int MPIDI_CH3_PktHandler_RndvReqToSend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt,
MPIDI_msg_sz_t *buflen, MPID_Request **rreqp )
{
MPID_Request * rreq;
int found;
MPIDI_CH3_Pkt_rndv_req_to_send_t * rts_pkt = &pkt->rndv_req_to_send;
int mpi_errno = MPI_SUCCESS;
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"received rndv RTS pkt, sreq=0x%08x, rank=%d, tag=%d, context=%d, data_sz=" MPIDI_MSG_SZ_FMT,
rts_pkt->sender_req_id, rts_pkt->match.parts.rank,
rts_pkt->match.parts.tag,
rts_pkt->match.parts.context_id, rts_pkt->data_sz));
MPIU_DBG_MSGPKT(vc,rts_pkt->match.parts.tag,rts_pkt->match.parts.context_id,
rts_pkt->match.parts.rank,rts_pkt->data_sz,
"ReceivedRndv");
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_MSGQ_MUTEX);
rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&rts_pkt->match, &found);
MPIR_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp());
/* If the completion counter is 0, that means that the communicator to
* which this message is being sent has been revoked and we shouldn't
* bother finishing this. */
if (!found && MPID_cc_get(rreq->cc) == 0) {
*rreqp = NULL;
goto fn_fail;
}
set_request_info(rreq, rts_pkt, MPIDI_REQUEST_RNDV_MSG);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_MSGQ_MUTEX);
*buflen = sizeof(MPIDI_CH3_Pkt_t);
if (found)
{
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,"posted request found");
/* FIXME: What if the receive user buffer is not big enough to
hold the data about to be cleared for sending? */
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,"sending rndv CTS packet");
MPIDI_Pkt_init(cts_pkt, MPIDI_CH3_PKT_RNDV_CLR_TO_SEND);
cts_pkt->sender_req_id = rts_pkt->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) {
MPID_Request_release(cts_req);
}
}
else
{
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,"unexpected request allocated");
/*
* A MPID_Probe() may be waiting for the request we just
* inserted, so we need to tell the progress engine to exit.
*
* FIXME: This will cause MPID_Progress_wait() to return to the
* MPI layer each time an unexpected RTS packet is
* received. MPID_Probe() should atomically increment a
* counter and MPIDI_CH3_Progress_signal_completion()
* should only be called if that counter is greater than zero.
*/
MPIDI_CH3_Progress_signal_completion();
}
*rreqp = NULL;
fn_fail:
return mpi_errno;
}
/* Translate the control message to get a huge message into a request to
* actually perform the data transfer. */
static inline int MPIDI_OFI_get_huge(MPIDI_OFI_send_control_t * info)
{
MPIDI_OFI_huge_recv_t *recv = NULL;
MPIR_Comm *comm_ptr;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_NETMOD_OFI_GET_HUGE);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_NETMOD_OFI_GET_HUGE);
/* Look up the communicator */
comm_ptr = MPIDIG_context_id_to_comm(info->comm_id);
/* If there has been a posted receive, search through the list of unmatched
* receives to find the one that goes with the incoming message. */
{
MPIDI_OFI_huge_recv_list_t *list_ptr;
MPL_DBG_MSG_FMT(MPIR_DBG_PT2PT, VERBOSE,
(MPL_DBG_FDEST, "SEARCHING POSTED LIST: (%d, %d, %d)", info->comm_id,
info->origin_rank, info->tag));
LL_FOREACH(MPIDI_posted_huge_recv_head, list_ptr) {
if (list_ptr->comm_id == info->comm_id &&
list_ptr->rank == info->origin_rank && list_ptr->tag == info->tag) {
MPL_DBG_MSG_FMT(MPIR_DBG_PT2PT, VERBOSE,
(MPL_DBG_FDEST, "MATCHED POSTED LIST: (%d, %d, %d, %d)",
info->comm_id, info->origin_rank, info->tag,
list_ptr->rreq->handle));
LL_DELETE(MPIDI_posted_huge_recv_head, MPIDI_posted_huge_recv_tail, list_ptr);
recv = (MPIDI_OFI_huge_recv_t *)
MPIDIU_map_lookup(MPIDI_OFI_COMM(comm_ptr).huge_recv_counters,
list_ptr->rreq->handle);
MPL_free(list_ptr);
break;
}
}
}
if (recv == NULL) { /* Put the struct describing the transfer on an
* unexpected list to be retrieved later */
MPL_DBG_MSG_FMT(MPIR_DBG_PT2PT, VERBOSE,
(MPL_DBG_FDEST, "CREATING UNEXPECTED HUGE RECV: (%d, %d, %d)",
info->comm_id, info->origin_rank, info->tag));
/* If this is unexpected, create a new tracker and put it in the unexpected list. */
recv = (MPIDI_OFI_huge_recv_t *) MPL_calloc(sizeof(*recv), 1, MPL_MEM_COMM);
if (!recv)
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
LL_APPEND(MPIDI_unexp_huge_recv_head, MPIDI_unexp_huge_recv_tail, recv);
}
recv->event_id = MPIDI_OFI_EVENT_GET_HUGE;
recv->cur_offset = MPIDI_OFI_global.max_msg_size;
recv->remote_info = *info;
recv->comm_ptr = comm_ptr;
recv->next = NULL;
MPIDI_OFI_get_huge_event(NULL, (MPIR_Request *) recv);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_NETMOD_OFI_GET_HUGE);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Comm_spawn_multiple_c(int count, char* array_of_commands_f,
char* array_of_argv_f, const int* array_of_maxprocs,
const MPI_Info* array_of_info, int root, MPI_Comm comm,
MPI_Comm* intercomm, int* array_of_errcodes,
int commands_elem_len, int argv_elem_len)
{
int mpi_errno = MPI_SUCCESS;
char** array_of_commands_c = NULL;
char*** array_of_argv_c = NULL;
int i, j, offset, len, terminate;
char *buf, *newbuf;
/* array_of_commands_f in Fortran has type CHARACTER(LEN=*), INTENT(IN) :: array_of_commands(*).
It contains commands array_of_commands(1), ..., array_of_commands(count). Each is a Fortran
string of length commands_elem_len, which equals to len(array_of_commands).
We need to convert array_of_commands_f into array_of_commands_c, which in C has type
char* array_of_commands_c[count], in other words, each element is a pointer to string.
*/
mpi_errno = MPIR_Fortran_array_of_string_f2c(array_of_commands_f, &array_of_commands_c,
commands_elem_len, 1 /* size of array_of_commands_f is known */, count);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* array_of_argv_f in Fortran has type CHARACTER(LEN=*), INTENT(IN) :: array_of_argv(count, *).
For a particular command number K (in the range 1..count), array_of_argv (K, 1) is the first
argument, array_of_argv(K,2) is the second argument, ... etc., until you get to array_of_argv(K,J)
being a string of all blank characters. That indicates that command K has J-1 arguments.
The value of J might be different from each command, but the size of the second dimension of
array_of_argv is the largest value of J for all the commands. The actual memory layout of
the array is (arg1 for command 1) (arg1 for command 2) ... (arg1 for command COUNT)
(arg2 for command 1) ...
We need to convert array_of_argv_f into array_of_argv_c, which in C has type
char** array_of_argv_c[count], with each element pointing to an array of pointers.
For example, array_of_argv_c[0] points to an array of pointers to string.
array_of_argv_c[0][0] points to 1st arg of command 0. array_of_argv_c[0][0] points
to 2nd arg of command 0, etc. If array_of_argv_c[0][J] is NULL, then command 0
has J args.
*/
if ((char***)array_of_argv_f == MPI_ARGVS_NULL) {
array_of_argv_c = MPI_ARGVS_NULL;
} else {
array_of_argv_c = (char***) MPIU_Malloc(sizeof(char**)*count);
if (!array_of_argv_c) MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
/* Allocate a temp buf to put args of a command */
len = 256; /* length of buf. Initialized with an arbitrary value */
buf = (char*)MPIU_Malloc(sizeof(char)*len);
if (!buf) MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
for (i = 0; i < count; i++) {
/* Extract args of command i, and put them in buf */
char *arg;
offset = 0; /* offset in bytes in buf to put next arg */
arg = array_of_argv_f + argv_elem_len * i; /* Point to 1st arg of command i */
do {
if (offset + argv_elem_len > len) { /* Make sure buf is big enough */
len = offset + argv_elem_len;
newbuf = (char*)MPIU_Realloc(buf, len);
if (!newbuf) {
MPIU_Free(buf);
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
buf = newbuf;
}
/* Check if arg is a terminating blank string */
j = 0;
while (arg[j] == ' ' && j < argv_elem_len) j++;
terminate = (j == argv_elem_len);
strncpy(buf + offset, arg, argv_elem_len); /* Copy it even it is all blank */
arg += argv_elem_len * count; /* Move to next arg of command i */
offset += argv_elem_len;
} while(!terminate);
/* Convert the args into C style. We indicate we don't know the count of strings so
that a NULL pointer will be appended at the end.
*/
mpi_errno = MPIR_Fortran_array_of_string_f2c(buf, &(array_of_argv_c[i]), argv_elem_len, 0, 0);
if (mpi_errno != MPI_SUCCESS) {
for (j = i - 1; j >= 0; j--)
MPIU_Free(array_of_argv_c[j]);
MPIU_Free(buf);
goto fn_fail;
}
}
MPIU_Free(buf);
}
mpi_errno = PMPI_Comm_spawn_multiple(count, array_of_commands_c, array_of_argv_c,
array_of_maxprocs, array_of_info, root, comm, intercomm, array_of_errcodes);
MPIU_Free(array_of_commands_c);
if (array_of_argv_c != MPI_ARGVS_NULL) {
for (i = 0; i < count; i++)
MPIU_Free(array_of_argv_c[i]);
MPIU_Free(array_of_argv_c);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/* *slen is the length of the string, including the null terminator. So if the
resulting string is |foo\0bar\0|, then *slen == 8. */
static int connToStringKVS( char **buf_p, int *slen, MPIDI_PG_t *pg )
{
char *string = 0;
char *pg_idStr = (char *)pg->id; /* In the PMI/KVS space,
the pg id is a string */
char buf[MPIDI_MAX_KVS_VALUE_LEN];
int i, j, rc, mpi_errno = MPI_SUCCESS, len;
size_t vallen, curSlen;
/* Make an initial allocation of a string with an estimate of the
needed space */
len = 0;
curSlen = 10 + pg->size * 128;
string = (char *)MPL_malloc( curSlen );
/* Start with the id of the pg */
while (*pg_idStr && len < curSlen)
string[len++] = *pg_idStr++;
string[len++] = 0;
/* Add the size of the pg */
MPL_snprintf( &string[len], curSlen - len, "%d", pg->size );
while (string[len]) len++;
len++;
for (i=0; i<pg->size; i++) {
rc = getConnInfoKVS( i, buf, MPIDI_MAX_KVS_VALUE_LEN, pg );
if (rc) {
MPL_internal_error_printf(
"Panic: getConnInfoKVS failed for %s (rc=%d)\n",
(char *)pg->id, rc );
}
#ifndef USE_PERSISTENT_SHARED_MEMORY
/* FIXME: This is a hack to avoid including shared-memory
queue names in the business card that may be used
by processes that were not part of the same COMM_WORLD.
To fix this, the shared memory channels should look at the
returned connection info and decide whether to use
sockets or shared memory by determining whether the
process is in the same MPI_COMM_WORLD. */
/* FIXME: The more general problem is that the connection information
needs to include some information on the range of validity (e.g.,
all processes, same comm world, particular ranks), and that
representation needs to be scalable */
/* printf( "Adding key %s value %s\n", key, val ); */
{
char *p = strstr( buf, "$shm_host" );
if (p) p[1] = 0;
/* printf( "(fixed) Adding key %s value %s\n", key, val ); */
}
#endif
/* Add the information to the output buffer */
vallen = strlen(buf);
/* Check that this will fix in the remaining space */
if (len + vallen + 1 >= curSlen) {
char *nstring = 0;
curSlen += (pg->size - i) * (vallen + 1 );
nstring = MPL_realloc( string, curSlen );
if (!nstring) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
string = nstring;
}
/* Append to string */
for (j=0; j<vallen+1; j++) {
string[len++] = buf[j];
}
}
MPIR_Assert(len <= curSlen);
*buf_p = string;
*slen = len;
fn_exit:
return mpi_errno;
fn_fail:
if (string) MPL_free(string);
goto fn_exit;
}
int MPID_Irsend(const void * buf, int count, MPI_Datatype datatype, int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_ready_send_t * const ready_pkt = &upkt.ready_send;
MPIDI_msg_sz_t data_sz;
int dt_contig;
MPI_Aint dt_true_lb;
MPID_Datatype * dt_ptr;
MPID_Request * sreq;
MPIDI_VC_t * vc;
#if defined(MPID_USE_SEQUENCE_NUMBERS)
MPID_Seqnum_t seqnum;
#endif
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_IRSEND);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_IRSEND);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"rank=%d, tag=%d, context=%d",
rank, tag, comm->context_id + context_offset));
/* Check to make sure the communicator hasn't already been revoked */
if (comm->revoked &&
MPIR_AGREE_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask) &&
MPIR_SHRINK_TAG != MPIR_TAG_MASK_ERROR_BITS(tag & ~MPIR_Process.tagged_coll_mask)) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked");
}
if (rank == comm->rank && comm->comm_kind != MPID_INTERCOMM)
{
mpi_errno = MPIDI_Isend_self(buf, count, datatype, rank, tag, comm, context_offset, MPIDI_REQUEST_TYPE_RSEND, &sreq);
goto fn_exit;
}
if (rank != MPI_PROC_NULL) {
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
#ifdef ENABLE_COMM_OVERRIDES
/* this needs to come before the sreq is created, since the override
* function is responsible for creating its own request */
if (vc->comm_ops && vc->comm_ops->irsend)
{
mpi_errno = vc->comm_ops->irsend( vc, buf, count, datatype, rank, tag, comm, context_offset, &sreq);
goto fn_exit;
}
#endif
}
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_RSEND);
MPIDI_Request_set_msg_type(sreq, MPIDI_REQUEST_EAGER_MSG);
if (rank == MPI_PROC_NULL)
{
MPIU_Object_set_ref(sreq, 1);
MPID_cc_set(&sreq->cc, 0);
goto fn_exit;
}
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr, dt_true_lb);
MPIDI_Pkt_init(ready_pkt, MPIDI_CH3_PKT_READY_SEND);
ready_pkt->match.parts.rank = comm->rank;
ready_pkt->match.parts.tag = tag;
ready_pkt->match.parts.context_id = comm->context_id + context_offset;
ready_pkt->sender_req_id = MPI_REQUEST_NULL;
ready_pkt->data_sz = data_sz;
if (data_sz == 0)
{
MPIU_DBG_MSG(CH3_OTHER,VERBOSE,"sending zero length message");
sreq->dev.OnDataAvail = 0;
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(ready_pkt, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iSend(vc, sreq, ready_pkt, sizeof(*ready_pkt));
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPID_Request_release(sreq);
sreq = NULL;
MPIR_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**ch3|eagermsg");
goto fn_exit;
}
/* --END ERROR HANDLING-- */
goto fn_exit;
}
if (vc->ready_eager_max_msg_sz < 0 || data_sz + sizeof(MPIDI_CH3_Pkt_ready_send_t) <= vc->ready_eager_max_msg_sz) {
if (dt_contig) {
mpi_errno = MPIDI_CH3_EagerContigIsend( &sreq,
MPIDI_CH3_PKT_READY_SEND,
(char*)buf + dt_true_lb,
data_sz, rank, tag,
comm, context_offset );
}
else {
mpi_errno = MPIDI_CH3_EagerNoncontigSend( &sreq,
MPIDI_CH3_PKT_READY_SEND,
buf, count, datatype,
data_sz, rank, tag,
comm, context_offset );
/* If we're not complete, then add a reference to the datatype */
if (sreq && sreq->dev.OnDataAvail) {
sreq->dev.datatype_ptr = dt_ptr;
MPID_Datatype_add_ref(dt_ptr);
}
}
} else {
/* Do rendezvous. This will be sent as a regular send not as
a ready send, so the receiver won't know to send an error
if the receive has not been posted */
MPIDI_Request_set_msg_type( sreq, MPIDI_REQUEST_RNDV_MSG );
mpi_errno = vc->rndvSend_fn( &sreq, buf, count, datatype, dt_contig,
data_sz, dt_true_lb, rank, tag, comm,
context_offset );
if (sreq && dt_ptr != NULL) {
sreq->dev.datatype_ptr = dt_ptr;
MPID_Datatype_add_ref(dt_ptr);
}
}
fn_exit:
*request = sreq;
MPIU_DBG_STMT(CH3_OTHER,VERBOSE,{
if (sreq != NULL)
{
MPIU_DBG_MSG_P(CH3_OTHER,VERBOSE,"request allocated, handle=0x%08x", sreq->handle);
}
}
);
int MPIDI_Comm_spawn_multiple(int count, char **commands,
char ***argvs, const int *maxprocs,
MPIR_Info **info_ptrs, int root,
MPIR_Comm *comm_ptr, MPIR_Comm
**intercomm, int *errcodes)
{
char port_name[MPI_MAX_PORT_NAME];
int *info_keyval_sizes=0, i, mpi_errno=MPI_SUCCESS;
PMI_keyval_t **info_keyval_vectors=0, preput_keyval_vector;
int *pmi_errcodes = 0, pmi_errno;
int total_num_processes, should_accept = 1;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_COMM_SPAWN_MULTIPLE);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_COMM_SPAWN_MULTIPLE);
if (comm_ptr->rank == root) {
/* create an array for the pmi error codes */
total_num_processes = 0;
for (i=0; i<count; i++) {
total_num_processes += maxprocs[i];
}
pmi_errcodes = (int*)MPL_malloc(sizeof(int) * total_num_processes);
if (pmi_errcodes == NULL) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
/* initialize them to 0 */
for (i=0; i<total_num_processes; i++)
pmi_errcodes[i] = 0;
/* Open a port for the spawned processes to connect to */
/* FIXME: info may be needed for port name */
mpi_errno = MPID_Open_port(NULL, port_name);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* --END ERROR HANDLING-- */
/* Spawn the processes */
#ifdef USE_PMI2_API
MPIR_Assert(count > 0);
{
int *argcs = MPL_malloc(count*sizeof(int));
struct MPIR_Info preput;
struct MPIR_Info *preput_p[1] = { &preput };
MPIR_Assert(argcs);
/*
info_keyval_sizes = MPL_malloc(count * sizeof(int));
*/
/* FIXME cheating on constness */
preput.key = (char *)PARENT_PORT_KVSKEY;
preput.value = port_name;
preput.next = NULL;
/* compute argcs array */
for (i = 0; i < count; ++i) {
argcs[i] = 0;
if (argvs != NULL && argvs[i] != NULL) {
while (argvs[i][argcs[i]]) {
++argcs[i];
}
}
/* a fib for now */
/*
info_keyval_sizes[i] = 0;
*/
}
/* XXX DJG don't need this, PMI API is thread-safe? */
/*MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);*/
/* release the global CS for spawn PMI calls */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
pmi_errno = PMI2_Job_Spawn(count, (const char **)commands,
argcs, (const char ***)argvs,
maxprocs,
info_keyval_sizes, (const MPIR_Info **)info_ptrs,
1, (const struct MPIR_Info **)preput_p,
NULL, 0,
/*jobId, jobIdSize,*/ /* XXX DJG job stuff? */
pmi_errcodes);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
/*MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);*/
MPL_free(argcs);
if (pmi_errno != PMI2_SUCCESS) {
MPIR_ERR_SETANDJUMP1(mpi_errno, MPI_ERR_OTHER,
"**pmi_spawn_multiple", "**pmi_spawn_multiple %d", pmi_errno);
}
}
#else
/* FIXME: This is *really* awkward. We should either
Fix on MPI-style info data structures for PMI (avoid unnecessary
duplication) or add an MPIU_Info_getall(...) that creates
the necessary arrays of key/value pairs */
/* convert the infos into PMI keyvals */
info_keyval_sizes = (int *) MPL_malloc(count * sizeof(int));
info_keyval_vectors =
(PMI_keyval_t**) MPL_malloc(count * sizeof(PMI_keyval_t*));
if (!info_keyval_sizes || !info_keyval_vectors) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
if (!info_ptrs) {
for (i=0; i<count; i++) {
info_keyval_vectors[i] = 0;
info_keyval_sizes[i] = 0;
}
}
else {
for (i=0; i<count; i++) {
mpi_errno = mpi_to_pmi_keyvals( info_ptrs[i],
&info_keyval_vectors[i],
&info_keyval_sizes[i] );
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
}
}
preput_keyval_vector.key = PARENT_PORT_KVSKEY;
preput_keyval_vector.val = port_name;
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
pmi_errno = PMI_Spawn_multiple(count, (const char **)
commands,
(const char ***) argvs,
maxprocs, info_keyval_sizes,
(const PMI_keyval_t **)
info_keyval_vectors, 1,
&preput_keyval_vector,
pmi_errcodes);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
if (pmi_errno != PMI_SUCCESS) {
MPIR_ERR_SETANDJUMP1(mpi_errno, MPI_ERR_OTHER,
"**pmi_spawn_multiple", "**pmi_spawn_multiple %d", pmi_errno);
}
#endif
if (errcodes != MPI_ERRCODES_IGNORE) {
for (i=0; i<total_num_processes; i++) {
/* FIXME: translate the pmi error codes here */
errcodes[i] = pmi_errcodes[i];
/* We want to accept if any of the spawns succeeded.
Alternatively, this is the same as we want to NOT accept if
all of them failed. should_accept = NAND(e_0, ..., e_n)
Remember, success equals false (0). */
should_accept = should_accept && errcodes[i];
}
should_accept = !should_accept; /* the `N' in NAND */
}
}
if (errcodes != MPI_ERRCODES_IGNORE) {
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
mpi_errno = MPIR_Bcast_impl(&should_accept, 1, MPI_INT, root, comm_ptr, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Bcast_impl(&total_num_processes, 1, MPI_INT, root, comm_ptr, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Bcast_impl(errcodes, total_num_processes, MPI_INT, root, comm_ptr, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
}
if (should_accept) {
mpi_errno = MPID_Comm_accept(port_name, NULL, root, comm_ptr, intercomm);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**pmi_spawn_multiple");
}
if (comm_ptr->rank == root) {
/* Close the port opened for the spawned processes to connect to */
mpi_errno = MPID_Close_port(port_name);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPIR_ERR_POP(mpi_errno);
}
/* --END ERROR HANDLING-- */
}
fn_exit:
if (info_keyval_vectors) {
free_pmi_keyvals(info_keyval_vectors, count, info_keyval_sizes);
MPL_free(info_keyval_sizes);
MPL_free(info_keyval_vectors);
}
if (pmi_errcodes) {
MPL_free(pmi_errcodes);
}
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_COMM_SPAWN_MULTIPLE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
static int get_business_card(int my_rank, char **bc_val_p, int *val_max_sz_p)
{
int mpi_errno = MPI_SUCCESS;
int str_errno = MPL_STR_SUCCESS;
int ret;
ptl_process_t my_ptl_id;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_GET_BUSINESS_CARD);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_GET_BUSINESS_CARD);
ret = PtlGetId(MPIDI_nem_ptl_ni, &my_ptl_id);
MPIR_ERR_CHKANDJUMP1(ret, mpi_errno, MPI_ERR_OTHER, "**ptlgetid", "**ptlgetid %s", MPID_nem_ptl_strerror(ret));
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_CHANNEL, VERBOSE, (MPL_DBG_FDEST, "Allocated NI and PT id=(%#x,%#x) pt=%#x",
my_ptl_id.phys.nid, my_ptl_id.phys.pid, MPIDI_nem_ptl_pt));
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, NID_KEY, (char *)&my_ptl_id.phys.nid, sizeof(my_ptl_id.phys.nid));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PID_KEY, (char *)&my_ptl_id.phys.pid, sizeof(my_ptl_id.phys.pid));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTI_KEY, (char *)&MPIDI_nem_ptl_pt, sizeof(MPIDI_nem_ptl_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTIG_KEY, (char *)&MPIDI_nem_ptl_get_pt,
sizeof(MPIDI_nem_ptl_get_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTIC_KEY, (char *)&MPIDI_nem_ptl_control_pt,
sizeof(MPIDI_nem_ptl_control_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTIR_KEY, (char *)&MPIDI_nem_ptl_rpt_pt,
sizeof(MPIDI_nem_ptl_rpt_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTIRG_KEY, (char *)&MPIDI_nem_ptl_get_rpt_pt,
sizeof(MPIDI_nem_ptl_get_rpt_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
str_errno = MPL_str_add_binary_arg(bc_val_p, val_max_sz_p, PTIRC_KEY, (char *)&MPIDI_nem_ptl_control_rpt_pt,
sizeof(MPIDI_nem_ptl_control_rpt_pt));
if (str_errno) {
MPIR_ERR_CHKANDJUMP(str_errno == MPL_STR_NOMEM, mpi_errno, MPI_ERR_OTHER, "**buscard_len");
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**buscard");
}
fn_exit:
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_GET_BUSINESS_CARD);
return mpi_errno;
fn_fail:
goto fn_exit;
}
