int MPIR_Comm_register_hint(const char *hint_key, MPIR_Comm_hint_fn_t fn, void *state)
{
int mpi_errno = MPI_SUCCESS;
struct MPIR_Comm_hint_fn_elt *hint_elt = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_REGISTER_HINT);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_REGISTER_HINT);
if (MPID_hint_fns == NULL) {
MPIR_Add_finalize(free_hint_handles, NULL, MPIR_FINALIZE_CALLBACK_PRIO - 1);
}
hint_elt = MPIU_Malloc(sizeof(struct MPIR_Comm_hint_fn_elt));
strncpy(hint_elt->name, hint_key, MPI_MAX_INFO_KEY);
hint_elt->state = state;
hint_elt->fn = fn;
HASH_ADD_STR(MPID_hint_fns, name, hint_elt);
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_REGISTER_HINT);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Topology_put( MPID_Comm *comm_ptr, MPIR_Topology *topo_ptr )
{
int mpi_errno = MPI_SUCCESS;
MPIU_Assert(comm_ptr != NULL);
if (MPIR_Topology_keyval == MPI_KEYVAL_INVALID) {
/* Create a new keyval */
/* FIXME - thread safe code needs a thread lock here, followed
by another test on the keyval to see if a different thread
got there first */
mpi_errno = MPIR_Comm_create_keyval_impl( MPIR_Topology_copy_fn,
MPIR_Topology_delete_fn,
&MPIR_Topology_keyval, 0 );
/* Register the finalize handler */
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Add_finalize( MPIR_Topology_finalize, (void*)0,
MPIR_FINALIZE_CALLBACK_PRIO-1);
}
mpi_errno = MPIR_Comm_set_attr_impl(comm_ptr, MPIR_Topology_keyval, topo_ptr, MPIR_ATTR_PTR);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIDI_CH3I_Comm_init(void)
{
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_CH3U_COMM_INIT);
MPIDI_FUNC_ENTER(MPID_STATE_MPIDI_CH3U_COMM_INIT);
MPIR_Add_finalize(register_hook_finalize, NULL, MPIR_FINALIZE_CALLBACK_PRIO-1);
/* register hooks for keeping track of communicators */
mpi_errno = MPIDI_CH3U_Comm_register_create_hook(comm_created, NULL);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
#if defined HAVE_LIBHCOLL
if (MPIR_CVAR_CH3_ENABLE_HCOLL) {
mpi_errno = MPIDI_CH3U_Comm_register_create_hook(hcoll_comm_create, NULL);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
mpi_errno = MPIDI_CH3U_Comm_register_destroy_hook(hcoll_comm_destroy, NULL);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
}
#endif
mpi_errno = MPIDI_CH3U_Comm_register_destroy_hook(comm_destroyed, NULL);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPIDI_CH3U_COMM_INIT);
return mpi_errno;
fn_fail:
goto fn_exit;
}
static void context_id_init(void)
{
int i;
#if defined(FINEGRAIN_MPI)
MPIU_Assert (NULL == context_mask);
context_mask = (uint32_t *)MPIU_Malloc(MPIR_MAX_CONTEXT_MASK * sizeof(uint32_t));
MPIU_Assert (NULL != context_mask);
#endif
for (i = 1; i < MPIR_MAX_CONTEXT_MASK; i++) {
context_mask[i] = 0xFFFFFFFF;
}
/* The first two values are already used (comm_world, comm_self).
* The third value is also used for the internal-only copy of
* comm_world, if needed by mpid. */
#ifdef MPID_NEEDS_ICOMM_WORLD
context_mask[0] = 0xFFFFFFF8;
#else
context_mask[0] = 0xFFFFFFFC;
#endif
initialize_context_mask = 0;
#ifdef MPICH_DEBUG_HANDLEALLOC
/* check for context ID leaks in MPI_Finalize. Use (_PRIO-1) to make sure
* that we run after MPID_Finalize. */
MPIR_Add_finalize(check_context_ids_on_finalize, context_mask, MPIR_FINALIZE_CALLBACK_PRIO - 1); /* FG: TODO IMPORTANT */
#endif
}
void MPIU_Handle_obj_alloc_complete(MPIU_Object_alloc_t *objmem,
int initialized)
{
if (initialized) {
/* obj_alloc initialized region during this allocation;
* perform any ancillary operations associated with
* initialization prior to releasing control over region.
*/
/* Tell finalize to free up any memory that we allocate.
* The 0 makes this the lowest priority callback, so
* that other callbacks will finish before this one is invoked.
*/
MPIR_Add_finalize(MPIU_Handle_finalize, objmem, 0);
}
}
static void SendqInit( void )
{
int i;
MPIR_Sendq *p;
/* Preallocated a few send requests */
for (i=0; i<10; i++) {
p = (MPIR_Sendq *)MPIU_Malloc( sizeof(MPIR_Sendq) );
if (!p) {
/* Just ignore it */
break;
}
p->next = pool;
pool = p;
}
/* Make sure the pool is deleted */
MPIR_Add_finalize( SendqFreePool, 0, 0 );
}
int MPIR_Datatype_init(void)
{
int i;
int mpi_errno = MPI_SUCCESS;
MPID_Datatype *ptr;
MPIU_Assert(MPID_Datatype_mem.initialized == 0);
MPIU_Assert(MPID_DATATYPE_PREALLOC >= 5);
for (i=0; mpi_pairtypes[i] != (MPI_Datatype) -1; ++i) {
/* types based on 'long long' and 'long double', may be disabled at
configure time, and their values set to MPI_DATATYPE_NULL. skip any
such types. */
if (mpi_pairtypes[i] == MPI_DATATYPE_NULL) continue;
/* XXX: this allocation strategy isn't right if one or more of the
pairtypes is MPI_DATATYPE_NULL. in fact, the assert below will
fail if any type other than the las in the list is equal to
MPI_DATATYPE_NULL. obviously, this should be fixed, but I need
to talk to Rob R. first. -- BRT */
/* XXX DJG it does work, but only because MPI_LONG_DOUBLE_INT is the
* only one that is ever optional and it comes last */
/* we use the _unsafe version because we are still in MPI_Init, before
* multiple threads are permitted and possibly before support for
* critical sections is entirely setup */
ptr = (MPID_Datatype *)MPIU_Handle_obj_alloc_unsafe( &MPID_Datatype_mem );
MPIU_Assert(ptr);
MPIU_Assert(ptr->handle == mpi_pairtypes[i]);
/* this is a redundant alternative to the previous statement */
MPIU_Assert((void *) ptr == (void *) (MPID_Datatype_direct + HANDLE_INDEX(mpi_pairtypes[i])));
mpi_errno = MPID_Type_create_pairtype(mpi_pairtypes[i], (MPID_Datatype *) ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
}
MPIR_Add_finalize(MPIR_Datatype_finalize, 0,
MPIR_FINALIZE_CALLBACK_PRIO-1);
fn_fail:
return mpi_errno;
}
/* Local routine to initialize the data structures for the dynamic
error classes and codes.
MPIR_Init_err_dyncodes is called if not_initialized is true.
Because all of the routines in this file are called by the
MPI_Add_error_xxx routines, and those routines use the SINGLE_CS
when the implementation is multithreaded, these routines (until
we implement finer-grain thread-synchronization) need not worry about
multiple threads
*/
static void MPIR_Init_err_dyncodes(void)
{
int i;
/* FIXME: Does this need a thread-safe init? */
not_initialized = 0;
for (i = 0; i < ERROR_MAX_NCLASS; i++) {
user_class_msgs[i] = 0;
}
for (i = 0; i < ERROR_MAX_NCODE; i++) {
user_code_msgs[i] = 0;
}
/* Set the routine to provides access to the dynamically created
* error strings */
MPIR_Process.errcode_to_string = get_dynerr_string;
/* Add a finalize handler to free any allocated space */
MPIR_Add_finalize(MPIR_Dynerrcodes_finalize, (void *) 0, 9);
}
static void context_id_init(void)
{
int i;
for (i = 1; i < MPIR_MAX_CONTEXT_MASK; i++) {
context_mask[i] = 0xFFFFFFFF;
}
/* The first two values are already used (comm_world, comm_self).
* The third value is also used for the internal-only copy of
* comm_world, if needed by mpid. */
#ifdef MPID_NEEDS_ICOMM_WORLD
context_mask[0] = 0xFFFFFFF8;
#else
context_mask[0] = 0xFFFFFFFC;
#endif
initialize_context_mask = 0;
#ifdef MPICH_DEBUG_HANDLEALLOC
/* check for context ID leaks in MPI_Finalize. Use (_PRIO-1) to make sure
* that we run after MPID_Finalize. */
MPIR_Add_finalize(check_context_ids_on_finalize, context_mask, MPIR_FINALIZE_CALLBACK_PRIO - 1);
#endif
}
/*@
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-- */
}
int MPIR_Create_unnamed_predefined(MPI_Datatype old, int combiner,
int r, int p, MPI_Datatype * new_ptr)
{
int i;
int mpi_errno = MPI_SUCCESS;
F90Predefined *type;
*new_ptr = MPI_DATATYPE_NULL;
/* Has this type been defined already? */
for (i = 0; i < nAlloc; i++) {
type = &f90Types[i];
if (type->combiner == combiner && type->r == r && type->p == p) {
*new_ptr = type->d;
return mpi_errno;
}
}
/* Create a new type and remember it */
if (nAlloc >= MAX_F90_TYPES) {
return MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
"MPIF_Create_unnamed_predefined", __LINE__,
MPI_ERR_INTERN, "**f90typetoomany", 0);
}
if (nAlloc == 0) {
/* Install the finalize callback that frees these datatyeps.
* Set the priority high enough that this will be executed
* before the handle allocation check */
MPIR_Add_finalize(MPIR_FreeF90Datatypes, 0, 2);
}
type = &f90Types[nAlloc++];
type->combiner = combiner;
type->r = r;
type->p = p;
/* Create a contiguous type from one instance of the named type */
mpi_errno = MPIR_Type_contiguous(1, old, &type->d);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Initialize the contents data */
{
MPIR_Datatype *new_dtp = NULL;
int vals[2];
int nvals = 0;
switch (combiner) {
case MPI_COMBINER_F90_INTEGER:
nvals = 1;
vals[0] = r;
break;
case MPI_COMBINER_F90_REAL:
case MPI_COMBINER_F90_COMPLEX:
nvals = 2;
vals[0] = p;
vals[1] = r;
break;
}
MPIR_Datatype_get_ptr(type->d, new_dtp);
mpi_errno = MPIR_Datatype_set_contents(new_dtp, combiner, nvals, 0, 0, vals, NULL, NULL);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* FIXME should we be setting type->is_permanent=TRUE here too? If so,
* will the cleanup code handle it correctly and not freak out? */
#ifndef NDEBUG
{
MPI_Datatype old_basic = MPI_DATATYPE_NULL;
MPI_Datatype new_basic = MPI_DATATYPE_NULL;
/* we used MPIR_Type_contiguous and then stomped it's contents
* information, so make sure that the basic_type is usable by
* MPIR_Type_commit */
MPIR_Datatype_get_basic_type(old, old_basic);
MPIR_Datatype_get_basic_type(new_dtp->handle, new_basic);
MPIR_Assert(new_basic == old_basic);
}
#endif
/* the MPI Standard requires that these types are pre-committed
* (MPI-2.2, sec 16.2.5, pg 492) */
mpi_errno = MPIR_Type_commit(&type->d);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
*new_ptr = type->d;
fn_fail:
return mpi_errno;
}
static int init_default_collops(void)
{
int mpi_errno = MPI_SUCCESS;
int i;
struct MPID_Collops *ops = NULL;
MPIU_CHKPMEM_DECL(MPID_HIERARCHY_SIZE + 1);
/* first initialize the intracomms */
for (i = 0; i < MPID_HIERARCHY_SIZE; ++i) {
MPIU_CHKPMEM_CALLOC(ops, struct MPID_Collops *, sizeof(struct MPID_Collops), mpi_errno,
"default intracomm collops");
ops->ref_count = 1; /* force existence until finalize time */
/* intracomm default defaults... */
ops->Ibcast_sched = &MPIR_Ibcast_intra;
ops->Ibarrier_sched = &MPIR_Ibarrier_intra;
ops->Ireduce_sched = &MPIR_Ireduce_intra;
ops->Ialltoall_sched = &MPIR_Ialltoall_intra;
ops->Ialltoallv_sched = &MPIR_Ialltoallv_intra;
ops->Ialltoallw_sched = &MPIR_Ialltoallw_intra;
ops->Iallreduce_sched = &MPIR_Iallreduce_intra;
ops->Igather_sched = &MPIR_Igather_intra;
ops->Igatherv_sched = &MPIR_Igatherv;
ops->Iscatter_sched = &MPIR_Iscatter_intra;
ops->Iscatterv_sched = &MPIR_Iscatterv;
ops->Ireduce_scatter_sched = &MPIR_Ireduce_scatter_intra;
ops->Ireduce_scatter_block_sched = &MPIR_Ireduce_scatter_block_intra;
ops->Iallgather_sched = &MPIR_Iallgather_intra;
ops->Iallgatherv_sched = &MPIR_Iallgatherv_intra;
ops->Iscan_sched = &MPIR_Iscan_rec_dbl;
ops->Iexscan_sched = &MPIR_Iexscan;
ops->Neighbor_allgather = &MPIR_Neighbor_allgather_default;
ops->Neighbor_allgatherv = &MPIR_Neighbor_allgatherv_default;
ops->Neighbor_alltoall = &MPIR_Neighbor_alltoall_default;
ops->Neighbor_alltoallv = &MPIR_Neighbor_alltoallv_default;
ops->Neighbor_alltoallw = &MPIR_Neighbor_alltoallw_default;
ops->Ineighbor_allgather = &MPIR_Ineighbor_allgather_default;
ops->Ineighbor_allgatherv = &MPIR_Ineighbor_allgatherv_default;
ops->Ineighbor_alltoall = &MPIR_Ineighbor_alltoall_default;
ops->Ineighbor_alltoallv = &MPIR_Ineighbor_alltoallv_default;
ops->Ineighbor_alltoallw = &MPIR_Ineighbor_alltoallw_default;
/* override defaults, such as for SMP */
switch (i) {
case MPID_HIERARCHY_FLAT:
break;
case MPID_HIERARCHY_PARENT:
ops->Ibcast_sched = &MPIR_Ibcast_SMP;
ops->Iscan_sched = &MPIR_Iscan_SMP;
ops->Iallreduce_sched = &MPIR_Iallreduce_SMP;
ops->Ireduce_sched = &MPIR_Ireduce_SMP;
break;
case MPID_HIERARCHY_NODE:
break;
case MPID_HIERARCHY_NODE_ROOTS:
break;
/* --BEGIN ERROR HANDLING-- */
default:
MPIU_Assertp(FALSE);
break;
/* --END ERROR HANDLING-- */
}
/* this is a default table, it's not overriding another table */
ops->prev_coll_fns = NULL;
default_collops[i] = ops;
}
/* now the intercomm table */
{
MPIU_CHKPMEM_CALLOC(ops, struct MPID_Collops *, sizeof(struct MPID_Collops), mpi_errno,
"default intercomm collops");
ops->ref_count = 1; /* force existence until finalize time */
/* intercomm defaults */
ops->Ibcast_sched = &MPIR_Ibcast_inter;
ops->Ibarrier_sched = &MPIR_Ibarrier_inter;
ops->Ireduce_sched = &MPIR_Ireduce_inter;
ops->Ialltoall_sched = &MPIR_Ialltoall_inter;
ops->Ialltoallv_sched = &MPIR_Ialltoallv_inter;
ops->Ialltoallw_sched = &MPIR_Ialltoallw_inter;
ops->Iallreduce_sched = &MPIR_Iallreduce_inter;
ops->Igather_sched = &MPIR_Igather_inter;
ops->Igatherv_sched = &MPIR_Igatherv;
ops->Iscatter_sched = &MPIR_Iscatter_inter;
ops->Iscatterv_sched = &MPIR_Iscatterv;
ops->Ireduce_scatter_sched = &MPIR_Ireduce_scatter_inter;
ops->Ireduce_scatter_block_sched = &MPIR_Ireduce_scatter_block_inter;
ops->Iallgather_sched = &MPIR_Iallgather_inter;
ops->Iallgatherv_sched = &MPIR_Iallgatherv_inter;
/* scan and exscan are not valid for intercommunicators, leave them NULL */
/* Ineighbor_all* routines are not valid for intercommunicators, leave
* them NULL */
/* this is a default table, it's not overriding another table */
ops->prev_coll_fns = NULL;
ic_default_collops = ops;
}
/* run after MPID_Finalize to permit collective usage during finalize */
MPIR_Add_finalize(cleanup_default_collops, NULL, MPIR_FINALIZE_CALLBACK_PRIO - 1);
MPIU_CHKPMEM_COMMIT();
fn_exit:
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
MPIU_CHKPMEM_REAP();
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Bsend_attach( void *buffer, int buffer_size )
{
MPIR_Bsend_data_t *p;
size_t offset, align_sz;
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
if (BsendBuffer.buffer) {
return MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
"MPIR_Bsend_attach", __LINE__, MPI_ERR_BUFFER,
"**bufexists", 0 );
}
if (buffer_size < MPI_BSEND_OVERHEAD) {
/* MPI_ERR_OTHER is another valid choice for this error,
but the Intel test wants MPI_ERR_BUFFER, and it seems
to violate the principle of least surprise to not use
MPI_ERR_BUFFER for errors with the Buffer */
return MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
"MPIR_Bsend_attach", __LINE__, MPI_ERR_BUFFER,
"**bsendbufsmall",
"**bsendbufsmall %d %d", buffer_size, MPI_BSEND_OVERHEAD );
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
if (!initialized) {
initialized = 1;
MPIR_Add_finalize( MPIR_Bsend_finalize, (void *)0, 10 );
}
BsendBuffer.origbuffer = buffer;
BsendBuffer.origbuffer_size = buffer_size;
BsendBuffer.buffer = buffer;
BsendBuffer.buffer_size = buffer_size;
/* Make sure that the buffer that we use is aligned to align_sz. Some other
code assumes pointer-alignment, and some code assumes double alignment.
Further, GCC 4.5.1 generates bad code on 32-bit platforms when this is
only 4-byte aligned (see #1149). */
align_sz = MPIR_MAX(sizeof(void *), sizeof(double));
offset = ((size_t)buffer) % align_sz;
if (offset) {
offset = align_sz - offset;
buffer = (char *)buffer + offset;
BsendBuffer.buffer = buffer;
BsendBuffer.buffer_size -= offset;
}
BsendBuffer.avail = buffer;
BsendBuffer.pending = 0;
BsendBuffer.active = 0;
/* Set the first block */
p = (MPIR_Bsend_data_t *)buffer;
p->size = buffer_size - BSENDDATA_HEADER_TRUE_SIZE;
p->total_size = buffer_size;
p->next = p->prev = NULL;
p->msg.msgbuf = (char *)p + BSENDDATA_HEADER_TRUE_SIZE;
return MPI_SUCCESS;
}
void *MPIU_Handle_obj_alloc_unsafe(MPIU_Object_alloc_t *objmem)
{
MPIU_Handle_common *ptr;
if (objmem->avail) {
ptr = objmem->avail;
objmem->avail = objmem->avail->next;
/* We do not clear ptr->next as we set it to an invalid pattern
when doing memory debugging and we don't need to set it
for the production/default case */
/* ptr points to object to allocate */
}
else {
int objsize, objkind;
int performed_initialize = 0;
objsize = objmem->size;
objkind = objmem->kind;
if (!objmem->initialized) {
performed_initialize = 1;
MPL_VG_CREATE_MEMPOOL(objmem, 0/*rzB*/, 0/*is_zeroed*/);
/* Setup the first block. This is done here so that short MPI
jobs do not need to include any of the Info code if no
Info-using routines are used */
objmem->initialized = 1;
ptr = MPIU_Handle_direct_init(objmem->direct,
objmem->direct_size,
objsize,
objkind);
if (ptr) {
objmem->avail = ptr->next;
}
#ifdef MPICH_DEBUG_HANDLEALLOC
/* The priority of these callbacks must be greater than
the priority of the callback that frees the objmem direct and
indirect storage. */
MPIR_Add_finalize(MPIU_CheckHandlesOnFinalize, objmem, MPIR_FINALIZE_CALLBACK_HANDLE_CHECK_PRIO);
#endif
/* ptr points to object to allocate */
}
else {
/* no space left in direct block; setup the indirect block. */
ptr = MPIU_Handle_indirect_init(&objmem->indirect,
&objmem->indirect_size,
HANDLE_BLOCK_INDEX_SIZE,
HANDLE_BLOCK_SIZE,
objsize,
objkind);
if (ptr) {
objmem->avail = ptr->next;
}
/* ptr points to object to allocate */
}
MPIU_Handle_obj_alloc_complete(objmem, performed_initialize);
}
if (ptr) {
#ifdef USE_MEMORY_TRACING
/* We set the object to an invalid pattern. This is similar to
what is done by MPIU_trmalloc by default (except that trmalloc uses
0xda as the byte in the memset)
*/
/* if the object was previously freed then MEMPOOL_FREE marked it as
* NOACCESS, so we need to make it addressable again before memsetting
* it */
/* save and restore the handle -- it's a more robust method than
* encoding the layout of the structure */
int tmp_handle;
MPL_VG_MAKE_MEM_DEFINED(ptr, objmem->size);
tmp_handle = ptr->handle ;
memset(ptr, 0xef, objmem->size);
ptr->handle = tmp_handle;
#endif /* USE_MEMORY_TRACING */
/* mark the mem as addressable yet undefined if valgrind is available */
MPL_VG_MEMPOOL_ALLOC(objmem, ptr, objmem->size);
/* the handle value is always valid at return from this function */
MPL_VG_MAKE_MEM_DEFINED(&ptr->handle, sizeof(ptr->handle));
/* necessary to prevent annotations from being misinterpreted. HB/HA
* arcs will be drawn between a req object in across a free/alloc
* boundary otherwise */
/* NOTE: basically causes DRD's --trace-addr option to be useless for
* handlemem-allocated objects. Consider one of the trace-inducing
* annotations instead. */
MPL_VG_ANNOTATE_NEW_MEMORY(ptr, objmem->size);
/* must come after NEW_MEMORY annotation above to avoid problems */
MPIU_THREAD_MPI_OBJ_INIT(ptr);
MPIU_DBG_MSG_FMT(HANDLE,TYPICAL,(MPIU_DBG_FDEST,
"Allocating object ptr %p (handle val 0x%08x)",
ptr, ptr->handle));
}
return ptr;
}
/*
* If MPICH is built with the --enable-debugger option, MPI_Init and
* MPI_Init_thread will call MPIR_WaitForDebugger. This ensures both that
* the debugger can gather information on the MPI job before the MPI_Init
* returns to the user and that the necessary symbols for providing
* information such as message queues is available.
*
* In addition, the environment variable MPIEXEC_DEBUG, if set, will cause
* all MPI processes to wait in this routine until the variable
* MPIR_debug_gate is set to 1.
*/
void MPIR_WaitForDebugger( void )
{
#ifdef MPIU_PROCTABLE_NEEDED
int rank = MPIR_Process.comm_world->rank;
#if defined(FINEGRAIN_MPI)
int size = MPIR_Process.comm_world->num_osprocs;
#else
int size = MPIR_Process.comm_world->local_size;
#endif
int i, maxsize;
/* FIXME: In MPICH, the executables may not have the information
on the other processes; this is part of the Process Manager Interface
(PMI). We need another way to provide this information to
a debugger */
/* The process manager probably has all of this data - the MPI2
debugger interface API provides (at least originally) a way
to access this. */
/* Also, to avoid scaling problems, we only populate the first 64
entries (default) */
maxsize = MPIR_CVAR_PROCTABLE_SIZE;
if (maxsize > size) maxsize = size;
if (rank == 0) {
char hostname[MPI_MAX_PROCESSOR_NAME+1];
int hostlen;
int val;
MPIR_proctable = (MPIR_PROCDESC *)MPIU_Malloc(
size * sizeof(MPIR_PROCDESC) );
for (i=0; i<size; i++) {
/* Initialize the proctable */
MPIR_proctable[i].host_name = 0;
MPIR_proctable[i].executable_name = 0;
MPIR_proctable[i].pid = -1;
}
PMPI_Get_processor_name( hostname, &hostlen );
MPIR_proctable[0].host_name = (char *)MPIU_Strdup( hostname );
MPIR_proctable[0].executable_name = 0;
MPIR_proctable[0].pid = getpid();
for (i=1; i<maxsize; i++) {
int msg[2];
PMPI_Recv( msg, 2, MPI_INT, i, 0, MPI_COMM_WORLD,MPI_STATUS_IGNORE);
MPIR_proctable[i].pid = msg[1];
MPIR_proctable[i].host_name = (char *)MPIU_Malloc( msg[0] + 1 );
PMPI_Recv( MPIR_proctable[i].host_name, msg[0]+1, MPI_CHAR,
i, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE );
MPIR_proctable[i].host_name[msg[0]] = 0;
}
MPIR_proctable_size = size;
/* Debugging hook */
if (MPIR_CVAR_PROCTABLE_PRINT) {
for (i=0; i<maxsize; i++) {
printf( "PT[%d].pid = %d, .host_name = %s\n",
i, MPIR_proctable[i].pid, MPIR_proctable[i].host_name );
}
fflush( stdout );
}
MPIR_Add_finalize( MPIR_FreeProctable, MPIR_proctable, 0 );
}
else {
char hostname[MPI_MAX_PROCESSOR_NAME+1];
int hostlen;
int mypid = getpid();
int msg[2];
if (rank < maxsize) {
PMPI_Get_processor_name( hostname, &hostlen );
msg[0] = hostlen;
msg[1] = mypid;
/* Deliver to the root process the proctable information */
PMPI_Ssend( msg, 2, MPI_INT, 0, 0, MPI_COMM_WORLD );
PMPI_Ssend( hostname, hostlen, MPI_CHAR, 0, 0, MPI_COMM_WORLD );
}
}
#endif /* MPIU_PROCTABLE_NEEDED */
/* Put the breakpoint after setting up the proctable */
MPIR_debug_state = MPIR_DEBUG_SPAWNED;
#ifdef MPIU_BREAKPOINT_NEEDED
(void)MPIR_Breakpoint();
#endif
/* After we exit the MPIR_Breakpoint routine, the debugger may have
set variables such as MPIR_being_debugged */
/* Initialize the sendq support */
SendqInit();
if (getenv("MPIEXEC_DEBUG")) {
while (!MPIR_debug_gate) ;
}
}
