helper_fns.c 24.3 KB
Newer Older
1
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
2
3
4
5
6
7
8
9
10
/*
 *
 *  (C) 2001 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

#include "mpiimpl.h"
#include "datatype.h"

11
12
#define COPY_BUFFER_SZ 16384

13
14
15
16
17
/* These functions are used in the implementation of collective
   operations. They are wrappers around MPID send/recv functions. They do
   sends/receives by setting the context offset to
   MPID_CONTEXT_INTRA_COLL or MPID_CONTEXT_INTER_COLL. */

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#undef FUNCNAME
#define FUNCNAME MPIC_Probe
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
int MPIC_Probe(int source, int tag, MPI_Comm comm, MPI_Status *status)
{
    int mpi_errno = MPI_SUCCESS;
    int context_id;
    MPID_Comm *comm_ptr;

    MPID_Comm_get_ptr( comm, comm_ptr );

    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;
    
    mpi_errno = MPID_Probe(source, tag, comm_ptr, context_id, status);
    if (mpi_errno != MPI_SUCCESS) goto fn_fail;

 fn_exit:
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}


43
44
45
46
#undef FUNCNAME
#define FUNCNAME MPIR_Localcopy
#undef FCNAME
#define FCNAME "MPIR_Localcopy"
47
int MPIR_Localcopy(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
48
49
                   void *recvbuf, int recvcount, MPI_Datatype recvtype)
{
50
51
52
    int mpi_errno = MPI_SUCCESS;
    int sendtype_iscontig, recvtype_iscontig;
    MPI_Aint sendsize, recvsize, sdata_sz, rdata_sz, copy_sz;
53
    MPI_Aint true_extent, sendtype_true_lb, recvtype_true_lb;
54
    MPIU_CHKLMEM_DECL(1);
55
    MPID_MPI_STATE_DECL(MPID_STATE_MPIR_LOCALCOPY);
56

57
58
    MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_LOCALCOPY);

59
60
    MPID_Datatype_get_size_macro(sendtype, sendsize);
    MPID_Datatype_get_size_macro(recvtype, recvsize);
61

62
63
    sdata_sz = sendsize * sendcount;
    rdata_sz = recvsize * recvcount;
64

65
    /* if there is no data to copy, bail out */
66
67
    if (!sdata_sz || !rdata_sz)
        goto fn_exit;
68
69
70

#if defined(HAVE_ERROR_CHECKING)
    if (sdata_sz > rdata_sz) {
71
72
73
74
        MPIU_ERR_SET2(mpi_errno, MPI_ERR_TRUNCATE, "**truncate", "**truncate %d %d", sdata_sz, rdata_sz);
        copy_sz = rdata_sz;
    }
    else
75
#endif /* HAVE_ERROR_CHECKING */
76
        copy_sz = sdata_sz;
77

78
79
80
    /* Builtin types is the common case; optimize for it */
    if ((HANDLE_GET_KIND(sendtype) == HANDLE_KIND_BUILTIN) &&
        HANDLE_GET_KIND(recvtype) == HANDLE_KIND_BUILTIN) {
81
82
        MPIU_Memcpy(recvbuf, sendbuf, copy_sz);
        goto fn_exit;
83
    }
84

85
86
87
    MPIR_Datatype_iscontig(sendtype, &sendtype_iscontig);
    MPIR_Datatype_iscontig(recvtype, &recvtype_iscontig);

88
89
    MPIR_Type_get_true_extent_impl(sendtype, &sendtype_true_lb, &true_extent);
    MPIR_Type_get_true_extent_impl(recvtype, &recvtype_true_lb, &true_extent);
90
91

    if (sendtype_iscontig && recvtype_iscontig)
92
93
94
95
96
97
98
99
100
    {
#if defined(HAVE_ERROR_CHECKING)
        MPIU_ERR_CHKMEMCPYANDJUMP(mpi_errno,
                                  ((char *)recvbuf + recvtype_true_lb),
                                  ((char *)sendbuf + sendtype_true_lb),
                                  copy_sz);
#endif
        MPIU_Memcpy(((char *) recvbuf + recvtype_true_lb),
               ((char *) sendbuf + sendtype_true_lb),
101
               copy_sz);
102
    }
