void dump_port_list(void)
{
int n;
fprintf(stderr, "--- port list ---\n");
for (n = 1; n <= 32; ++n)
check_comm(n);
}
PUBLIC int MPI_Bcast (void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm)
{
check_comm (comm);
check_coll_root (root, comm);
check_datatype (datatype, comm);
if (comm->group->size == 1)
return MPI_SUCCESS;
if (comm->group->rank == root)
{
int i, j, rval;
MPI_Request *reqs = mymalloc (comm->group->size - 1, MPI_Request);
for (i = 0; i < root; i++)
if (rval = MPI_Isend (buffer, count, datatype, i, MPII_BCAST_TAG,
comm, &(reqs[i])))
{
free (reqs);
return rval;
}
for (j = i++; i < comm->group->size; i++, j++)
if (rval = MPI_Isend (buffer, count, datatype, i, MPII_BCAST_TAG,
comm, &(reqs[j])))
{
free (reqs);
return rval;
}
rval = MPI_Waitall (comm->group->size - 1, reqs, NULL);
free (reqs);
return rval;
}
else
return MPI_Recv (buffer, count, datatype, root, MPII_BCAST_TAG, comm,
NULL);
}
PUBLIC int MPI_Errhandler_set (MPI_Comm comm, MPI_Errhandler errhandler)
{
check_comm (comm);
comm->errhandler = errhandler;
return MPI_SUCCESS;
}
PUBLIC int MPI_Recv (void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status *status)
{
MPI_Request req;
MPII_Msg msg;
MPII_Member *member;
int rval, retry = 0;
check_comm (comm);
check_datatype (datatype, comm);
if (source < 0 || source > comm->group->size)
if (source == MPI_PROC_NULL)
{
/* The following two equalities are defined in MPI-1 (section 3.11) */
status->MPI_SOURCE = MPI_PROC_NULL;
status->MPI_TAG = MPI_ANY_TAG;
status->MPII_COUNT = 0;
return MPI_SUCCESS;
}
else if (source != MPI_ANY_SOURCE)
return MPII_Error (comm, MPII_RANK_RANGE);
req.type = MPII_REQUEST_RECV;
req.comm = comm;
req.buf = buf;
req.count = count;
req.datatype = datatype;
req.srcdest = source;
req.tag = tag;
post_recv ();
member = MPII_Me (comm);
lock (member->mutex);
while (!MPII_queue_search (&retry, &(member->queue), MPII_match_recv,
&req, &msg))
wait (member->cond, member->mutex);
unlock (member->mutex);
if (status != NULL)
{
status->MPI_SOURCE = msg.req->comm->group->rank;
status->MPI_TAG = msg.req->tag;
status->MPII_COUNT = msg.req->count * MPII_types[msg.req->datatype].size;
}
if (datatype != msg.req->datatype)
rval = MPII_Error (comm, MPII_TYPE_MISMATCH);
else if (count >= msg.req->count)
{
memcpy (buf, msg.req->buf, msg.req->count * MPII_types[datatype].size);
rval = MPI_SUCCESS;
}
else
{
memcpy (buf, msg.req->buf, count * MPII_types[datatype].size);
rval = MPII_Error (comm, MPII_OVERFLOW);
}
notify_sender (((MPII_Member **) msg.req->comm->group->members)
[msg.req->comm->group->rank], msg, member);
return rval;
}
PUBLIC int MPI_Reduce (void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
#endif
{
int rval = MPI_SUCCESS;
check_comm (comm);
check_coll_root (root, comm);
check_datatype (datatype, comm);
check_op (op, comm);
if (comm->group->size == 1)
{
memcpy (recvbuf, sendbuf, count * MPII_types[datatype].size);
return MPI_SUCCESS;
}
if (comm->group->rank == root)
{
int i;
int len = count * MPII_types[datatype].size;
void *tempbuf = MPII_Malloc (len);
#ifdef ALLREDUCE
MPI_Request *reqs;
#endif
if (MPII_ops[op].commute)
{
if ((rval = MPI_Recv (recvbuf, count, datatype, MPI_ANY_SOURCE,
MPII_REDUCE_TAG, comm, NULL)))
{
free (tempbuf);
return rval;
}
(*(MPII_ops[op].f)) (sendbuf, recvbuf, &count, &datatype);
for (i = 0; i < comm->group->size - 1; i++)
{
if ((rval = MPI_Recv (tempbuf, count, datatype, MPI_ANY_SOURCE,
MPII_REDUCE_TAG, comm, NULL)))
{
free (tempbuf);
return rval;
}
(*(MPII_ops[op].f)) (tempbuf, recvbuf, &count, &datatype);
}
}
else
{
if (root == 0)
memmove (recvbuf, sendbuf, len);
else if ((rval = MPI_Recv (recvbuf, count, datatype, 0,
MPII_REDUCE_TAG, comm, NULL)))
{
free (tempbuf);
return rval;
}
for (i = 1; i < comm->group->size; i++)
{
if (root == i)
memmove (tempbuf, sendbuf, len);
else if ((rval = MPI_Recv (tempbuf, count, datatype, i,
MPII_REDUCE_TAG, comm, NULL)))
{
free (tempbuf);
return rval;
}
(*(MPII_ops[op].f)) (recvbuf, tempbuf, &count, &datatype);
if (++i >= comm->group->size)
{
memmove (recvbuf, tempbuf, len);
break;
}
if ((rval = MPI_Recv (recvbuf, count, datatype, i,
MPII_REDUCE_TAG, comm, NULL)))
{
free (tempbuf);
return rval;
}
(*(MPII_ops[op].f)) (tempbuf, recvbuf, &count, &datatype);
}
}
free (tempbuf);
#ifdef ALLREDUCE
int j;
reqs = mymalloc (comm->group->size - 1, MPI_Request);
for (i = 0; i < root; i++)
if ((rval = MPI_Isend (recvbuf, count, datatype, i, MPII_ALLREDUCE_TAG2,
comm, &(reqs[i]))))
{
free (reqs);
return rval;
}
for (j = i++; i < comm->group->size; i++, j++)
if ((rval = MPI_Isend (recvbuf, count, datatype, i, MPII_ALLREDUCE_TAG2,
comm, &(reqs[j]))))
{
free (reqs);
return rval;
}
rval = MPI_Waitall (comm->group->size - 1, reqs, NULL);
free (reqs);
#endif
}
else
{
if ((rval = MPI_Send (sendbuf, count, datatype, root, MPII_REDUCE_TAG, comm)))
return rval;
#ifdef ALLREDUCE
rval = MPI_Recv (recvbuf, count, datatype, root, MPII_ALLREDUCE_TAG2, comm,
NULL);
#endif
}
return rval;
}