1 /*
2  * Copyright (C) by Argonne National Laboratory
3  *     See COPYRIGHT in top-level directory
4  */
5 
6 #include "mpiimpl.h"
7 
8 /* -- Begin Profiling Symbol Block for routine MPI_Wait */
9 #if defined(HAVE_PRAGMA_WEAK)
10 #pragma weak MPI_Wait = PMPI_Wait
11 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
12 #pragma _HP_SECONDARY_DEF PMPI_Wait  MPI_Wait
13 #elif defined(HAVE_PRAGMA_CRI_DUP)
14 #pragma _CRI duplicate MPI_Wait as PMPI_Wait
15 #elif defined(HAVE_WEAK_ATTRIBUTE)
16 int MPI_Wait(MPI_Request * request, MPI_Status * status) __attribute__ ((weak, alias("PMPI_Wait")));
17 #endif
18 /* -- End Profiling Symbol Block */
19 
20 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
21    the MPI routines */
22 #ifndef MPICH_MPI_FROM_PMPI
23 #undef MPI_Wait
24 #define MPI_Wait PMPI_Wait
25 
26 /* MPID_Wait call MPIR_Wait_state with initialized progress state */
MPIR_Wait_state(MPIR_Request * request_ptr,MPI_Status * status,MPID_Progress_state * state)27 int MPIR_Wait_state(MPIR_Request * request_ptr, MPI_Status * status, MPID_Progress_state * state)
28 {
29     int mpi_errno = MPI_SUCCESS;
30 
31     while (!MPIR_Request_is_complete(request_ptr)) {
32         mpi_errno = MPID_Progress_wait(state);
33         MPIR_ERR_CHECK(mpi_errno);
34 
35         if (unlikely(MPIR_Request_is_anysrc_mismatched(request_ptr))) {
36             mpi_errno = MPIR_Request_handle_proc_failed(request_ptr);
37             goto fn_fail;
38         }
39     }
40 
41   fn_exit:
42     return mpi_errno;
43   fn_fail:
44     goto fn_exit;
45 }
46 
47 /* legacy interface (for ch3) */
MPIR_Wait_impl(MPIR_Request * request_ptr,MPI_Status * status)48 int MPIR_Wait_impl(MPIR_Request * request_ptr, MPI_Status * status)
49 {
50     int mpi_errno = MPI_SUCCESS;
51     MPID_Progress_state progress_state;
52 
53     MPIR_Assert(request_ptr != NULL);
54     MPID_Progress_start(&progress_state);
55     mpi_errno = MPIR_Wait_state(request_ptr, status, &progress_state);
56     MPID_Progress_end(&progress_state);
57 
58     return mpi_errno;
59 }
60 
MPIR_Wait(MPI_Request * request,MPI_Status * status)61 int MPIR_Wait(MPI_Request * request, MPI_Status * status)
62 {
63     int mpi_errno = MPI_SUCCESS;
64     int active_flag;
65     MPIR_Request *request_ptr = NULL;
66 
67     /* If this is a null request handle, then return an empty status */
68     if (*request == MPI_REQUEST_NULL) {
69         MPIR_Status_set_empty(status);
70         goto fn_exit;
71     }
72 
73     MPIR_Request_get_ptr(*request, request_ptr);
74     MPIR_Assert(request_ptr != NULL);
75 
76     if (!MPIR_Request_is_complete(request_ptr)) {
77         /* If this is an anysource request including a communicator with
78          * anysource disabled, convert the call to an MPI_Test instead so we
79          * don't get stuck in the progress engine. */
80         if (unlikely(MPIR_Request_is_anysrc_mismatched(request_ptr))) {
81             mpi_errno = MPIR_Test(request, &active_flag, status);
82             goto fn_exit;
83         }
84 
85         if (MPIR_Request_has_poll_fn(request_ptr)) {
86             while (!MPIR_Request_is_complete(request_ptr)) {
87                 mpi_errno = MPIR_Grequest_poll(request_ptr, status);
88                 MPIR_ERR_CHECK(mpi_errno);
89 
90                 /* Avoid blocking other threads since I am inside an infinite loop */
91                 MPID_THREAD_CS_YIELD(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
92             }
93         } else {
94             mpi_errno = MPID_Wait(request_ptr, status);
95             MPIR_ERR_CHECK(mpi_errno);
96         }
97     }
98 
99     mpi_errno = MPIR_Request_completion_processing(request_ptr, status);
100     if (!MPIR_Request_is_persistent(request_ptr)) {
101         MPIR_Request_free(request_ptr);
102         *request = MPI_REQUEST_NULL;
103     }
104     MPIR_ERR_CHECK(mpi_errno);
105 
106   fn_exit:
107     return mpi_errno;
108   fn_fail:
109     goto fn_exit;
110 }
111 
112 #endif
113 
114 /*@
115     MPI_Wait - Waits for an MPI request to complete
116 
117 Input Parameters:
118 . request - request (handle)
119 
120 Output Parameters:
121 . status - status object (Status).  May be 'MPI_STATUS_IGNORE'.
122 
123 .N waitstatus
124 
125 .N ThreadSafe
126 
127 .N Fortran
128 
129 .N FortranStatus
130 
131 .N Errors
132 .N MPI_SUCCESS
133 .N MPI_ERR_REQUEST
134 .N MPI_ERR_ARG
135 @*/
MPI_Wait(MPI_Request * request,MPI_Status * status)136 int MPI_Wait(MPI_Request * request, MPI_Status * status)
137 {
138     MPIR_Request *request_ptr = NULL;
139     int mpi_errno = MPI_SUCCESS;
140     MPIR_Comm *comm_ptr = NULL;
141     MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WAIT);
142 
143     MPIR_ERRTEST_INITIALIZED_ORDIE();
144 
145     MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
146     MPIR_FUNC_TERSE_REQUEST_ENTER(MPID_STATE_MPI_WAIT);
147 
148     /* Check the arguments */
149 #ifdef HAVE_ERROR_CHECKING
150     {
151         MPID_BEGIN_ERROR_CHECKS;
152         {
153             MPIR_ERRTEST_ARGNULL(request, "request", mpi_errno);
154             /* NOTE: MPI_STATUS_IGNORE != NULL */
155             MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
156             MPIR_ERRTEST_REQUEST_OR_NULL(*request, mpi_errno);
157         }
158         MPID_END_ERROR_CHECKS;
159     }
160 #endif /* HAVE_ERROR_CHECKING */
161 
162     /* If this is a null request handle, then return an empty status */
163     if (*request == MPI_REQUEST_NULL) {
164         MPIR_Status_set_empty(status);
165         goto fn_exit;
166     }
167 
168     /* Convert MPI request handle to a request object pointer */
169     MPIR_Request_get_ptr(*request, request_ptr);
170 
171     /* Validate object pointers if error checking is enabled */
172 #ifdef HAVE_ERROR_CHECKING
173     {
174         MPID_BEGIN_ERROR_CHECKS;
175         {
176             MPIR_Request_valid_ptr(request_ptr, mpi_errno);
177             if (mpi_errno)
178                 goto fn_fail;
179         }
180         MPID_END_ERROR_CHECKS;
181     }
182 #endif /* HAVE_ERROR_CHECKING */
183 
184     /* ... body of routine ... */
185 
186     /* save copy of comm because request will be freed */
187     if (request_ptr)
188         comm_ptr = request_ptr->comm;
189     mpi_errno = MPIR_Wait(request, status);
190     if (mpi_errno)
191         goto fn_fail;
192 
193     /* ... end of body of routine ... */
194 
195   fn_exit:
196     MPIR_FUNC_TERSE_REQUEST_EXIT(MPID_STATE_MPI_WAIT);
197     MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
198     return mpi_errno;
199 
200   fn_fail:
201     /* --BEGIN ERROR HANDLING-- */
202 #ifdef HAVE_ERROR_CHECKING
203     mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE,
204                                      __func__, __LINE__, MPI_ERR_OTHER,
205                                      "**mpi_wait", "**mpi_wait %p %p", request, status);
206 #endif
207     mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno);
208     goto fn_exit;
209     /* --END ERROR HANDLING-- */
210 }
211