Exemplo n.º 1
0
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);
}
Exemplo n.º 2
0
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;
}
Exemplo n.º 3
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);
}
Exemplo n.º 4
0
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;
}
Exemplo n.º 5
0
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);
}
Exemplo n.º 6
0
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;
}
Exemplo n.º 7
0
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);
}
Exemplo n.º 8
0
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);
}
Exemplo n.º 9
0
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);
}
Exemplo n.º 10
0
/**
 * 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();
}
Exemplo n.º 12
0
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;
}
Exemplo n.º 13
0
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;
}
Exemplo n.º 14
0
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);
}
Exemplo n.º 15
0
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;
}
Exemplo n.º 17
0
/* 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;
}
Exemplo n.º 18
0
  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);
  }
Exemplo n.º 19
0
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++;
}
Exemplo n.º 20
0
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;
}
Exemplo n.º 21
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);
}
Exemplo n.º 22
0
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;
}
Exemplo n.º 23
0
/**
   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
}
Exemplo n.º 24
0
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;
}
Exemplo n.º 25
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;
}
Exemplo n.º 26
0
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;
}
Exemplo n.º 27
0
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-- */
}
Exemplo n.º 28
0
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);
}
Exemplo n.º 29
0
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;
}
Exemplo n.º 30
0
/**
 * 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 */