int MPI_Comm_free(MPI_Comm *comm)
{
pList sendlist, recvlist;
int size;
Comm *mycomm;
mycomm=mpi_handle_to_ptr(*comm); /* (Comm *)(*comm) */
sendlist=mycomm->sendlist;
recvlist=mycomm->recvlist;
size=AP_list_size(sendlist);
if (size!=0)
fprintf(stderr,"MPI_Comm_free: warning: %d pending send reqs\n",
size);
AP_list_free(sendlist);
size=AP_list_size(recvlist);
if (size!=0)
fprintf(stderr,"MPI_Comm_free: warning: %d pending receive reqs\n",
size);
AP_list_free(recvlist);
mpi_free_handle(*comm); /* free(mycomm); */
*comm=MPI_COMM_NULL;
return(MPI_SUCCESS);
}
int MPI_Test(MPI_Request *request, int *flag, MPI_Status *status)
{
Req *req;
if (*request==MPI_REQUEST_NULL)
{
status->MPI_TAG= MPI_ANY_TAG;
status->MPI_SOURCE= MPI_ANY_SOURCE;
*flag=1;
return(MPI_SUCCESS);
}
req=mpi_handle_to_ptr(*request);
*flag=req->complete;
if (*flag)
{
status->MPI_SOURCE= req->source;
status->MPI_TAG= req->tag;
mpi_free_handle(*request);
*request=MPI_REQUEST_NULL;
}
return(MPI_SUCCESS);
}
/*
* Wrapper for mpi_handle_to_ptr in handles.c
* specific for datatype handles, which may be
* predefined negative handles
*/
Datatype* mpi_handle_to_datatype(int handle)
{
if (handle < 0)
return (Datatype*) &simpletypes[-1-handle];
else
return (Datatype*) mpi_handle_to_ptr(handle);
}
int MPI_Pack_size(int incount, MPI_Datatype datatype,
MPI_Comm comm, MPI_Aint * size)
{
int ret;
Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(datatype);
Comm * comm_ptr = mpi_handle_to_ptr(comm);
ret = Pack_size(incount, type_ptr, comm_ptr, size);
return ret;
}
int MPI_Unpack(void * inbuf, int insize, int * position, void * outbuf,
int outcount, MPI_Datatype type, MPI_Comm comm)
{
int ret;
Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(type);
Comm * comm_ptr = mpi_handle_to_ptr(comm);
ret = Unpack(inbuf, insize, position, outbuf, outcount, type_ptr, comm_ptr);
return ret;
}
int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag,
MPI_Status *status)
{
pListitem match;
Comm *mycomm;
Req *sreq;
mycomm=mpi_handle_to_ptr(comm); /* mycomm=(Comm *)comm; */
#ifdef INFO
fflush(stdout);
fprintf(stderr,"MPI_IProbev: Comm=%d tag=%d count=%d type=%d\n",
mycomm->num,tag,count,datatype);
#endif
if (source!=0 && source!=MPI_ANY_SOURCE)
{
fprintf(stderr,"MPI_Irecv: bad source %d\n",source);
abort();
}
match=AP_list_search_func(mycomm->sendlist,mpi_match_send,&tag);
*flag= (match==NULL ? 0:1 );
if (*flag)
{
sreq=(Req *)AP_listitem_data(match);
if (status!=MPI_STATUS_IGNORE)
{
status->MPI_SOURCE=0 ;
status->MPI_TAG= sreq->tag;
}
}
return(MPI_SUCCESS);
}
int MPI_Irecv(void *buf, int count, MPI_Datatype datatype,
int source, int tag, MPI_Comm comm, MPI_Request *request)
{
pListitem match;
Comm *mycomm;
Req *rreq, *sreq;
mycomm=mpi_handle_to_ptr(comm); /* mycomm=(Comm *)comm; */
#ifdef INFO
fflush(stdout);
fprintf(stderr,"MPI_Irecv: Comm=%d tag=%d count=%d type=%d\n",
mycomm->num,tag,count,datatype);
#endif
if (source!=0 && source!=MPI_ANY_SOURCE && source!=MPI_PROC_NULL)
{
fprintf(stderr,"MPI_Irecv: bad source %d\n",source);
abort();
}
mpi_alloc_handle(request,(void **)&rreq);
if (source==MPI_PROC_NULL)
{
rreq->complete=1;
rreq->source=MPI_PROC_NULL;
rreq->tag=MPI_ANY_TAG;
return(MPI_SUCCESS);
}
if ( match=AP_list_search_func(mycomm->sendlist,mpi_match_send,&tag) )
{
sreq=(Req *)AP_listitem_data(match);
AP_list_delete_item(mycomm->sendlist,match);
memcpy(buf,sreq->buf,count * datatype);
rreq->complete=1;
rreq->source=0;
rreq->tag=sreq->tag; /* in case tag was MPI_ANY_TAG */
sreq->complete=1;
#ifdef DEBUG
printf("Completion(recv) value=%d tag=%d\n",
*((int *)buf),rreq->tag);
#endif
return(MPI_SUCCESS);
}
rreq->buf=buf;
rreq->tag=tag;
rreq->complete=0;
rreq->listitem=AP_list_append(mycomm->recvlist,rreq);
#ifdef INFO
print_list(mycomm->recvlist,"recvlist for comm ",mycomm->num);
#endif
return(MPI_SUCCESS);
}