103
104
105
    else if (sendtype_iscontig)
    {
        MPID_Segment seg;
106
	MPI_Aint last;
107
108
109
110

	MPID_Segment_init(recvbuf, recvcount, recvtype, &seg, 0);
	last = copy_sz;
	MPID_Segment_unpack(&seg, 0, &last, (char*)sendbuf + sendtype_true_lb);
111
        MPIU_ERR_CHKANDJUMP(last != copy_sz, mpi_errno, MPI_ERR_TYPE, "**dtypemismatch");
112
113
114
115
    }
    else if (recvtype_iscontig)
    {
        MPID_Segment seg;
116
	MPI_Aint last;
117
118
119
120
121
122
123
124
125
126
127
128
129
130

	MPID_Segment_init(sendbuf, sendcount, sendtype, &seg, 0);
	last = copy_sz;
	MPID_Segment_pack(&seg, 0, &last, (char*)recvbuf + recvtype_true_lb);
        MPIU_ERR_CHKANDJUMP(last != copy_sz, mpi_errno, MPI_ERR_TYPE, "**dtypemismatch");
    }
    else
    {
	char * buf;
	MPIDI_msg_sz_t buf_off;
	MPID_Segment sseg;
	MPIDI_msg_sz_t sfirst;
	MPID_Segment rseg;
	MPIDI_msg_sz_t rfirst;
131
132

        MPIU_CHKLMEM_MALLOC(buf, char *, COPY_BUFFER_SZ, mpi_errno, "buf");
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

	MPID_Segment_init(sendbuf, sendcount, sendtype, &sseg, 0);
	MPID_Segment_init(recvbuf, recvcount, recvtype, &rseg, 0);

	sfirst = 0;
	rfirst = 0;
	buf_off = 0;
	
	while (1)
	{
	    MPI_Aint last;
	    char * buf_end;

	    if (copy_sz - sfirst > COPY_BUFFER_SZ - buf_off)
	    {
		last = sfirst + (COPY_BUFFER_SZ - buf_off);
	    }
	    else
	    {
		last = copy_sz;
	    }
	    
	    MPID_Segment_pack(&sseg, sfirst, &last, buf + buf_off);
	    MPIU_Assert(last > sfirst);
	    
	    buf_end = buf + buf_off + (last - sfirst);
	    sfirst = last;
	    
	    MPID_Segment_unpack(&rseg, rfirst, &last, buf);
	    MPIU_Assert(last > rfirst);

	    rfirst = last;

	    if (rfirst == copy_sz)
	    {
		/* successful completion */
		break;
	    }

            /* if the send side finished, but the recv side couldn't unpack it, there's a datatype mismatch */
            MPIU_ERR_CHKANDJUMP(sfirst == copy_sz, mpi_errno, MPI_ERR_TYPE, "**dtypemismatch");        

            /* if not all data was unpacked, copy it to the front of the buffer for next time */
	    buf_off = sfirst - rfirst;
	    if (buf_off > 0)
	    {
		memmove(buf, buf_end - buf_off, buf_off);
	    }
	}
182
183
    }
    
184
    
185
  fn_exit:
186
    MPIU_CHKLMEM_FREEALL();
187
    MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_LOCALCOPY);
188
189
190
191
192
193
194
    return mpi_errno;

  fn_fail:
    goto fn_exit;
}


195
196
197
198
/* FIXME: For the brief-global and finer-grain control, we must ensure that
   the global lock is *not* held when this routine is called. (unless we change
   progress_start/end to grab the lock, in which case we must *still* make
   sure that the lock is not held when this routine is called). */
199
200
201
202
203
204
#undef FUNCNAME
#define FUNCNAME MPIC_Wait
#undef FCNAME
#define FCNAME "MPIC_Wait"
int MPIC_Wait(MPID_Request * request_ptr)
{
Rajeev Thakur's avatar
Rajeev Thakur committed
205
    int mpi_errno = MPI_SUCCESS;
206
207
208
    MPIDI_STATE_DECL(MPID_STATE_MPIC_WAIT);

    MPIDI_PT2PT_FUNC_ENTER(MPID_STATE_MPIC_WAIT);
209
    if (!MPID_Request_is_complete(request_ptr))
210
211
212
213
    {
	MPID_Progress_state progress_state;
	
	MPID_Progress_start(&progress_state);
214
        while (!MPID_Request_is_complete(request_ptr))
215
216
217
218
219
220
221
222
	{
	    mpi_errno = MPID_Progress_wait(&progress_state);
	    if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
	}
	MPID_Progress_end(&progress_state);
    }

 fn_fail:
223
    /* --BEGIN ERROR HANDLING-- */
224
    MPIDI_PT2PT_FUNC_EXIT(MPID_STATE_MPIC_WAIT);
225
    return mpi_errno;
226
    /* --END ERROR HANDLING-- */
227
}
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250


