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; }