/*@
MPI_Ssend_init - Builds a handle for a synchronous send
Input Parameters:
+ buf - initial address of send buffer (choice)
. count - number of elements sent (integer)
. datatype - type of each element (handle)
. dest - rank of destination (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Output Parameter:
. request - communication request (handle)
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_TAG
.N MPI_ERR_RANK
@*/
int MPI_Ssend_init( void *buf, int count, MPI_Datatype datatype, int dest,
int tag, MPI_Comm comm, MPI_Request *request )
{
int mpi_errno = MPI_SUCCESS;
struct MPIR_DATATYPE *dtype_ptr;
struct MPIR_COMMUNICATOR *comm_ptr;
static char myname[] = "MPI_SSEND_INIT";
MPIR_PSHANDLE *shandle;
disableSignal();
TR_PUSH(myname);
comm_ptr = MPIR_GET_COMM_PTR(comm);
MPIR_TEST_MPI_COMM(comm,comm_ptr,comm_ptr,myname);
#ifndef MPIR_NO_ERROR_CHECKING
MPIR_TEST_COUNT(count);
MPIR_TEST_SEND_TAG(tag);
MPIR_TEST_SEND_RANK(comm_ptr,dest);
if (mpi_errno) {
revertSignal();
return MPIR_ERROR(comm_ptr, mpi_errno, myname );
}
#endif
/* This is IDENTICAL to the create_send code except for the send
function */
MPIR_ALLOCFN(shandle,MPID_PSendAlloc,
comm_ptr,MPI_ERR_EXHAUSTED,myname );
*request = (MPI_Request)shandle;
MPID_Request_init( &(shandle->shandle), MPIR_PERSISTENT_SEND );
/* Save the information about the operation, being careful with
ref-counted items */
dtype_ptr = MPIR_GET_DTYPE_PTR(datatype);
MPIR_TEST_DTYPE(datatype,dtype_ptr,comm_ptr,myname);
MPIR_REF_INCR(dtype_ptr);
shandle->perm_datatype = dtype_ptr;
shandle->perm_tag = tag;
shandle->perm_dest = dest;
shandle->perm_count = count;
shandle->perm_buf = buf;
MPIR_REF_INCR(comm_ptr);
shandle->perm_comm = comm_ptr;
shandle->active = 0;
shandle->send = MPID_IssendDatatype;
/* dest of MPI_PROC_NULL handled in start */
TR_POP;
revertSignal();
return MPI_SUCCESS;
}
/*@
MPI_Recv_init - Builds a handle for a receive
Input Parameters:
+ buf - initial address of receive buffer (choice)
. count - number of elements received (integer)
. datatype - type of each element (handle)
. source - rank of source or 'MPI_ANY_SOURCE' (integer)
. tag - message tag or 'MPI_ANY_TAG' (integer)
- comm - communicator (handle)
Output Parameter:
. request - communication request (handle)
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_RANK
.N MPI_ERR_TAG
.N MPI_ERR_COMM
.N MPI_ERR_EXHAUSTED
.seealso: MPI_Start, MPI_Request_free
@*/
int MPI_Recv_init( void *buf, int count, MPI_Datatype datatype, int source,
int tag, MPI_Comm comm, MPI_Request *request )
{
int mpi_errno = MPI_SUCCESS;
struct MPIR_DATATYPE *dtype_ptr;
struct MPIR_COMMUNICATOR *comm_ptr;
static char myname[] = "MPI_RECV_INIT";
MPIR_PRHANDLE *rhandle;
disableSignal();
TR_PUSH(myname);
comm_ptr = MPIR_GET_COMM_PTR(comm);
MPIR_TEST_MPI_COMM(comm,comm_ptr,comm_ptr,myname);
dtype_ptr = MPIR_GET_DTYPE_PTR(datatype);
MPIR_TEST_DTYPE(datatype,dtype_ptr,comm_ptr,myname);
#ifndef MPIR_NO_ERROR_CHECKING
MPIR_TEST_COUNT(count);
MPIR_TEST_RECV_TAG(tag);
MPIR_TEST_RECV_RANK(comm_ptr,source);
if (mpi_errno) {
revertSignal();
return MPIR_ERROR(comm_ptr, mpi_errno, myname );
}
#endif
MPIR_ALLOCFN(rhandle,MPID_PRecvAlloc,
comm_ptr,MPI_ERR_EXHAUSTED,myname );
*request = (MPI_Request)rhandle;
MPID_Request_init( &(rhandle->rhandle), MPIR_PERSISTENT_RECV );
/* Save the information about the operation, being careful with
ref-counted items */
MPIR_REF_INCR(dtype_ptr);
rhandle->perm_datatype = dtype_ptr;
rhandle->perm_tag = tag;
rhandle->perm_source = source;
rhandle->perm_count = count;
rhandle->perm_buf = buf;
MPIR_REF_INCR(comm_ptr);
rhandle->perm_comm = comm_ptr;
rhandle->active = 0;
/* dest of MPI_PROC_NULL handled in start */
TR_POP;
revertSignal();
return MPI_SUCCESS;
}
/*@
MPI_Attr_put - Stores attribute value associated with a key
Input Parameters:
+ comm - communicator to which attribute will be attached (handle)
. keyval - key value, as returned by 'MPI_KEYVAL_CREATE' (integer)
- attribute_val - attribute value
Notes:
Values of the permanent attributes 'MPI_TAG_UB', 'MPI_HOST', 'MPI_IO', and
'MPI_WTIME_IS_GLOBAL' may not be changed.
The type of the attribute value depends on whether C or Fortran is being used.
In C, an attribute value is a pointer ('void *'); in Fortran, it is a single
integer (`not` a pointer, since Fortran has no pointers and there are systems
for which a pointer does not fit in an integer (e.g., any > 32 bit address
system that uses 64 bits for Fortran 'DOUBLE PRECISION').
If an attribute is already present, the delete function (specified when the
corresponding keyval was created) will be called.
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_KEYVAL
.N MPI_ERR_PERM_KEY
.seealso MPI_Attr_get, MPI_Keyval_create, MPI_Attr_delete
@*/
EXPORT_MPI_API int MPI_Attr_put ( MPI_Comm comm, int keyval, void *attr_value )
{
MPIR_HBT_node *attr;
MPIR_Attr_key *attr_key;
int mpi_errno = MPI_SUCCESS;
struct MPIR_COMMUNICATOR *comm_ptr;
static char myname[] = "MPI_ATTR_PUT";
TR_PUSH(myname);
comm_ptr = MPIR_GET_COMM_PTR(comm);
MPIR_TEST_MPI_COMM(comm,comm_ptr,comm_ptr,myname);
attr_key = MPIR_GET_KEYVAL_PTR( keyval );
MPIR_TEST_MPI_KEYVAL(keyval,attr_key,comm_ptr,myname);
/* Check for valid arguments */
if ( ( (keyval == MPI_KEYVAL_INVALID) && (mpi_errno = MPI_ERR_OTHER) ) )
return MPIR_ERROR( comm_ptr, mpi_errno, myname);
if (comm == MPI_COMM_WORLD && attr_key->permanent)
return MPIR_ERROR( comm_ptr,
MPIR_ERRCLASS_TO_CODE(MPI_ERR_ARG,MPIR_ERR_PERM_KEY),myname );
MPIR_HBT_lookup(comm_ptr->attr_cache, keyval, &attr);
if (attr == (MPIR_HBT_node *)0) {
(void) MPIR_HBT_new_node ( attr_key, attr_value, &attr );
(void) MPIR_HBT_insert ( comm_ptr->attr_cache, attr );
/* Every update to the attr_key must be counted! */
MPIR_REF_INCR(attr_key);
}
else {
/*
This is an unclear part of the standard. Under MPI_KEYVAL_CREATE,
it is claimed that ONLY MPI_COMM_FREE and MPI_ATTR_DELETE
can cause the delete routine to be called. Under
MPI_ATTR_PUT, however, the delete routine IS called.
*/
if ( attr_key->delete_fn.c_delete_fn ) {
if (attr_key->FortranCalling) {
MPI_Aint invall = (MPI_Aint)attr->value;
int inval = (int)invall;
(void) (*attr_key->delete_fn.f77_delete_fn)(comm,
&keyval, &inval,
attr_key->extra_state, &mpi_errno );
attr->value = (void *)(MPI_Aint)inval;
}
else
mpi_errno = (*attr_key->delete_fn.c_delete_fn)(comm, keyval,
attr->value,
attr_key->extra_state );
if (mpi_errno)
return MPIR_ERROR( comm_ptr, mpi_errno, myname);
}
attr->value = attr_value;
}
/* The device may want to know about attributes */
MPID_ATTR_SET(comm_ptr,keyval,attr_value);
TR_POP;
return (mpi_errno);
}