/* Fault-tolerance versions.  When a process fails, collectives will
   still complete, however the result may be invalid.  Processes
   directly communicating with the failed process can detect the
   failure, however another mechanism is needed to commuinicate the
   failure to other processes receiving the invalid data.  To do this
   we introduce the _ft versions of the MPIC_ helper functions.  These
   functions take a pointer to an error flag.  When this is set to
   TRUE, the send functions will communicate the failure to the
   receiver.  If a function detects a failure, either by getting a
   failure in the communication operation, or by receiving an error
   indicator from a remote process, it sets the error flag to TRUE.

   In this implementation, we indicate an error to a remote process by
   sending an empty message instead of the requested buffer.  When a
   process receives an empty message, it knows to set the error flag.
   We count on the fact that collectives that exchange data (as
   opposed to barrier) will never send an empty message.  The barrier
   collective will not communicate failure information this way, but
   this is OK since there is no data that can be received corrupted. */

#undef FUNCNAME
251
#define FUNCNAME MPIC_Send
252
253
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
254
int MPIC_Send(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
Wesley Bland's avatar
Wesley Bland committed
255
                 MPI_Comm comm, mpir_errflag_t *errflag)
256
257
{
    int mpi_errno = MPI_SUCCESS;
258
259
260
    int context_id;
    MPID_Request *request_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
261
    MPIDI_STATE_DECL(MPID_STATE_MPIC_SEND);
262

Wesley Bland's avatar
Wesley Bland committed
263
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_SEND);
264

Wesley Bland's avatar
Wesley Bland committed
265
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "IN: errflag = %d", *errflag);
266

267
268
269
    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", count);

Wesley Bland's avatar
Wesley Bland committed
270
271
272
273
274
    switch(*errflag) {
        case MPIR_ERR_NONE:
            break;
        case MPIR_ERR_PROC_FAILED:
            MPIR_TAG_SET_PROC_FAILURE_BIT(tag);
275
        default:
Wesley Bland's avatar
Wesley Bland committed
276
277
            MPIR_TAG_SET_ERROR_BIT(tag);
    }
278

279
280
281
282
283
284
285
286
287
288
289
290
    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

    mpi_errno = MPID_Send(buf, count, datatype, dest, tag, comm_ptr,
                          context_id, &request_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    if (request_ptr) {
        mpi_errno = MPIC_Wait(request_ptr);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
        MPID_Request_release(request_ptr);
    }
291

292
 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
293
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_SEND);
294
    return mpi_errno;
295
 fn_fail:
296
297
    /* --BEGIN ERROR HANDLING-- */
    if (request_ptr) MPID_Request_release(request_ptr);
298
    goto fn_exit;
299
    /* --END ERROR HANDLING-- */
300
301
302
}

#undef FUNCNAME
303
#define FUNCNAME MPIC_Recv
304
305
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
306
int MPIC_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag,
Wesley Bland's avatar
Wesley Bland committed
307
                 MPI_Comm comm, MPI_Status *status, mpir_errflag_t *errflag)
308
309
{
    int mpi_errno = MPI_SUCCESS;
310
    int context_id;
311
    MPI_Status mystatus;
312
313
    MPID_Request *request_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
314
    MPIDI_STATE_DECL(MPID_STATE_MPIC_RECV);
315

Wesley Bland's avatar
Wesley Bland committed
316
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_RECV);
317

Wesley Bland's avatar
Wesley Bland committed
318
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "IN: errflag = %d", *errflag);
319

320
321
    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", count);
322

323
324
325
    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;
326

327
328
    if (status == MPI_STATUS_IGNORE)
        status = &mystatus;
329

330
331
    mpi_errno = MPID_Recv(buf, count, datatype, source, tag, comm_ptr,
                          context_id, status, &request_ptr);
332
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
333
334
    if (request_ptr) {
        mpi_errno = MPIC_Wait(request_ptr);
335
        if (mpi_errno != MPI_SUCCESS)
336
            MPIU_ERR_POP(mpi_errno);
337
338
339

        *status = request_ptr->status;
        mpi_errno = status->MPI_ERROR;
340
341
        MPID_Request_release(request_ptr);
    }
