1 /* -*- Mode: C; c-basic-offset:4 ; -*- */
2 /*
3 *
4 * (C) 2001 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
6 */
7
8 #include "mpiimpl.h"
9
10 #if !defined(MPID_REQUEST_PTR_ARRAY_SIZE)
11 #define MPID_REQUEST_PTR_ARRAY_SIZE 16
12 #endif
13
14 /* -- Begin Profiling Symbol Block for routine MPI_Waitsome */
15 #if defined(HAVE_PRAGMA_WEAK)
16 #pragma weak MPI_Waitsome = PMPI_Waitsome
17 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
18 #pragma _HP_SECONDARY_DEF PMPI_Waitsome MPI_Waitsome
19 #elif defined(HAVE_PRAGMA_CRI_DUP)
20 #pragma _CRI duplicate MPI_Waitsome as PMPI_Waitsome
21 #endif
22 /* -- End Profiling Symbol Block */
23
24 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
25 the MPI routines */
26 #ifndef MPICH_MPI_FROM_PMPI
27 #undef MPI_Waitsome
28 #define MPI_Waitsome PMPI_Waitsome
29
30 #endif
31
32 #undef FUNCNAME
33 #define FUNCNAME MPI_Waitsome
34
35 /*@
36 MPI_Waitsome - Waits for some given MPI Requests to complete
37
38 Input Parameters:
39 + incount - length of array_of_requests (integer)
40 - array_of_requests - array of requests (array of handles)
41
42 Output Parameters:
43 + outcount - number of completed requests (integer)
44 . array_of_indices - array of indices of operations that
45 completed (array of integers)
46 - array_of_statuses - array of status objects for
47 operations that completed (array of Status). May be 'MPI_STATUSES_IGNORE'.
48
49 Notes:
50 The array of indicies are in the range '0' to 'incount - 1' for C and
51 in the range '1' to 'incount' for Fortran.
52
53 Null requests are ignored; if all requests are null, then the routine
54 returns with 'outcount' set to 'MPI_UNDEFINED'.
55
56 While it is possible to list a request handle more than once in the
57 array_of_requests, such an action is considered erroneous and may cause the
58 program to unexecpectedly terminate or produce incorrect results.
59
60 'MPI_Waitsome' provides an interface much like the Unix 'select' or 'poll'
61 calls and, in a high qualilty implementation, indicates all of the requests
62 that have completed when 'MPI_Waitsome' is called.
63 However, 'MPI_Waitsome' only guarantees that at least one
64 request has completed; there is no guarantee that `all` completed requests
65 will be returned, or that the entries in 'array_of_indices' will be in
66 increasing order. Also, requests that are completed while 'MPI_Waitsome' is
67 executing may or may not be returned, depending on the timing of the
68 completion of the message.
69
70 .N waitstatus
71
72 .N ThreadSafe
73
74 .N Fortran
75
76 .N Errors
77 .N MPI_SUCCESS
78 .N MPI_ERR_REQUEST
79 .N MPI_ERR_ARG
80 .N MPI_ERR_IN_STATUS
81 @*/
MPI_Waitsome(int incount,MPI_Request array_of_requests[],int * outcount,int array_of_indices[],MPI_Status array_of_statuses[])82 int MPI_Waitsome(int incount, MPI_Request array_of_requests[],
83 int *outcount, int array_of_indices[],
84 MPI_Status array_of_statuses[])
85 {
86 static const char FCNAME[] = "MPI_Waitsome";
87 MPID_Request * request_ptr_array[MPID_REQUEST_PTR_ARRAY_SIZE];
88 MPID_Request ** request_ptrs = request_ptr_array;
89 MPI_Status * status_ptr;
90 MPID_Progress_state progress_state;
91 int i;
92 int n_active;
93 int n_inactive;
94 int active_flag;
95 int rc;
96 int mpi_errno = MPI_SUCCESS;
97 MPIU_CHKLMEM_DECL(1);
98 MPID_MPI_STATE_DECL(MPID_STATE_MPI_WAITSOME);
99
100 MPIR_ERRTEST_INITIALIZED_ORDIE();
101
102 MPIU_THREAD_CS_ENTER(ALLFUNC,);
103 MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_WAITSOME);
104
105 /* Check the arguments */
106 # ifdef HAVE_ERROR_CHECKING
107 {
108 MPID_BEGIN_ERROR_CHECKS;
109 {
110 MPIR_ERRTEST_COUNT(incount, mpi_errno);
111
112 if (incount != 0) {
113 MPIR_ERRTEST_ARGNULL(array_of_requests, "array_of_requests", mpi_errno);
114 MPIR_ERRTEST_ARGNULL(array_of_indices, "array_of_indices", mpi_errno);
115 /* NOTE: MPI_STATUSES_IGNORE != NULL */
116 MPIR_ERRTEST_ARGNULL(array_of_statuses, "array_of_statuses", mpi_errno);
117 }
118 MPIR_ERRTEST_ARGNULL(outcount, "outcount", mpi_errno);
119
120 for (i = 0; i < incount; i++) {
121 MPIR_ERRTEST_ARRAYREQUEST_OR_NULL(array_of_requests[i], i, mpi_errno);
122 }
123 }
124 MPID_END_ERROR_CHECKS;
125 }
126 # endif /* HAVE_ERROR_CHECKING */
127
128 /* ... body of routine ... */
129
130 *outcount = 0;
131
132 /* Convert MPI request handles to a request object pointers */
133 if (incount > MPID_REQUEST_PTR_ARRAY_SIZE)
134 {
135 MPIU_CHKLMEM_MALLOC_ORJUMP(request_ptrs, MPID_Request **, incount * sizeof(MPID_Request *), mpi_errno, "request pointers");
136 }
137
138 n_inactive = 0;
139 for (i = 0; i < incount; i++)
140 {
141 if (array_of_requests[i] != MPI_REQUEST_NULL)
142 {
143 MPID_Request_get_ptr(array_of_requests[i], request_ptrs[i]);
144 /* Validate object pointers if error checking is enabled */
145 # ifdef HAVE_ERROR_CHECKING
146 {
147 MPID_BEGIN_ERROR_CHECKS;
148 {
149 MPID_Request_valid_ptr( request_ptrs[i], mpi_errno );
150 if (mpi_errno != MPI_SUCCESS)
151 {
152 goto fn_fail;
153 }
154
155 }
156 MPID_END_ERROR_CHECKS;
157 }
158 # endif
159 }
160 else
161 {
162 n_inactive += 1;
163 request_ptrs[i] = NULL;
164 }
165 }
166
167 if (n_inactive == incount)
168 {
169 *outcount = MPI_UNDEFINED;
170 goto fn_exit;
171 }
172
173 /* Bill Gropp says MPI_Waitsome() is expected to try to make
174 progress even if some requests have already completed;
175 therefore, we kick the pipes once and then fall into a loop
176 checking for completion and waiting for progress. */
177 mpi_errno = MPID_Progress_test();
178 if (mpi_errno != MPI_SUCCESS)
179 {
180 /* --BEGIN ERROR HANDLING-- */
181 goto fn_fail;
182 /* --END ERROR HANDLING-- */
183 }
184
185 n_active = 0;
186 MPID_Progress_start(&progress_state);
187 for(;;)
188 {
189 mpi_errno = MPIR_Grequest_progress_poke(incount,
190 request_ptrs, array_of_statuses);
191 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
192 for (i = 0; i < incount; i++)
193 {
194 if (request_ptrs[i] != NULL && MPID_Request_is_complete(request_ptrs[i]))
195 {
196 status_ptr = (array_of_statuses != MPI_STATUSES_IGNORE) ? &array_of_statuses[n_active] : MPI_STATUS_IGNORE;
197 rc = MPIR_Request_complete(&array_of_requests[i], request_ptrs[i], status_ptr, &active_flag);
198 if (active_flag)
199 {
200 array_of_indices[n_active] = i;
201 n_active += 1;
202
203 if (rc == MPI_SUCCESS)
204 {
205 request_ptrs[i] = NULL;
206 }
207 else
208 {
209 mpi_errno = MPI_ERR_IN_STATUS;
210 if (status_ptr != MPI_STATUS_IGNORE)
211 {
212 status_ptr->MPI_ERROR = rc;
213 }
214 }
215 }
216 else
217 {
218 request_ptrs[i] = NULL;
219 n_inactive += 1;
220 }
221 }
222 }
223
224 if (mpi_errno == MPI_ERR_IN_STATUS)
225 {
226 if (array_of_statuses != MPI_STATUSES_IGNORE)
227 {
228 for (i = 0; i < n_active; i++)
229 {
230 if (request_ptrs[array_of_indices[i]] == NULL)
231 {
232 array_of_statuses[i].MPI_ERROR = MPI_SUCCESS;
233 }
234 }
235 }
236 *outcount = n_active;
237 break;
238 }
239 else if (n_active > 0)
240 {
241 *outcount = n_active;
242 break;
243 }
244 else if (n_inactive == incount)
245 {
246 *outcount = MPI_UNDEFINED;
247 break;
248 }
249
250 mpi_errno = MPID_Progress_wait(&progress_state);
251 if (mpi_errno != MPI_SUCCESS)
252 {
253 /* --BEGIN ERROR HANDLING-- */
254 MPID_Progress_end(&progress_state);
255 goto fn_fail;
256 /* --END ERROR HANDLING-- */
257 }
258 }
259 MPID_Progress_end(&progress_state);
260
261 /* ... end of body of routine ... */
262
263 fn_exit:
264 if (incount > MPID_REQUEST_PTR_ARRAY_SIZE)
265 {
266 MPIU_CHKLMEM_FREEALL();
267 }
268
269 MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_WAITSOME);
270 MPIU_THREAD_CS_EXIT(ALLFUNC,);
271 return mpi_errno;
272
273 fn_fail:
274 /* --BEGIN ERROR HANDLING-- */
275 #ifdef HAVE_ERROR_CHECKING
276 mpi_errno = MPIR_Err_create_code(
277 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
278 "**mpi_waitsome", "**mpi_waitsome %d %p %p %p %p",
279 incount, array_of_requests, outcount, array_of_indices,
280 array_of_statuses);
281 #endif
282 mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
283 goto fn_exit;
284 /* --END ERROR HANDLING-- */
285 }
286