int MPIO_Err_return_file(MPI_File mpi_fh, int error_code)
{
MPI_Errhandler e;
void (*c_errhandler) (MPI_File *, int *, ...);
int kind; /* Error handler kind (see below) */
char error_msg[4096];
int len;
/* If the file pointer is not valid, we use the handler on
* MPI_FILE_NULL (MPI-2, section 9.7). For now, this code assumes that
* MPI_FILE_NULL has the default handler (return). FIXME. See
* below - the set error handler uses ADIOI_DFLT_ERR_HANDLER;
*/
/* First, get the handler and the corresponding function */
if (mpi_fh == MPI_FILE_NULL) {
e = ADIOI_DFLT_ERR_HANDLER;
} else {
ADIO_File fh;
fh = MPIO_File_resolve(mpi_fh);
e = fh->err_handler;
}
/* Actually, e is just the value provide by the MPICH routines
* file_set_errhandler. This is actually a *pointer* to the
* errhandler structure. We don't know that, so we ask
* the MPICH code to translate this object into an error handler.
* kind = 0: errors are fatal
* kind = 1: errors return
* kind = 2: errors call function
*/
if (e == MPI_ERRORS_RETURN || e == MPIR_ERRORS_THROW_EXCEPTIONS || !e) {
/* FIXME: This is a hack in case no error handler was set */
kind = 1;
c_errhandler = 0;
} else {
MPIR_Get_file_error_routine(e, &c_errhandler, &kind);
}
/* --BEGIN ERROR HANDLING-- */
if (MPIR_Err_is_fatal(error_code) || kind == 0) {
ADIO_File fh = MPIO_File_resolve(mpi_fh);
MPL_snprintf(error_msg, 4096, "I/O error: ");
len = (int) strlen(error_msg);
MPIR_Err_get_string(error_code, &error_msg[len], 4096 - len, NULL);
MPIR_Abort(fh->comm, MPI_SUCCESS, error_code, error_msg);
}
/* --END ERROR HANDLING-- */
else if (kind == 2) {
(*c_errhandler) (&mpi_fh, &error_code, 0);
} else if (kind == 3) {
MPIR_File_call_cxx_errhandler(&mpi_fh, &error_code, c_errhandler);
}
/* kind == 1 just returns */
return error_code;
}
int MPIR_Comm_commit(MPID_Comm * comm)
{
int mpi_errno = MPI_SUCCESS;
int num_local = -1, num_external = -1;
int local_rank = -1, external_rank = -1;
int *local_procs = NULL, *external_procs = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COMMIT);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COMMIT);
/* It's OK to relax these assertions, but we should do so very
* intentionally. For now this function is the only place that we create
* our hierarchy of communicators */
MPIU_Assert(comm->node_comm == NULL);
MPIU_Assert(comm->node_roots_comm == NULL);
mpi_errno = set_collops(comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Notify device of communicator creation */
mpi_errno = MPID_Dev_comm_create_hook(comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_Comm_map_free(comm);
if (comm->comm_kind == MPID_INTRACOMM) {
mpi_errno = MPIU_Find_local_and_external(comm,
&num_local, &local_rank, &local_procs,
&num_external, &external_rank, &external_procs,
&comm->intranode_table, &comm->internode_table);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno) {
if (MPIR_Err_is_fatal(mpi_errno))
MPIR_ERR_POP(mpi_errno);
/* Non-fatal errors simply mean that this communicator will not have
* any node awareness. Node-aware collectives are an optimization. */
MPIU_DBG_MSG_P(COMM, VERBOSE, "MPIU_Find_local_and_external failed for comm_ptr=%p",
comm);
if (comm->intranode_table)
MPIU_Free(comm->intranode_table);
if (comm->internode_table)
MPIU_Free(comm->internode_table);
mpi_errno = MPI_SUCCESS;
goto fn_exit;
}
/* --END ERROR HANDLING-- */
/* defensive checks */
MPIU_Assert(num_local > 0);
MPIU_Assert(num_local > 1 || external_rank >= 0);
MPIU_Assert(external_rank < 0 || external_procs != NULL);
/* if the node_roots_comm and comm would be the same size, then creating
* the second communicator is useless and wasteful. */
if (num_external == comm->remote_size) {
MPIU_Assert(num_local == 1);
goto fn_exit;
}
/* we don't need a local comm if this process is the only one on this node */
if (num_local > 1) {
mpi_errno = MPIR_Comm_create(&comm->node_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
comm->node_comm->context_id = comm->context_id + MPID_CONTEXT_INTRANODE_OFFSET;
comm->node_comm->recvcontext_id = comm->node_comm->context_id;
comm->node_comm->rank = local_rank;
comm->node_comm->comm_kind = MPID_INTRACOMM;
comm->node_comm->hierarchy_kind = MPID_HIERARCHY_NODE;
comm->node_comm->local_comm = NULL;
MPIU_DBG_MSG_D(CH3_OTHER, VERBOSE, "Create node_comm=%p\n", comm->node_comm);
comm->node_comm->local_size = num_local;
comm->node_comm->remote_size = num_local;
MPIR_Comm_map_irregular(comm->node_comm, comm, local_procs,
num_local, MPIR_COMM_MAP_DIR_L2L, NULL);
mpi_errno = set_collops(comm->node_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Notify device of communicator creation */
mpi_errno = MPID_Dev_comm_create_hook(comm->node_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* don't call MPIR_Comm_commit here */
MPIR_Comm_map_free(comm->node_comm);
}
/* this process may not be a member of the node_roots_comm */
if (local_rank == 0) {
mpi_errno = MPIR_Comm_create(&comm->node_roots_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
comm->node_roots_comm->context_id = comm->context_id + MPID_CONTEXT_INTERNODE_OFFSET;
comm->node_roots_comm->recvcontext_id = comm->node_roots_comm->context_id;
comm->node_roots_comm->rank = external_rank;
comm->node_roots_comm->comm_kind = MPID_INTRACOMM;
comm->node_roots_comm->hierarchy_kind = MPID_HIERARCHY_NODE_ROOTS;
comm->node_roots_comm->local_comm = NULL;
comm->node_roots_comm->local_size = num_external;
comm->node_roots_comm->remote_size = num_external;
MPIR_Comm_map_irregular(comm->node_roots_comm, comm,
external_procs, num_external, MPIR_COMM_MAP_DIR_L2L, NULL);
mpi_errno = set_collops(comm->node_roots_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Notify device of communicator creation */
mpi_errno = MPID_Dev_comm_create_hook(comm->node_roots_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* don't call MPIR_Comm_commit here */
MPIR_Comm_map_free(comm->node_roots_comm);
}
comm->hierarchy_kind = MPID_HIERARCHY_PARENT;
}
fn_exit:
if (external_procs != NULL)
MPIU_Free(external_procs);
if (local_procs != NULL)
MPIU_Free(local_procs);
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COMMIT);
return mpi_errno;
fn_fail:
goto fn_exit;
}