342
343

    if (source != MPI_PROC_NULL) {
344
345
        if (MPIX_ERR_REVOKED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
            MPIX_ERR_PROC_FAILED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
346
            MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
Wesley Bland's avatar
Wesley Bland committed
347
348
349
350
351
352
353
            if (MPIR_TAG_CHECK_PROC_FAILURE_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_PROC_FAILED;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            } else if (MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_OTHER;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            }
354
        } else if (MPI_SUCCESS == MPIR_ERR_GET_CLASS(status->MPI_ERROR)) {
355
356
357
358
359
            MPIU_Assert(status->MPI_TAG == tag);
        }
    }

 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
360
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "OUT: errflag = %d", *errflag);
Wesley Bland's avatar
Wesley Bland committed
361
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_RECV);
362
363
    return mpi_errno;
 fn_fail:
364
365
    /* --BEGIN ERROR HANDLING-- */
    if (request_ptr) MPID_Request_release(request_ptr);
366
    goto fn_exit;
367
    /* --END ERROR HANDLING-- */
368
369
370
}

#undef FUNCNAME
371
#define FUNCNAME MPIC_Ssend
372
373
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
374
int MPIC_Ssend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
Wesley Bland's avatar
Wesley Bland committed
375
                  MPI_Comm comm, mpir_errflag_t *errflag)
376
377
{
    int mpi_errno = MPI_SUCCESS;
378
379
380
    int context_id;
    MPID_Request *request_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
381
    MPIDI_STATE_DECL(MPID_STATE_MPIC_SSEND);
382

Wesley Bland's avatar
Wesley Bland committed
383
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_SSEND);
384

Wesley Bland's avatar
Wesley Bland committed
385
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "IN: errflag = %d", *errflag);
386
387
388
389
390
391
392
393

    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
            "**countneg", "**countneg %d", count);

    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

394
395
396
397
398
399
400
401
    switch(*errflag) {
        case MPIR_ERR_NONE:
            break;
        case MPIR_ERR_PROC_FAILED:
            MPIR_TAG_SET_PROC_FAILURE_BIT(tag);
        default:
            MPIR_TAG_SET_ERROR_BIT(tag);
    }
402

403
404
405
406
407
408
409
410
    mpi_errno = MPID_Ssend(buf, count, datatype, dest, tag, comm_ptr,
                           context_id, &request_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    if (request_ptr) {
        mpi_errno = MPIC_Wait(request_ptr);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
        MPID_Request_release(request_ptr);
    }
411

412
 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
413
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_SSEND);
414
    return mpi_errno;
415
 fn_fail:
416
417
    /* --BEGIN ERROR HANDLING-- */
    if (request_ptr) MPID_Request_release(request_ptr);
418
    goto fn_exit;
419
    /* --END ERROR HANDLING-- */
420
421
422
}

#undef FUNCNAME
423
#define FUNCNAME MPIC_Sendrecv
424
425
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
426
int MPIC_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
427
428
                     int dest, int sendtag, void *recvbuf, int recvcount,
                     MPI_Datatype recvtype, int source, int recvtag,
Wesley Bland's avatar
Wesley Bland committed
429
                     MPI_Comm comm, MPI_Status *status, mpir_errflag_t *errflag)
430
431
{
    int mpi_errno = MPI_SUCCESS;
432
    int context_id;
433
    MPI_Status mystatus;
434
435
    MPID_Request *recv_req_ptr = NULL, *send_req_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
436
    MPIDI_STATE_DECL(MPID_STATE_MPIC_SENDRECV);
437

Wesley Bland's avatar
Wesley Bland committed
438
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_SENDRECV);
439
440
441

    MPIU_DBG_MSG_S(PT2PT, TYPICAL, "IN: errflag = %s", *errflag?"TRUE":"FALSE");

