int MPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
int dest, int sendtag, void *recvbuf, int recvcount,
MPI_Datatype recvtype, int source, int recvtag,
MPI_Comm comm, MPI_Status *status)
{
char sendtypename[MPI_MAX_OBJECT_NAME], recvtypename[MPI_MAX_OBJECT_NAME];
char commname[MPI_MAX_OBJECT_NAME];
int len;
int rank;
int size;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
PMPI_Type_get_name(sendtype, sendtypename, &len);
PMPI_Type_get_name(sendtype, recvtypename, &len);
PMPI_Comm_get_name(comm, commname, &len);
PMPI_Type_size(recvtype, &size);
fprintf(stderr, "MPI_SENDRECV[%d]: sendbuf %0" PRIxPTR " sendcount %d sendtype %s dest %d sendtag %d\n\t"
"recvbuf %0" PRIxPTR " recvcount %d recvtype %s source %d recvtag %d comm %s\n",
rank, (uintptr_t) sendbuf, sendcount, sendtypename, dest, sendtag,
(uintptr_t) recvbuf, recvcount, recvtypename, source, recvtag, commname);
fflush(stderr);
memset(recvbuf, 0, recvcount*size);
return PMPI_Sendrecv(sendbuf, sendcount, sendtype, dest, sendtag,
recvbuf, recvcount, recvtype, source, recvtag,
comm, status);
}
int MPI_Init( int *argc, char **argv[] )
{
int i, j;
// call real init function
PMPI_Init( argc, argv );
// get current rank
PMPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
// get total number of process
PMPI_Comm_size(MPI_COMM_WORLD, &proc_num);
if(my_rank == 0){
send_count = (int *)malloc(proc_num * proc_num * sizeof(int));
send_size = (int *)malloc(proc_num * proc_num * sizeof(int));
}
// allocate space for local statistic storage
my_send_count = (int *)malloc(proc_num * sizeof(int));
my_send_size = (int *)malloc(proc_num * sizeof(int));
// init stastistic storage
for(i = 0; i < proc_num; i++){
my_send_count[i] = 0;
my_send_size[i] = 0;
}
return 0;
}
int MPI_Accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
int target_rank, MPI_Aint target_disp, int target_count,
MPI_Datatype target_datatype, MPI_Op op, MPI_Win win)
{
char typename[MPI_MAX_OBJECT_NAME], target_dt[MPI_MAX_OBJECT_NAME];
char winname[MPI_MAX_OBJECT_NAME];
int len;
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
PMPI_Type_get_name(origin_datatype, typename, &len);
PMPI_Type_get_name(target_datatype, target_dt, &len);
PMPI_Win_get_name(win, winname, &len);
fprintf(stderr, "MPI_ACCUMULATE[%d]: origin_addr %0" PRIxPTR " origin_count %d origin_datatype %s\n"
"\ttarget_rank %d target_disp %" PRIdPTR " target_count %d target_datatype %s op %s win %s\n",
rank, (uintptr_t)origin_addr, origin_count, typename, target_rank, (intptr_t) target_disp,
target_count, target_dt, op->o_name, winname);
fflush(stderr);
return PMPI_Accumulate(origin_addr, origin_count, origin_datatype,
target_rank, target_disp, target_count,
target_datatype, op, win);
}
int MPI_Init(int* argc, char*** argv)
{
int result, MPIT_result;
int provided;
result = PMPI_Init(argc, argv);
PMPI_Comm_size(MPI_COMM_WORLD, &comm_world_size);
PMPI_Comm_rank(MPI_COMM_WORLD, &comm_world_rank);
MPIT_result = MPI_T_init_thread(MPI_THREAD_SINGLE, &provided);
if (MPIT_result != MPI_SUCCESS) {
fprintf(stderr, "ERROR : failed to intialize MPI_T interface, preventing to get monitoring results: check your OpenMPI installation\n");
PMPI_Abort(MPI_COMM_WORLD, MPIT_result);
}
MPIT_result = MPI_T_pvar_session_create(&session);
if (MPIT_result != MPI_SUCCESS) {
fprintf(stderr, "ERROR : failed to create MPI_T session, preventing to get monitoring results: check your OpenMPI installation\n");
PMPI_Abort(MPI_COMM_WORLD, MPIT_result);
}
init_monitoring_result("pml_monitoring_messages_count", &counts);
init_monitoring_result("pml_monitoring_messages_size", &sizes);
start_monitoring_result(&counts);
start_monitoring_result(&sizes);
return result;
}
int MPI_Comm_rank(MPI_Comm comm, int* rank_ptr)
{
if (handle_get_type(comm) == COMM_EP)
{
*rank_ptr = handle_get_rank(comm);
return MPI_SUCCESS;
}
else
return PMPI_Comm_rank(comm, rank_ptr);
}
static int MTCORE_Complete_flush(int start_grp_size, MTCORE_Win * uh_win)
{
int mpi_errno = MPI_SUCCESS;
int user_rank, user_nprocs;
int i, j, k;
MTCORE_DBG_PRINT_FCNAME();
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
/* Flush helpers to finish the sequence of locally issued RMA operations */
#ifdef MTCORE_ENABLE_SYNC_ALL_OPT
/* Optimization for MPI implementations that have optimized lock_all.
* However, user should be noted that, if MPI implementation issues lock messages
* for every target even if it does not have any operation, this optimization
* could lose performance and even lose asynchronous! */
MTCORE_DBG_PRINT("[%d]flush_all(active_win 0x%x)\n", user_rank, uh_win->active_win);
mpi_errno = PMPI_Win_flush_all(uh_win->active_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
#else
/* Flush every helper once in the single window.
* TODO: track op issuing, only flush the helpers which receive ops. */
for (i = 0; i < uh_win->num_h_ranks_in_uh; i++) {
mpi_errno = PMPI_Win_flush(uh_win->h_ranks_in_uh[i], uh_win->active_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
#ifdef MTCORE_ENABLE_LOCAL_LOCK_OPT
/* Need flush local target */
for (i = 0; i < start_grp_size; i++) {
if (uh_win->start_ranks_in_win_group[i] == user_rank) {
mpi_errno = PMPI_Win_flush(uh_win->my_rank_in_uh_comm, uh_win->active_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
}
#endif
#endif
/* TODO: All the operations which we have not wrapped up will be failed, because they
* are issued to user window. We need wrap up all operations.
*/
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPI_Add_error_code(int errorclass, int *errorcode)
{
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
fprintf(stderr, "MPI_ADD_ERROR_CODE[%d]: errorclass %d errcode %0" PRIxPTR "\n", rank, errorclass, (uintptr_t)errorcode);
fflush(stderr);
return PMPI_Add_error_code(errorclass, errorcode);
}
int MPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr)
{
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
fprintf(stderr, "MPI_Alloc_mem[%d]: size %0ld\n", rank, (long)size);
fflush(stderr);
return PMPI_Alloc_mem(size, info, baseptr);
}
int MPI_Address(void *location, MPI_Aint *address)
{
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
fprintf(stderr, "MPI_ADDRESS[%d]: location %0" PRIxPTR " address %0" PRIxPTR "\n",
rank, (uintptr_t)location, (uintptr_t)address);
fflush(stderr);
return PMPI_Address(location, address);
}
/**
* Measurement wrapper for MPI_Comm_rank
* @note Auto-generated by wrapgen from template: std.w
* @note C interface
* @note Introduced with MPI 1.0
* @ingroup cg
*/
int MPI_Comm_rank(MPI_Comm comm,
int* rank)
{
int return_val;
if (IS_EVENT_GEN_ON_FOR(CG))
{
EVENT_GEN_OFF();
esd_enter(epk_mpi_regid[EPK__MPI_COMM_RANK]);
return_val = PMPI_Comm_rank(comm, rank);
esd_exit(epk_mpi_regid[EPK__MPI_COMM_RANK]);
EVENT_GEN_ON();
}
else
{
return_val = PMPI_Comm_rank(comm, rank);
}
return return_val;
}
void__give_pebil_name(mpi_init_)(int* ierr){
#else
void __wrapper_name(mpi_init_)(int* ierr){
pmpi_init_(ierr);
#endif // USES_PSINSTRACER
PMPI_Comm_rank(MPI_COMM_WORLD, &__taskid);
PMPI_Comm_size(MPI_COMM_WORLD, &__ntasks);
mpiValid = 1;
fprintf(stdout, "-[p%d]- remapping to taskid %d/%d on host %u in mpi_init_ wrapper\n", getpid(), __taskid, __ntasks, gethostid());
tool_mpi_init();
}
static int MTCORE_Wait_pscw_complete_msg(int post_grp_size, MTCORE_Win * uh_win)
{
int mpi_errno = MPI_SUCCESS;
int user_rank;
int i;
char post_flg;
MPI_Request *reqs = NULL;
MPI_Status *stats = NULL;
int remote_cnt = 0;
reqs = calloc(post_grp_size, sizeof(MPI_Request));
stats = calloc(post_grp_size, sizeof(MPI_Status));
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
for (i = 0; i < post_grp_size; i++) {
int origin_rank = uh_win->post_ranks_in_win_group[i];
/* Do not receive from local target, otherwise it may deadlock.
* We do not check the wrong sync case that user calls start(self)
* before/without post(self). */
if (user_rank == origin_rank)
continue;
mpi_errno = PMPI_Irecv(&post_flg, 1, MPI_CHAR, origin_rank,
MTCORE_PSCW_CW_TAG, uh_win->user_comm, &reqs[remote_cnt++]);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MTCORE_DBG_PRINT("receive pscw complete msg from target %d \n", origin_rank);
}
/* It is blocking. */
mpi_errno = PMPI_Waitall(remote_cnt, reqs, stats);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
fn_exit:
if (reqs)
free(reqs);
if (stats)
free(stats);
return mpi_errno;
fn_fail:
goto fn_exit;
}
static int MTCORE_Send_pscw_post_msg(int post_grp_size, MTCORE_Win * uh_win)
{
int mpi_errno = MPI_SUCCESS;
int i, user_rank;
char post_flg = 1;
MPI_Request *reqs = NULL;
MPI_Status *stats = NULL;
int remote_cnt = 0;
reqs = calloc(post_grp_size, sizeof(MPI_Request));
stats = calloc(post_grp_size, sizeof(MPI_Status));
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
for (i = 0; i < post_grp_size; i++) {
int origin_rank = uh_win->post_ranks_in_win_group[i];
/* Do not send to local target, otherwise it may deadlock.
* We do not check the wrong sync case that user calls start(self)
* before post(self). */
if (user_rank == origin_rank)
continue;
mpi_errno = PMPI_Isend(&post_flg, 1, MPI_CHAR, origin_rank,
MTCORE_PSCW_PS_TAG, uh_win->user_comm, &reqs[remote_cnt++]);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
/* Set post flag to true on the main helper of post origin. */
MTCORE_DBG_PRINT("send pscw post msg to origin %d \n", origin_rank);
}
/* Has to blocking wait here to poll progress. */
mpi_errno = PMPI_Waitall(remote_cnt, reqs, stats);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
fn_exit:
if (reqs)
free(reqs);
if (stats)
free(stats);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPI_Recv(void *buf, int count, MPI_Datatype type, int source,
int tag, MPI_Comm comm, MPI_Status *status)
{
char typename[MPI_MAX_OBJECT_NAME], commname[MPI_MAX_OBJECT_NAME];
int len;
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
PMPI_Type_get_name(type, typename, &len);
PMPI_Comm_get_name(comm, commname, &len);
fprintf(stderr, "MPI_RECV[%d]: buf %0" PRIxPTR " count %d datatype %s source %d tag %d comm %s\n",
rank, (uintptr_t) buf, count, typename, source, tag, commname);
fflush(stderr);
return PMPI_Recv(buf, count, type, source, tag, comm, status);
}
int MPI_Send(const void *buf, int count, MPI_Datatype type, int dest,
int tag, MPI_Comm comm)
{
char typename[MPI_MAX_OBJECT_NAME], commname[MPI_MAX_OBJECT_NAME];
int len;
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
PMPI_Type_get_name(type, typename, &len);
PMPI_Comm_get_name(comm, commname, &len);
fprintf(stderr, "MPI_SEND[%d]: : buf %0" PRIxPTR " count %d datatype %s dest %d tag %d comm %s\n",
rank, (uintptr_t) buf, count, typename, dest, tag, commname);
fflush(stderr);
return PMPI_Send(buf, count, type, dest, tag, comm);
}
int __give_pebil_name(MPI_Init)(int* argc, char*** argv){
int retval = 0;
#else
int __wrapper_name(MPI_Init)(int* argc, char*** argv){
int retval = PMPI_Init(argc, argv);
#endif // USES_PSINSTRACER
PMPI_Comm_rank(MPI_COMM_WORLD, &__taskid);
PMPI_Comm_size(MPI_COMM_WORLD, &__ntasks);
mpiValid = 1;
fprintf(stdout, "-[p%d]- remapping to taskid %d/%d on host %u in MPI_Init wrapper\n", getpid(), __taskid, __ntasks, gethostid());
tool_mpi_init();
return retval;
}
/* MPI_Bcast_user: This is our version of MPI function. */
int MPI_Bcast_user(void *buf, int count, MPI_Datatype datatype, int root,
MPI_Comm comm)
{
int i, rank, commsize;
PMPI_Comm_size(comm, &commsize);
PMPI_Comm_rank(comm, &rank);
/* Simple linear algorithm for broadcast */
if (rank == root) {
for (i = 0; i < commsize; i++) {
if (i != root)
PMPI_Send(buf, count, datatype, i, 4321, comm);
}
} else {
PMPI_Recv(buf, count, datatype, root, 4321, comm, MPI_STATUS_IGNORE);
}
return MPI_SUCCESS;
}
void synchronize_effort_keys(effort_data& effort_log, MPI_Comm comm) {
int rank, size;
PMPI_Comm_rank(comm, &rank);
PMPI_Comm_size(comm, &size);
relatives rels = get_radix_relatives(rank, size);
if (rels.left >= 0) receive_keys(effort_log, rels.left, comm);
if (rels.right >= 0) receive_keys(effort_log, rels.right, comm);
if (rels.parent >= 0) {
send_keys(effort_log, rels.parent, comm);
receive_keys(effort_log, rels.parent, comm);
}
// TODO: be more efficient and only propagate the difference
// back up the tree.
if (rels.left >= 0) send_keys(effort_log, rels.left, comm);
if (rels.right >= 0) send_keys(effort_log, rels.right, comm);
}
void COMM_ALL_INIT(int argc, char **argv)
{
PMPI_Comm_size(MPI_COMM_WORLD, &critpath_tasks);
PMPI_Comm_rank(MPI_COMM_WORLD, &critpath_myid);
local_timestamp = 0;
critpath = 1;
after_barrier = 0;
barrier_number = 1;
graphlib_newGraph(&lgr);
barrier_number = 0;
// cp_setnode(-1,-1,-1,0);
barrier_number = 1;
cp_setnode(-1, local_timestamp, -1, critpath);
after_barrier = 1;
barrier_number++;
}
int check_comm_registry(MPI_Comm comm)
{
MPID_Comm* comm_ptr;
MPIU_THREADPRIV_DECL;
MPIU_THREADPRIV_GET;
MPID_Comm_get_ptr( comm, comm_ptr );
int context_id = 0, i =0, my_rank, size;
context_id = comm_ptr->context_id;
PMPI_Comm_rank(comm, &my_rank);
PMPI_Comm_size(comm, &size);
for (i = 0; i < comm_registered; i++){
if (comm_registry[i] == context_id){
return 1;
}
}
return 0;
}
int MPI_Allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, const int recvcounts[], const int displs[],
MPI_Datatype recvtype, MPI_Comm comm)
{
char sendtypename[MPI_MAX_OBJECT_NAME], recvtypename[MPI_MAX_OBJECT_NAME];
char commname[MPI_MAX_OBJECT_NAME];
int len;
int rank;
PMPI_Comm_rank(MPI_COMM_WORLD, &rank);
PMPI_Type_get_name(sendtype, sendtypename, &len);
PMPI_Type_get_name(recvtype, recvtypename, &len);
PMPI_Comm_get_name(comm, commname, &len);
fprintf(stderr, "MPI_ALLGATHERV[%d]: sendbuf %0" PRIxPTR " sendcount %d sendtype %s\n\trecvbuf %0" PRIxPTR " recvtype %s comm %s\n",
rank, (uintptr_t) sendbuf, sendcount, sendtypename, (uintptr_t) recvbuf, recvtypename, commname);
fflush(stderr);
return PMPI_Allgatherv(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, comm);
}
static inline int MTCORE_Win_flush_self_impl(MTCORE_Win * uh_win)
{
int mpi_errno = MPI_SUCCESS;
#ifdef MTCORE_ENABLE_SYNC_ALL_OPT
/* flush_all already flushed local target */
#else
int user_rank;
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
if (uh_win->is_self_locked) {
/* Flush local window for local communication (self-target). */
MTCORE_DBG_PRINT("[%d]flush self(%d, local win 0x%x)\n", user_rank,
uh_win->my_rank_in_uh_comm, uh_win->my_uh_win);
mpi_errno = PMPI_Win_flush(uh_win->my_rank_in_uh_comm, uh_win->my_uh_win);
if (mpi_errno != MPI_SUCCESS)
return mpi_errno;
}
#endif
return mpi_errno;
}
/**
Sets up user_state events
This does nothing if MPE is not enabled
*/
static void
setup_mpe_events(int num_types, int* types)
{
#ifdef ENABLE_MPE
PMPI_Comm_rank(MPI_COMM_WORLD,&my_log_rank);
user_state_start = malloc(num_types * sizeof(int));
user_state_end = malloc(num_types * sizeof(int));
for (int i = 0; i < num_types; i++)
{
MPE_Log_get_state_eventIDs(&user_state_start[i],
&user_state_end[i]);
if ( my_log_rank == 0 )
{
sprintf(user_state_description,"user_state_%d", types[i]);
MPE_Describe_state(user_state_start[i], user_state_end[i],
user_state_description, "MPE_CHOOSE_COLOR");
}
}
#endif
}
int main( int argc, char* argv[] )
{
int i, j;
int myrank, nprocs;
char buf[256];
MPI_Init( &argc, &argv);
PMPI_Comm_rank( MPI_COMM_WORLD, &myrank );
PMPI_Comm_size( MPI_COMM_WORLD, &nprocs );
MPI_Bcast(buf, 1, MPI_BYTE, 0, MPI_COMM_WORLD);
for( i=0; i<OUTER; i++ ) {
for( j=0; j<INNER; j++ ) {
MPI_Bcast(buf, 2, MPI_BYTE, 0, MPI_COMM_WORLD);
MPI_Bcast(buf, 3, MPI_BYTE, 0, MPI_COMM_WORLD);
}
for( j=0; j<INNER; j++ ) {
MPI_Bcast(buf, 4, MPI_BYTE, 0, MPI_COMM_WORLD);
MPI_Bcast(buf, 5, MPI_BYTE, 0, MPI_COMM_WORLD);
}
if( i==OUTER-1 ) {
MPI_Bcast(buf, 7, MPI_BYTE, 0, MPI_COMM_WORLD);
}
MPI_Bcast(buf, 6, MPI_BYTE, 0, MPI_COMM_WORLD);
MPI_Bcast(buf, 8, MPI_BYTE, 0, MPI_COMM_WORLD);
}
MPI_Bcast(buf, 9, MPI_BYTE, 0, MPI_COMM_WORLD);
MPI_Finalize();
return 0;
}
int EPLIB_init()
{
process_env_vars();
init_sig_handlers();
PMPI_Comm_rank(MPI_COMM_WORLD, &taskid);
PMPI_Comm_size(MPI_COMM_WORLD, &num_tasks);
set_local_uuid(taskid);
allocator_init();
if (max_ep == 0) return MPI_SUCCESS;
/* Initialize client */
client_init(taskid, num_tasks);
/* Register MPI type and MPI Op before any other cqueue commands */
cqueue_mpi_type_register();
cqueue_mpi_op_register();
/* Initialize communicator handles table */
handle_init();
/* Initialize window object table */
window_init();
/* Create server world and peer comm for MPI_COMM_WORLD */
EPLIB_split_comm(MPI_COMM_WORLD, 0, taskid, MPI_COMM_WORLD);
if (std_mpi_mode == STD_MPI_MODE_IMPLICIT)
block_coll_request = malloc(max_ep*sizeof(MPI_Request));
return MPI_SUCCESS;
}
static inline int MTCORE_Win_unlock_self_impl(MTCORE_Win * uh_win)
{
int mpi_errno = MPI_SUCCESS;
#ifdef MTCORE_ENABLE_SYNC_ALL_OPT
/* unlockall already released window for local target */
#else
int user_rank;
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
if (uh_win->is_self_locked) {
/* We need also release the lock of local rank */
MTCORE_DBG_PRINT("[%d]unlock self(%d, local win 0x%x)\n", user_rank,
uh_win->my_rank_in_uh_comm, uh_win->my_uh_win);
mpi_errno = PMPI_Win_unlock(uh_win->my_rank_in_uh_comm, uh_win->my_uh_win);
if (mpi_errno != MPI_SUCCESS)
return mpi_errno;
}
#endif
uh_win->is_self_locked = 0;
return mpi_errno;
}
int MPIR_Init_thread(int * argc, char ***argv, int required, int * provided)
{
int mpi_errno = MPI_SUCCESS;
int has_args;
int has_env;
int thread_provided;
int exit_init_cs_on_failure = 0;
/* For any code in the device that wants to check for runtime
decisions on the value of isThreaded, set a provisional
value here. We could let the MPID_Init routine override this */
#ifdef HAVE_RUNTIME_THREADCHECK
MPIR_ThreadInfo.isThreaded = required == MPI_THREAD_MULTIPLE;
#endif
MPIU_THREAD_CS_INIT;
/* FIXME: Move to os-dependent interface? */
#ifdef HAVE_WINDOWS_H
/* prevent the process from bringing up an error message window if mpich
asserts */
_CrtSetReportMode( _CRT_ASSERT, _CRTDBG_MODE_FILE );
_CrtSetReportFile( _CRT_ASSERT, _CRTDBG_FILE_STDERR );
_CrtSetReportHook2(_CRT_RPTHOOK_INSTALL, assert_hook);
#ifdef _WIN64
{
/* FIXME: (Windows) This severly degrades performance but fixes alignment
issues with the datatype code. */
/* Prevent misaligned faults on Win64 machines */
UINT mode, old_mode;
old_mode = SetErrorMode(SEM_NOALIGNMENTFAULTEXCEPT);
mode = old_mode | SEM_NOALIGNMENTFAULTEXCEPT;
SetErrorMode(mode);
}
#endif
#endif
/* We need this inorder to implement IS_THREAD_MAIN */
# if (MPICH_THREAD_LEVEL >= MPI_THREAD_SERIALIZED) && defined(MPICH_IS_THREADED)
{
MPID_Thread_self(&MPIR_ThreadInfo.master_thread);
}
# endif
#ifdef HAVE_ERROR_CHECKING
/* Because the PARAM system has not been initialized, temporarily
uncondtionally enable error checks. Once the PARAM system is
initialized, this may be reset */
MPIR_Process.do_error_checks = 1;
#else
MPIR_Process.do_error_checks = 0;
#endif
/* Initialize necessary subsystems and setup the predefined attribute
values. Subsystems may change these values. */
MPIR_Process.attrs.appnum = -1;
MPIR_Process.attrs.host = 0;
MPIR_Process.attrs.io = 0;
MPIR_Process.attrs.lastusedcode = MPI_ERR_LASTCODE;
MPIR_Process.attrs.tag_ub = 0;
MPIR_Process.attrs.universe = MPIR_UNIVERSE_SIZE_NOT_SET;
MPIR_Process.attrs.wtime_is_global = 0;
/* Set the functions used to duplicate attributes. These are
when the first corresponding keyval is created */
MPIR_Process.attr_dup = 0;
MPIR_Process.attr_free = 0;
#ifdef HAVE_CXX_BINDING
/* Set the functions used to call functions in the C++ binding
for reductions and attribute operations. These are null
until a C++ operation is defined. This allows the C code
that implements these operations to not invoke a C++ code
directly, which may force the inclusion of symbols known only
to the C++ compiler (e.g., under more non-GNU compilers, including
Solaris and IRIX). */
MPIR_Process.cxx_call_op_fn = 0;
#endif
/* This allows the device to select an alternative function for
dimsCreate */
MPIR_Process.dimsCreate = 0;
/* "Allocate" from the reserved space for builtin communicators and
(partially) initialize predefined communicators. comm_parent is
intially NULL and will be allocated by the device if the process group
was started using one of the MPI_Comm_spawn functions. */
MPIR_Process.comm_world = MPID_Comm_builtin + 0;
MPIR_Comm_init(MPIR_Process.comm_world);
MPIR_Process.comm_world->handle = MPI_COMM_WORLD;
MPIR_Process.comm_world->context_id = 0 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.comm_world->recvcontext_id = 0 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.comm_world->comm_kind = MPID_INTRACOMM;
/* This initialization of the comm name could be done only when
comm_get_name is called */
MPIU_Strncpy(MPIR_Process.comm_world->name, "MPI_COMM_WORLD",
MPI_MAX_OBJECT_NAME);
MPIR_Process.comm_self = MPID_Comm_builtin + 1;
MPIR_Comm_init(MPIR_Process.comm_self);
MPIR_Process.comm_self->handle = MPI_COMM_SELF;
MPIR_Process.comm_self->context_id = 1 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.comm_self->recvcontext_id = 1 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.comm_self->comm_kind = MPID_INTRACOMM;
MPIU_Strncpy(MPIR_Process.comm_self->name, "MPI_COMM_SELF",
MPI_MAX_OBJECT_NAME);
#ifdef MPID_NEEDS_ICOMM_WORLD
MPIR_Process.icomm_world = MPID_Comm_builtin + 2;
MPIR_Comm_init(MPIR_Process.icomm_world);
MPIR_Process.icomm_world->handle = MPIR_ICOMM_WORLD;
MPIR_Process.icomm_world->context_id = 2 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.icomm_world->recvcontext_id= 2 << MPID_CONTEXT_PREFIX_SHIFT;
MPIR_Process.icomm_world->comm_kind = MPID_INTRACOMM;
MPIU_Strncpy(MPIR_Process.icomm_world->name, "MPI_ICOMM_WORLD",
MPI_MAX_OBJECT_NAME);
/* Note that these communicators are not ready for use - MPID_Init
will setup self and world, and icomm_world if it desires it. */
#endif
MPIR_Process.comm_parent = NULL;
/* Setup the initial communicator list in case we have
enabled the debugger message-queue interface */
MPIR_COMML_REMEMBER( MPIR_Process.comm_world );
MPIR_COMML_REMEMBER( MPIR_Process.comm_self );
/* Call any and all MPID_Init type functions */
MPIR_Err_init();
MPIR_Datatype_init();
MPIR_Group_init();
/* MPIU_Timer_pre_init(); */
mpi_errno = MPIR_Param_init_params();
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Wait for debugger to attach if requested. */
if (MPIR_PARAM_DEBUG_HOLD) {
volatile int hold = 1;
while (hold)
#ifdef HAVE_USLEEP
usleep(100);
#endif
;
}
#if HAVE_ERROR_CHECKING == MPID_ERROR_LEVEL_RUNTIME
MPIR_Process.do_error_checks = MPIR_PARAM_ERROR_CHECKING;
#endif
/* define MPI as initialized so that we can use MPI functions within
MPID_Init if necessary */
MPIR_Process.initialized = MPICH_WITHIN_MPI;
/* We can't acquire any critical sections until this point. Any
* earlier the basic data structures haven't been initialized */
MPIU_THREAD_CS_ENTER(INIT,required);
exit_init_cs_on_failure = 1;
mpi_errno = MPID_Init(argc, argv, required, &thread_provided,
&has_args, &has_env);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Capture the level of thread support provided */
MPIR_ThreadInfo.thread_provided = thread_provided;
if (provided) *provided = thread_provided;
#ifdef HAVE_RUNTIME_THREADCHECK
MPIR_ThreadInfo.isThreaded = (thread_provided == MPI_THREAD_MULTIPLE);
#endif
/* FIXME: Define these in the interface. Does Timer init belong here? */
MPIU_dbg_init(MPIR_Process.comm_world->rank);
MPIU_Timer_init(MPIR_Process.comm_world->rank,
MPIR_Process.comm_world->local_size);
#ifdef USE_MEMORY_TRACING
MPIU_trinit( MPIR_Process.comm_world->rank );
/* Indicate that we are near the end of the init step; memory
allocated already will have an id of zero; this helps
separate memory leaks in the initialization code from
leaks in the "active" code */
/* Uncomment this code to leave out any of the MPID_Init/etc
memory allocations from the memory leak testing */
/* MPIU_trid( 1 ); */
#endif
#ifdef USE_DBG_LOGGING
MPIU_DBG_Init( argc, argv, has_args, has_env,
MPIR_Process.comm_world->rank );
#endif
/* Initialize the C versions of the Fortran link-time constants.
We now initialize the Fortran symbols from within the Fortran
interface in the routine that first needs the symbols.
This fixes a problem with symbols added by a Fortran compiler that
are not part of the C runtime environment (the Portland group
compilers would do this)
*/
#if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C)
mpirinitf_();
#endif
/* FIXME: Does this need to come before the call to MPID_InitComplete?
For some debugger support, MPIR_WaitForDebugger may want to use
MPI communication routines to collect information for the debugger */
#ifdef HAVE_DEBUGGER_SUPPORT
MPIR_WaitForDebugger();
#endif
/* Let the device know that the rest of the init process is completed */
if (mpi_errno == MPI_SUCCESS)
mpi_errno = MPID_InitCompleted();
#if defined(_OSU_MVAPICH_) || defined(_OSU_PSM_)
if (is_shmem_collectives_enabled()){
if (check_split_comm(pthread_self())){
int my_id, size;
PMPI_Comm_rank(MPI_COMM_WORLD, &my_id);
PMPI_Comm_size(MPI_COMM_WORLD, &size);
disable_split_comm(pthread_self());
create_2level_comm(MPI_COMM_WORLD, size, my_id);
enable_split_comm(pthread_self());
}
}
#endif /* defined(_OSU_MVAPICH_) || defined(_OSU_PSM_) */
fn_exit:
MPIU_THREAD_CS_EXIT(INIT,required);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
/* signal to error handling routines that core services are unavailable */
MPIR_Process.initialized = MPICH_PRE_INIT;
if (exit_init_cs_on_failure) {
MPIU_THREAD_CS_EXIT(INIT,required);
}
MPIU_THREAD_CS_FINALIZE;
return mpi_errno;
/* --END ERROR HANDLING-- */
}
void vt_sync(MPI_Comm comm, uint64_t* ltime, int64_t* offset)
{
VT_MPI_INT myrank, myrank_host, myrank_sync;
VT_MPI_INT numnodes;
uint64_t time;
MPI_Comm host_comm;
MPI_Comm sync_comm;
VT_SUSPEND_IO_TRACING(VT_CURRENT_THREAD);
/* mark begin of clock synchronization */
time = vt_pform_wtime();
vt_enter(VT_CURRENT_THREAD, &time, vt_trc_regid[VT__TRC_SYNCTIME]);
/* barrier at entry */
PMPI_Barrier(comm);
*offset = 0;
*ltime = vt_pform_wtime();
PMPI_Comm_rank(comm, &myrank);
/* create communicator containing all processes on the same node */
PMPI_Comm_split(comm, (vt_pform_node_id() & 0x7FFFFFFF), 0, &host_comm);
PMPI_Comm_rank(host_comm, &myrank_host);
/* create communicator containing all processes with rank zero in the
previously created communicators */
PMPI_Comm_split(comm, myrank_host, 0, &sync_comm);
PMPI_Comm_rank(sync_comm, &myrank_sync);
PMPI_Comm_size(sync_comm, &numnodes);
/* measure offsets between all nodes and the root node (rank 0 in sync_comm) */
if (myrank_host == 0)
{
VT_MPI_INT i;
for (i = 1; i < numnodes; i++)
{
PMPI_Barrier(sync_comm);
if (myrank_sync == i)
*offset = sync_slave(ltime, 0, sync_comm);
else if (myrank_sync == 0)
*offset = sync_master(ltime, i, sync_comm);
}
}
/* distribute offset and ltime across all processes on the same node */
PMPI_Bcast(offset, 1, MPI_LONG_LONG_INT, 0, host_comm);
PMPI_Bcast(ltime, 1, MPI_LONG_LONG_INT, 0, host_comm);
PMPI_Comm_free(&host_comm);
PMPI_Comm_free(&sync_comm);
/* barrier at exit */
PMPI_Barrier(comm);
/* mark end of clock synchronization */
time = vt_pform_wtime();
vt_exit(VT_CURRENT_THREAD, &time);
VT_RESUME_IO_TRACING(VT_CURRENT_THREAD);
}
int MPI_Win_unlock(int target_rank, MPI_Win win)
{
MTCORE_Win *uh_win;
int mpi_errno = MPI_SUCCESS;
int user_rank;
int j, k;
MTCORE_DBG_PRINT_FCNAME();
MTCORE_Fetch_uh_win_from_cache(win, uh_win);
if (uh_win == NULL) {
/* normal window */
return PMPI_Win_unlock(target_rank, win);
}
/* mtcore window starts */
MTCORE_Assert((uh_win->info_args.epoch_type & MTCORE_EPOCH_LOCK) ||
(uh_win->info_args.epoch_type & MTCORE_EPOCH_LOCK_ALL));
PMPI_Comm_rank(uh_win->user_comm, &user_rank);
uh_win->targets[target_rank].remote_lock_assert = 0;
/* Unlock all helper processes in every uh-window of target process. */
j = 0;
#ifdef MTCORE_ENABLE_SYNC_ALL_OPT
/* Optimization for MPI implementations that have optimized lock_all.
* However, user should be noted that, if MPI implementation issues lock messages
* for every target even if it does not have any operation, this optimization
* could lose performance and even lose asynchronous! */
MTCORE_DBG_PRINT("[%d]unlock_all(uh_win 0x%x), instead of target rank %d\n",
user_rank, uh_win->targets[target_rank].uh_win, target_rank);
mpi_errno = PMPI_Win_unlock_all(uh_win->targets[target_rank].uh_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
#else
for (k = 0; k < MTCORE_ENV.num_h; k++) {
int target_h_rank_in_uh = uh_win->targets[target_rank].h_ranks_in_uh[k];
MTCORE_DBG_PRINT("[%d]unlock(Helper(%d), uh_win 0x%x), instead of "
"target rank %d\n", user_rank, target_h_rank_in_uh,
uh_win->targets[target_rank].uh_win, target_rank);
mpi_errno = PMPI_Win_unlock(target_h_rank_in_uh, uh_win->targets[target_rank].uh_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
#endif
#ifdef MTCORE_ENABLE_LOCAL_LOCK_OPT
/* If target is itself, we need also release the lock of local rank */
if (user_rank == target_rank && uh_win->is_self_locked) {
mpi_errno = MTCORE_Win_unlock_self_impl(uh_win);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
#endif
#if defined(MTCORE_ENABLE_RUNTIME_LOAD_OPT)
for (j = 0; j < uh_win->targets[target_rank].num_segs; j++) {
uh_win->targets[target_rank].segs[j].main_lock_stat = MTCORE_MAIN_LOCK_RESET;
}
#endif
/* Decrease lock/lockall counter, change epoch status only when counter
* become 0. */
uh_win->lock_counter--;
if (uh_win->lockall_counter == 0 && uh_win->lock_counter == 0) {
MTCORE_DBG_PRINT("all locks are cleared ! no epoch now\n");
uh_win->epoch_stat = MTCORE_WIN_NO_EPOCH;
}
/* TODO: All the operations which we have not wrapped up will be failed, because they
* are issued to user window. We need wrap up all operations.
*/
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/**
* Measurement wrapper for MPI_Cart_create
* @note Manually adapted wrapper
* @note C interface
* @note Introduced with MPI 1.0
* @ingroup topo
*/
int MPI_Cart_create(MPI_Comm comm_old,
int ndims,
int* dims,
int* periodv,
int reorder,
MPI_Comm* comm_cart)
{
const int event_gen_active = IS_EVENT_GEN_ON_FOR(TOPO);
int return_val;
if (event_gen_active)
{
EVENT_GEN_OFF();
esd_enter(epk_mpi_regid[EPK__MPI_CART_CREATE]);
}
return_val = PMPI_Cart_create(comm_old,
ndims,
dims,
periodv,
reorder,
comm_cart);
if (*comm_cart != MPI_COMM_NULL)
{
int cid, my_rank, i;
int* coordv;
/* Create new topology object and set name */
EPIK_TOPOL * topology = EPIK_Cart_create("MPI Cartesian topology", ndims);
epk_comm_create(*comm_cart);
/* get the topid and cid */
cid = epk_comm_id(*comm_cart);
/* find the rank of the calling process */
PMPI_Comm_rank(*comm_cart, &my_rank);
/* assign the cartesian topology dimension parameters */
for (i = 0; i < ndims; i++)
{
EPIK_Cart_add_dim(topology, dims[i], periodv[i], "");
}
/* allocate space for coordv and ucoordv */
coordv = calloc(topology->num_dims, sizeof(elg_ui4));
if (coordv == NULL)
{
elg_error();
}
/* get the coordinates of the calling process in coordv */
PMPI_Cart_coords(*comm_cart, my_rank, ndims, coordv);
/* assign the coordinates */
for (i = 0; i < topology->num_dims; i++)
{
topology->coords[i] = (elg_ui4)coordv[i];
}
/* create the cartesian topology definition record */
/* Note: cannot call EPIK_Cart_commit because it does NOT record "cid" */
topology->topid = esd_def_cart(cid, topology);
/* create the coordinates definition record */
/* Could call EPIK_Cart_coords_commit, but does just produce 1 extra
* useless fun ction call */
esd_def_coords(topology);
}
if (event_gen_active)
{
esd_exit(epk_mpi_regid[EPK__MPI_CART_CREATE]);
EVENT_GEN_ON();
}
return return_val;
} /* MPI_Cart_create */