mpid_rma_common.c

fortran并行计算包

 * \brief Generic request cache done callback with counter decr
 *
 * Callback for decrementing a "done" or pending count.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - (int *) pending counter
 * - \e w1 - ignored
 * - \e w2 - ignored
 * - \e w3 - ignored
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
void done_rqc_cb(void *v) {
        volatile unsigned *pending;
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        pending = (volatile unsigned *)xtra.w0;
        if (pending) {
                --(*pending);
        }
}

#ifdef NOT_USED
/**
 * \brief Generic request cache done callback with counter decr
 * and 2-buffer freeing.
 *
 * Callback for decrementing a "done" or pending count and
 * freeing malloc() memory, up to two pointers.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - (int *) pending counter
 * - \e w1 - ignored
 * - \e w2 - (void *) allocated memory if not NULL
 * - \e w3 - (void *) allocated memory if not NULL
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
static void done_free_rqc_cb(void *v) {
        volatile unsigned *pending;
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        pending = (volatile unsigned *)xtra.w0;
        if (pending) {
                --(*pending);
        }
        if (xtra.w2) { MPIDU_FREE(xtra.w2, e, "xtra.w2"); }
        if (xtra.w3) { MPIDU_FREE(xtra.w3, e, "xtra.w3"); }
}
#endif /* NOT_USED */

/**
 * \brief request cache done callback for Get, with counter decr,
 * ref count, buffer freeing and dt release when ref count reaches zero.
 * Also uses dt to unpack results into application buffer.
 *
 * Callback for decrementing a "done" or pending count and
 * freeing malloc() memory, up to two pointers, when ref count goes 0.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - (int *) pending counter
 * - \e w1 - (int *) get struct
 * - \e w2 - (void *) allocated memory if not NULL
 * - \e w3 - (void *) allocated memory if not NULL
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
void done_getfree_rqc_cb(void *v) {
        volatile unsigned *pending;
	volatile struct mpid_get_cb_data *get;
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        pending = (volatile unsigned *)xtra.w0;
        get = (volatile struct mpid_get_cb_data *)xtra.w1;
        if (pending) {
                --(*pending);
        }
	MPID_assert_debug(get != NULL);
        if (--get->ref == 0) {
		MPID_assert_debug(get->dtp != NULL);
		MPID_Segment segment;
		DLOOP_Offset last;

		int mpi_errno = MPID_Segment_init(get->addr,
				get->count,
				get->dtp->handle, &segment, 0);
		MPID_assert_debug(mpi_errno == MPI_SUCCESS);
		last = get->len;
		MPID_Segment_unpack(&segment, 0, &last, get->buf);
		MPID_assert_debug(last == get->len);
		MPID_Datatype_release(get->dtp);
                if (xtra.w2) { MPIDU_FREE(xtra.w2, e, "xtra.w2"); }
                if (xtra.w3) { MPIDU_FREE(xtra.w3, e, "xtra.w3"); }
        }
}


/**
 * \brief Generic request cache done callback with counter decr,
 * ref count, and 2-buffer freeing when ref count reaches zero.
 *
 * Callback for decrementing a "done" or pending count and
 * freeing malloc() memory, up to two pointers, when ref count goes 0.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - (int *) pending counter
 * - \e w1 - (int *) reference counter
 * - \e w2 - (void *) allocated memory if not NULL
 * - \e w3 - (void *) datatype to release if not NULL
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
void done_reffree_rqc_cb(void *v) {
        volatile unsigned *pending, *ref;
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        pending = (volatile unsigned *)xtra.w0;
        ref = (volatile unsigned *)xtra.w1;
        if (pending) {
                --(*pending);
        }
        if (ref == NULL || --(*ref) == 0) {
                if (xtra.w2) { MPIDU_FREE(xtra.w2, e, "xtra.w2"); }
                if (xtra.w3) { MPIDU_FREE(xtra.w3, e, "xtra.w3"); }
        }
}

#ifdef NOT_USED
/**
 * \brief Callback for freeing malloc() memory, up to two pointers.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - (void *) allocated memory if not NULL
 * - \e w1 - (void *) allocated memory if not NULL
 * - \e w2 - ignored
 * - \e w3 - ignored
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
static void free_rqc_cb(void *v) {
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        if (xtra.w0) { MPIDU_FREE(xtra.w0, e, "xtra.w0"); }
        if (xtra.w1) { MPIDU_FREE(xtra.w1, e, "xtra.w1"); }
}
#endif /* NOT_USED */

/**
 * \brief Generic request cache callback for RMA op completion
 *
 * Callback for incrementing window RMA recvs count.
 * Used only by Put and Accumulate (not used by Get).
 *
 * Only used for a "long message" - i.e. multi-packet - PUT.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - ignored
 * - \e w1 - window handle
 * - \e w2 - origin rank
 * - \e w3 - origin lpid
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
void rma_rqc_cb(void *v) {
        MPID_Win *win;
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        MPID_Win_get_ptr((MPI_Win)xtra.w1, win);
        MPID_assert_debug(win != NULL);
        rma_recvs_cb(win, xtra.w2, xtra.w3);
}

/**
 * \brief Generic callback for request cache
 *
 * Callback for simply (only) freeing the request cache object.
 *
 * To use this callback, the "xtra" info (DCQuad) must
 * be filled as follows:
 *
 * - \e w0 - ignored
 * - \e w1 - ignored
 * - \e w2 - ignored
 * - \e w3 - ignored
 *
 * \param[in] v	Pointer to DCMF request object
 * \return nothing
 *
 * \ref rqcache_design
 */