442
443
444
445
446
447
448
449
450
    MPIU_ERR_CHKANDJUMP1((sendcount < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", sendcount);
    MPIU_ERR_CHKANDJUMP1((recvcount < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", recvcount);

    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

451
    if (status == MPI_STATUS_IGNORE) status = &mystatus;
Wesley Bland's avatar
Wesley Bland committed
452
453
454
455
456
    switch(*errflag) {
        case MPIR_ERR_NONE:
            break;
        case MPIR_ERR_PROC_FAILED:
            MPIR_TAG_SET_PROC_FAILURE_BIT(sendtag);
457
        default:
Wesley Bland's avatar
Wesley Bland committed
458
459
            MPIR_TAG_SET_ERROR_BIT(sendtag);
    }
460

461
462
    mpi_errno = MPID_Irecv(recvbuf, recvcount, recvtype, source, recvtag,
                           comm_ptr, context_id, &recv_req_ptr);
463
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
    mpi_errno = MPID_Isend(sendbuf, sendcount, sendtype, dest, recvtag,
                           comm_ptr, context_id, &send_req_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);

    mpi_errno = MPIC_Wait(send_req_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    mpi_errno = MPIC_Wait(recv_req_ptr);
    if (mpi_errno) MPIU_ERR_POPFATAL(mpi_errno);

    *status = recv_req_ptr->status;
    mpi_errno = recv_req_ptr->status.MPI_ERROR;

    MPID_Request_release(send_req_ptr);
    MPID_Request_release(recv_req_ptr);

479
    if (source != MPI_PROC_NULL) {
480
481
482
        if (MPIX_ERR_REVOKED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
            MPIX_ERR_PROC_FAILED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
            MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
Wesley Bland's avatar
Wesley Bland committed
483
484
485
486
487
488
489
            if (MPIR_TAG_CHECK_PROC_FAILURE_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_PROC_FAILED;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            } else if (MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_OTHER;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            }
490
        } else if (MPI_SUCCESS == MPIR_ERR_GET_CLASS(status->MPI_ERROR)) {
491
492
493
            MPIU_Assert(status->MPI_TAG == recvtag);
        }
    }
494

Wesley Bland's avatar
Wesley Bland committed
495

496
 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
497
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "OUT: errflag = %d", *errflag);
498

Wesley Bland's avatar
Wesley Bland committed
499
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_SENDRECV);
500
501
502
503
504
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

505
506
507
/* NOTE: for regular collectives (as opposed to irregular collectives) calling
 * this function repeatedly will almost always be slower than performing the
 * equivalent inline because of the overhead of the repeated malloc/free */
508
#undef FUNCNAME
509
#define FUNCNAME MPIC_Sendrecv_replace
510
511
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
512
int MPIC_Sendrecv_replace(void *buf, int count, MPI_Datatype datatype,
513
514
                             int dest, int sendtag,
                             int source, int recvtag,
Wesley Bland's avatar
Wesley Bland committed
515
                             MPI_Comm comm, MPI_Status *status, mpir_errflag_t *errflag)
516
517
518
{
    int mpi_errno = MPI_SUCCESS;
    MPI_Status mystatus;
519
520
521
522
    MPIR_Context_id_t context_id_offset;
    MPID_Request *sreq;
    MPID_Request *rreq;
    void *tmpbuf = NULL;
523
524
    MPI_Aint tmpbuf_size = 0;
    MPI_Aint tmpbuf_count = 0;
525
526
    MPID_Comm *comm_ptr;
    MPIU_CHKLMEM_DECL(1);
Wesley Bland's avatar
Wesley Bland committed
527
    MPIDI_STATE_DECL(MPID_STATE_MPIC_SENDRECV_REPLACE);
528
529
530
531
#ifdef MPID_LOG_ARROWS
    /* The logging macros log sendcount and recvcount */
    int sendcount = count, recvcount = count;
#endif
532

Wesley Bland's avatar
Wesley Bland committed
533
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_SENDRECV_REPLACE);
534

Wesley Bland's avatar
Wesley Bland committed
535
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "IN: errflag = %d", *errflag);
536

537
538
539
    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", count);

540
    if (status == MPI_STATUS_IGNORE) status = &mystatus;
Wesley Bland's avatar
Wesley Bland committed
541
542
543
544
545
    switch(*errflag) {
        case MPIR_ERR_NONE:
            break;
        case MPIR_ERR_PROC_FAILED:
            MPIR_TAG_SET_PROC_FAILURE_BIT(sendtag);
546
        default:
Wesley Bland's avatar
Wesley Bland committed
547
548
            MPIR_TAG_SET_ERROR_BIT(sendtag);
    }
549

550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id_offset = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

    if (count > 0 && dest != MPI_PROC_NULL) {
        MPIR_Pack_size_impl(count, datatype, &tmpbuf_size);
        MPIU_CHKLMEM_MALLOC(tmpbuf, void *, tmpbuf_size, mpi_errno, "temporary send buffer");

        mpi_errno = MPIR_Pack_impl(buf, count, datatype, tmpbuf, tmpbuf_size, &tmpbuf_count);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    }

    mpi_errno = MPID_Irecv(buf, count, datatype, source, recvtag,
                           comm_ptr, context_id_offset, &rreq);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);

    mpi_errno = MPID_Isend(tmpbuf, tmpbuf_count, MPI_PACKED, dest,
                           sendtag, comm_ptr, context_id_offset, &sreq);
    if (mpi_errno != MPI_SUCCESS) {
        /* --BEGIN ERROR HANDLING-- */
        /* FIXME: should we cancel the pending (possibly completed) receive
         * request or wait for it to complete? */
        MPID_Request_release(rreq);
        MPIU_ERR_POP(mpi_errno);
        /* --END ERROR HANDLING-- */
    }

    if (!MPID_Request_is_complete(sreq) || !MPID_Request_is_complete(rreq)) {
        MPID_Progress_state progress_state;

        MPID_Progress_start(&progress_state);
        while (!MPID_Request_is_complete(sreq) || !MPID_Request_is_complete(rreq)) {
            mpi_errno = MPID_Progress_wait(&progress_state);
            if (mpi_errno != MPI_SUCCESS) {
                /* --BEGIN ERROR HANDLING-- */
                MPID_Progress_end(&progress_state);
                MPIU_ERR_POP(mpi_errno);
                /* --END ERROR HANDLING-- */
            }
        }
        MPID_Progress_end(&progress_state);
    }

    *status = rreq->status;

    if (mpi_errno == MPI_SUCCESS) {
        mpi_errno = rreq->status.MPI_ERROR;

        if (mpi_errno == MPI_SUCCESS) {
            mpi_errno = sreq->status.MPI_ERROR;
        }
    }

    MPID_Request_release(sreq);
    MPID_Request_release(rreq);

606
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);
607

608
    if (source != MPI_PROC_NULL) {
609
610
611
        if (MPIX_ERR_REVOKED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
            MPIX_ERR_PROC_FAILED == MPIR_ERR_GET_CLASS(status->MPI_ERROR) ||
            MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
Wesley Bland's avatar
Wesley Bland committed
612
613
614
615
616
617
618
            if (MPIR_TAG_CHECK_PROC_FAILURE_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_PROC_FAILED;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            } else if (MPIR_TAG_CHECK_ERROR_BIT(status->MPI_TAG)) {
                *errflag = MPIR_ERR_OTHER;
                MPIR_TAG_CLEAR_ERROR_BITS(status->MPI_TAG);
            }
619
        } else if (MPI_SUCCESS == MPIR_ERR_GET_CLASS(status->MPI_ERROR)) {
620
621
622
623
            MPIU_Assert(status->MPI_TAG == recvtag);
        }
    }

Wesley Bland's avatar
Wesley Bland committed
624

625
 fn_exit:
626
    MPIU_CHKLMEM_FREEALL();
Wesley Bland's avatar
Wesley Bland committed
627
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "OUT: errflag = %d", *errflag);
Wesley Bland's avatar
Wesley Bland committed
628
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_SENDRECV_REPLACE);
629
630
631
632
633
634
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

#undef FUNCNAME
635
#define FUNCNAME MPIC_Isend
636
637
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
638
int MPIC_Isend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
Wesley Bland's avatar
Wesley Bland committed
639
                  MPI_Comm comm, MPI_Request *request, mpir_errflag_t *errflag)
640
641
{
    int mpi_errno = MPI_SUCCESS;
642
643
644
    int context_id;
    MPID_Request *request_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
645
    MPIDI_STATE_DECL(MPID_STATE_MPIC_ISEND);
646

Wesley Bland's avatar
Wesley Bland committed
647
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_ISEND);
648

Wesley Bland's avatar
Wesley Bland committed
649
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "IN: errflag = %d", *errflag);
650

651
652
653
    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", count);

Wesley Bland's avatar
Wesley Bland committed
654
655
656
657
658
    switch(*errflag) {
        case MPIR_ERR_NONE:
            break;
        case MPIR_ERR_PROC_FAILED:
            MPIR_TAG_SET_PROC_FAILURE_BIT(tag);
659
        default:
Wesley Bland's avatar
Wesley Bland committed
660
661
            MPIR_TAG_SET_ERROR_BIT(tag);
    }