void none_rqc_cb(void *v) {
        MPIDU_free_req((DCMF_Request_t *)v, NULL);
}

#ifdef NOT_USED
/**
 * \brief Generic send done callback
 *
 * Local send callback.
 *
 * Simple "done" callback, currently used only by lock/unlock.
 * Assumes param is an int * and decrements it.
 *
 * \param[in] v	Pointer to integer counter to decrement
 * \return nothing
 */
static void done_cb(void *v) {
        int *cp = (int *)v;
        --(*cp);
}
#endif /* NOT_USED */

/**
 *  \brief receive callback for datatype cache messages (map and iov)
 *
 * \param[in] v	Pointer to request object used for transfer
 * \return	nothing
 */
void dtc1_rqc_cb(void *v) {
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        MPID_Recvdone1_rem_dt((const DCQuad *)&xtra);
}

#ifdef NOT_USED
/**
 *  \brief receive callback for datatype cache messages (map and iov)
 *
 * \param[in] v	Pointer to request object used for transfer
 * \return	nothing
 */
static void dtc2_rqc_cb(void *v) {
        DCQuad xtra;

        MPIDU_free_req((DCMF_Request_t *)v, &xtra);
        mpid_recvdone2_rem_dt((const DCQuad *)&xtra);
}
#endif /* NOT_USED */

/*
 * * * * * * * * * * * * * * * * * * * * * *
 */

/**
 * \brief Send (spray) a protocol message to a group of nodes.
 *
 * Send a protocol message to all members of a group (or the
 * window-comm if no group).
 *
 * Currently, this routine will only be called once per group
 * (i.e. once during an exposure or access epoch). If it ends
 * up being called more than once, it might make sense to build
 * a translation table between the group rank and the window
 * communicator rank.  Or if we can determine that the same
 * group is being used in multiple, successive, epochs. In practice,
 * it takes more work to build a translation table than to lookup
 * ranks ad-hoc.
 *
 * \param[in] win	Pointer to MPID_Win object
 * \param[in] grp	Optional pointer to MPID_Group object
 * \param[in] type	Type of message (MPID_MSGTYPE_*)
 * \return MPI_SUCCESS or error returned from DCMF_Send.
 *
 * \ref msginfo_usage
 */
int MPIDU_proto_send(MPID_Win *win, MPID_Group *grp, int type) {
        int lpid, x;
        MPIDU_Onesided_ctl_t ctl;
        int size, comm_size = 0, comm_rank;
        int mpi_errno = MPI_SUCCESS;
        MPID_VCR *vc;
        DCMF_Consistency consistency = win->_dev.my_cstcy;

        /*
         * \todo Confirm this:
         * For inter-comms, we only talk to the remote nodes. For
         * intra-comms there are no remote or local nodes.
         * So, we always use win->_dev.comm_ptr->vcr (?)
         * However, we have to choose remote_size, in the case of
         * inter-comms, vs. local_size. This decision also
         * affects MPIDU_world_rank_c().
         */
        size = MPIDU_comm_size(win);
        vc = MPIDU_world_vcr(win);
        MPID_assert_debug(vc != NULL && size > 0);
        if (grp) {
                comm_size = size;
                size = grp->size;
        }
        /** \todo is it OK to lower consistency here? */
        consistency = DCMF_RELAXED_CONSISTENCY;

        ctl.mpid_ctl_w0 = type;
        ctl.mpid_ctl_w2 = win->_dev.comm_ptr->rank;
        for (x = 0; x < size; ++x) {
                if (grp) {
                        int z;

                        lpid = grp->lrank_to_lpid[x].lpid;
                        /* convert group rank to comm rank */
                        for (z = 0; z < comm_size &&
                                lpid != vc[z]->lpid; ++z);
                        MPID_assert_debug(z < comm_size);
                        comm_rank = z;
                } else {
                        lpid = vc[x]->lpid;
                        comm_rank = x;
                }
                ctl.mpid_ctl_w1 = win->_dev.coll_info[comm_rank].win_handle;
                if (type == MPID_MSGTYPE_COMPLETE) {
                        ctl.mpid_ctl_w3 = win->_dev.coll_info[comm_rank].rma_sends;
                        win->_dev.coll_info[comm_rank].rma_sends = 0;
                }
                mpi_errno = DCMF_Control(&bg1s_ct_proto, consistency, lpid, &ctl.ctl);
                if (mpi_errno) { break; }
        }
        return mpi_errno;
}

/*
 * * * * * * * * * * * * * * * * * * * * * *
 */

/**
 * \brief validate whether a lpid is in a given group