662

663
664
665
666
667
668
669
670
671
    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

    mpi_errno = MPID_Isend(buf, count, datatype, dest, tag, comm_ptr,
            context_id, &request_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);

    *request = request_ptr->handle;
672

673
 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
674
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_ISEND);
675
    return mpi_errno;
676
677
 fn_fail:
    goto fn_exit;
678
679
680
}

#undef FUNCNAME
681
#define FUNCNAME MPIC_Irecv
682
683
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
684
int MPIC_Irecv(void *buf, int count, MPI_Datatype datatype, int source,
685
686
687
                  int tag, MPI_Comm comm, MPI_Request *request)
{
    int mpi_errno = MPI_SUCCESS;
688
689
690
    int context_id;
    MPID_Request *request_ptr = NULL;
    MPID_Comm *comm_ptr = NULL;
Wesley Bland's avatar
Wesley Bland committed
691
    MPIDI_STATE_DECL(MPID_STATE_MPIC_IRECV);
692

Wesley Bland's avatar
Wesley Bland committed
693
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_IRECV);
694

695
696
697
698
699
700
701
702
703
704
705
706
    MPIU_ERR_CHKANDJUMP1((count < 0), mpi_errno, MPI_ERR_COUNT,
                         "**countneg", "**countneg %d", count);

    MPID_Comm_get_ptr(comm, comm_ptr);
    context_id = (comm_ptr->comm_kind == MPID_INTRACOMM) ?
        MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL;

    mpi_errno = MPID_Irecv(buf, count, datatype, source, tag, comm_ptr,
            context_id, &request_ptr);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);

    *request = request_ptr->handle;
707

708
 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
709
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_IRECV);
710
    return mpi_errno;
711
712
 fn_fail:
    goto fn_exit;
713
714
715
716
}


#undef FUNCNAME
717
#define FUNCNAME MPIC_Waitall
718
719
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
Wesley Bland's avatar
Wesley Bland committed
720
int MPIC_Waitall(int numreq, MPI_Request requests[], MPI_Status statuses[], mpir_errflag_t *errflag)
721
722
723
{
    int mpi_errno = MPI_SUCCESS;
    int i;
Wesley Bland's avatar
Wesley Bland committed
724
    MPIDI_STATE_DECL(MPID_STATE_MPIC_WAITALL);
725

Wesley Bland's avatar
Wesley Bland committed
726
    MPIDI_FUNC_ENTER(MPID_STATE_MPIC_WAITALL);
727
728
729
730
731

    MPIU_Assert(statuses != MPI_STATUSES_IGNORE);

    MPIU_DBG_MSG_S(PT2PT, TYPICAL, "IN: errflag = %s", *errflag?"TRUE":"FALSE");

732
733
734
    /* The MPI_TAG field is not set for send operations, so if we want
       to check for the error bit in the tag below, we should initialize all
       tag fields here. */
735
736
737
    for (i = 0; i < numreq; ++i)
        statuses[i].MPI_TAG = 0;
    
738
739
740
    mpi_errno = MPIR_Waitall_impl(numreq, requests, statuses);
    if (mpi_errno) MPIU_ERR_POP(mpi_errno);

741
    if (*errflag) goto fn_exit;
742
743

    for (i = 0; i < numreq; ++i) {
Wesley Bland's avatar
Wesley Bland committed
744
745
746
747
748
749
        if (MPIR_TAG_CHECK_PROC_FAILURE_BIT(statuses[i].MPI_TAG)) {
            *errflag = MPIR_ERR_PROC_FAILED;
            MPIR_TAG_CLEAR_ERROR_BITS(statuses[i].MPI_TAG);
            break;
        } else if (MPIR_TAG_CHECK_ERROR_BIT(statuses[i].MPI_TAG)) {
            *errflag = MPIR_ERR_OTHER;
750
            MPIR_TAG_CLEAR_ERROR_BITS(statuses[i].MPI_TAG);
751
752
753
754
755
            break;
        }
    }

 fn_exit:
Wesley Bland's avatar
Wesley Bland committed
756
    MPIU_DBG_MSG_D(PT2PT, TYPICAL, "OUT: errflag = %d", *errflag);
Wesley Bland's avatar
Wesley Bland committed
757
    MPIDI_FUNC_EXIT(MPID_STATE_MPIC_WAITALL);
758
759
760
761
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}