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

#include "mpiimpl.h"

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
/*
=== BEGIN_MPI_T_CVAR_INFO_BLOCK ===

cvars:
    - name        : MPIR_CVAR_ENABLE_SMP_BARRIER
      category    : COLLECTIVE
      type        : boolean
      default     : true
      class       : device
      verbosity   : MPI_T_VERBOSITY_USER_BASIC
      scope       : MPI_T_SCOPE_ALL_EQ
      description : Enable SMP aware barrier.

=== END_MPI_T_CVAR_INFO_BLOCK ===
*/

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
/* -- Begin Profiling Symbol Block for routine MPI_Barrier */
#if defined(HAVE_PRAGMA_WEAK)
#pragma weak MPI_Barrier = PMPI_Barrier
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
#pragma _HP_SECONDARY_DEF PMPI_Barrier  MPI_Barrier
#elif defined(HAVE_PRAGMA_CRI_DUP)
#pragma _CRI duplicate MPI_Barrier as PMPI_Barrier
#endif
/* -- End Profiling Symbol Block */

/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
   the MPI routines */
#ifndef MPICH_MPI_FROM_PMPI
#undef MPI_Barrier
#define MPI_Barrier PMPI_Barrier


/* This is the default implementation of the barrier operation.  The
   algorithm is:
   
   Algorithm: MPI_Barrier

   We use the dissemination algorithm described in:
   Debra Hensgen, Raphael Finkel, and Udi Manbet, "Two Algorithms for
   Barrier Synchronization," International Journal of Parallel
   Programming, 17(1):1-17, 1988.  

   It uses ceiling(lgp) steps. In step k, 0 <= k <= (ceiling(lgp)-1),
   process i sends to process (i + 2^k) % p and receives from process 
   (i - 2^k + p) % p.

   Possible improvements: 

   End Algorithm: MPI_Barrier

   This is an intracommunicator barrier only!
*/

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
#undef FUNCNAME
#define FUNCNAME barrier_smp_intra
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
static int barrier_smp_intra(MPID_Comm *comm_ptr, int *errflag)
{
    int mpi_errno=MPI_SUCCESS;
    int mpi_errno_ret = MPI_SUCCESS;

    MPIU_Assert(MPIR_CVAR_ENABLE_SMP_COLLECTIVES && MPIR_CVAR_ENABLE_SMP_BARRIER &&
                MPIR_Comm_is_node_aware(comm_ptr));

    /* do the intranode barrier on all nodes */
    if (comm_ptr->node_comm != NULL)
    {
        mpi_errno = MPIR_Barrier_impl(comm_ptr->node_comm, errflag);
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            *errflag = TRUE;
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
    }

    /* do the barrier across roots of all nodes */
    if (comm_ptr->node_roots_comm != NULL) {
        mpi_errno = MPIR_Barrier_impl(comm_ptr->node_roots_comm, errflag);
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            *errflag = TRUE;
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
    }

    /* release the local processes on each node with a 1-byte
       broadcast (0-byte broadcast just returns without doing
       anything) */
    if (comm_ptr->node_comm != NULL)
    {
        int i=0;
        mpi_errno = MPIR_Bcast_impl(&i, 1, MPI_BYTE, 0, comm_ptr->node_comm, errflag);
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            *errflag = TRUE;
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
    }

 fn_exit:
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
    else if (*errflag)
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**coll_fail");
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

124
/* not declared static because it is called in ch3_comm_connect/accept */
125
#undef FUNCNAME
126
#define FUNCNAME MPIR_Barrier_intra
127
128
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
129
int MPIR_Barrier_intra( MPID_Comm *comm_ptr, int *errflag )
130
131
{
    int size, rank, src, dst, mask, mpi_errno=MPI_SUCCESS;
132
    int mpi_errno_ret = MPI_SUCCESS;
133
134
    MPI_Comm comm;

135
136
137
138
    /* Only one collective operation per communicator can be active at any
       time */
    MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );

139
140
    size = comm_ptr->local_size;
    /* Trivial barriers return immediately */
141
    if (size == 1) goto fn_exit;
142

143
144
145
146
147
148
149
150
151
152
153
154
    if (MPIR_CVAR_ENABLE_SMP_COLLECTIVES && MPIR_CVAR_ENABLE_SMP_BARRIER &&
        MPIR_Comm_is_node_aware(comm_ptr)) {
        mpi_errno = barrier_smp_intra(comm_ptr, errflag);
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            *errflag = TRUE;
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
        goto fn_exit;
    }

155
156
157
158
159
160
161
    rank = comm_ptr->rank;
    comm = comm_ptr->handle;

    mask = 0x1;
    while (mask < size) {
        dst = (rank + mask) % size;
        src = (rank - mask + size) % size;
162
        mpi_errno = MPIC_Sendrecv(NULL, 0, MPI_BYTE, dst,
163
164
                                     MPIR_BARRIER_TAG, NULL, 0, MPI_BYTE,
                                     src, MPIR_BARRIER_TAG, comm,
165
                                     MPI_STATUS_IGNORE, errflag);
166
167
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
168
            *errflag = TRUE;
169
170
171
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
172
173
174
        mask <<= 1;
    }

175
 fn_exit:
176
    MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
177
178
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
179
180
    else if (*errflag)
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**coll_fail");
181
    return mpi_errno;
182
183
 fn_fail:
    goto fn_exit;
184
185
186
187
}

/* not declared static because a machine-specific function may call this one 
   in some cases */
188
189
190
191
#undef FUNCNAME
#define FUNCNAME MPIR_Barrier_inter
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
192
int MPIR_Barrier_inter( MPID_Comm *comm_ptr, int *errflag )
193
{
194
    int rank, mpi_errno = MPI_SUCCESS, root;
195
    int mpi_errno_ret = MPI_SUCCESS;
196
    int i = 0;
197
    MPID_Comm *newcomm_ptr = NULL;
198
    
199
200
201
    rank = comm_ptr->rank;

    /* Get the local intracommunicator */
202
203
204
205
    if (!comm_ptr->local_comm) {
	mpi_errno = MPIR_Setup_intercomm_localcomm( comm_ptr );
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    }
206
207
208
209

    newcomm_ptr = comm_ptr->local_comm;

    /* do a barrier on the local intracommunicator */
210
    mpi_errno = MPIR_Barrier_intra(newcomm_ptr, errflag);
211
212
    if (mpi_errno) {
        /* for communication errors, just record the error but continue */
213
        *errflag = TRUE;
214
215
216
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
        MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
    }
217
218
219
220
221
222
223
224
225
226
227

    /* rank 0 on each group does an intercommunicator broadcast to the
       remote group to indicate that all processes in the local group
       have reached the barrier. We do a 1-byte bcast because a 0-byte
       bcast will just return without doing anything. */
    
    /* first broadcast from left to right group, then from right to
       left group */
    if (comm_ptr->is_low_group) {
        /* bcast to right*/
        root = (rank == 0) ? MPI_ROOT : MPI_PROC_NULL;
228
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag);
229
230
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
231
            *errflag = TRUE;
232
233
234
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
235

236
237
        /* receive bcast from right */
        root = 0;
238
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag);
239
240
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
241
            *errflag = TRUE;
242
243
244
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
245
246
247
248
    }
    else {
        /* receive bcast from left */
        root = 0;
249
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag);
250
251
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
252
            *errflag = TRUE;
253
254
255
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
256

257
258
        /* bcast to left */
        root = (rank == 0) ? MPI_ROOT : MPI_PROC_NULL;
259
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag);
260
261
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
262
            *errflag = TRUE;
263
264
265
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
266
267
    }
 fn_exit:
268
269
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
270
271
    else if (*errflag)
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**coll_fail");
272
273
274
275
276
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

277
278
/* MPIR_Barrier performs an barrier using poin        MPIU_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
t-to-point messages.
279
280
281
282
283
284
   This is intended to be used by device-specific implementations of
   barrier.  In all other cases MPIR_Barrier_impl should be used. */
#undef FUNCNAME
#define FUNCNAME MPIR_Barrier
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
285
int MPIR_Barrier(MPID_Comm *comm_ptr, int *errflag)
286
287
288
289
290
{
    int mpi_errno = MPI_SUCCESS;

    if (comm_ptr->comm_kind == MPID_INTRACOMM) {
        /* intracommunicator */
291
        mpi_errno = MPIR_Barrier_intra( comm_ptr, errflag );
292
293
294
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    } else {
        /* intercommunicator */
295
        mpi_errno = MPIR_Barrier_inter( comm_ptr, errflag );
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    }

 fn_exit:
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}


/* MPIR_Barrier_impl should be called by any internal component that
   would otherwise call MPI_Barrier.  This differs from MPIR_Barrier
   in that this is SMP aware and will call the coll_fns version if it
   exists.  This is a replacement for NMPI_Barrier. */
#undef FUNCNAME
#define FUNCNAME MPIR_Barrier_impl
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
314
int MPIR_Barrier_impl(MPID_Comm *comm_ptr, int *errflag)
315
316
{
    int mpi_errno = MPI_SUCCESS;
317
    int mpi_errno_ret = MPI_SUCCESS;
318
319
    if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Barrier != NULL)
    {
320
	/* --BEGIN USEREXTENSION-- */
321
	mpi_errno = comm_ptr->coll_fns->Barrier(comm_ptr, errflag);
322
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
323
	/* --END USEREXTENSION-- */
324
    }
325
326
    else
    {
327
328
        mpi_errno = MPIR_Barrier(comm_ptr, errflag);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
329
330
331
    }
        
 fn_exit:
332
333
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
334
335
    else if (*errflag)
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**coll_fail");
336
    return mpi_errno;
337
338
 fn_fail:
    goto fn_exit;
339
340
341
342
}

#endif

343

344
345


346
347
#undef FUNCNAME
#define FUNCNAME MPI_Barrier
348
349
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
350
351
352
353
354
355

/*@

MPI_Barrier - Blocks until all processes in the communicator have
reached this routine.  

356
Input Parameters:
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
. comm - communicator (handle) 

Notes:
Blocks the caller until all processes in the communicator have called it; 
that is, the call returns at any process only after all members of the
communicator have entered the call.

.N ThreadSafe

.N Fortran

.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
@*/
int MPI_Barrier( MPI_Comm comm )
{
    int mpi_errno = MPI_SUCCESS;
    MPID_Comm *comm_ptr = NULL;
376
    int errflag = FALSE;
377
378
379
380
    MPID_MPI_STATE_DECL(MPID_STATE_MPI_BARRIER);

    MPIR_ERRTEST_INITIALIZED_ORDIE();
    
381
    MPIU_THREAD_CS_ENTER(ALLFUNC,);
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
    MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_BARRIER);
    
    /* Validate parameters, especially handles needing to be converted */
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
	    MPIR_ERRTEST_COMM(comm, mpi_errno);
	}
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */

    /* Convert MPI object handles to object pointers */
    MPID_Comm_get_ptr( comm, comm_ptr );
    
    /* Validate parameters and objects (post conversion) */
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
	    /* Validate communicator */
            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
            if (mpi_errno) goto fn_fail;
        }
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */

    /* ... body of routine ...  */

413
    mpi_errno = MPIR_Barrier_impl(comm_ptr, &errflag);
414
415
    if (mpi_errno) goto fn_fail;
    
416
417
418
419
    /* ... end of body of routine ... */

  fn_exit:
    MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BARRIER);
420
    MPIU_THREAD_CS_EXIT(ALLFUNC,);
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
    return mpi_errno;

  fn_fail:
    /* --BEGIN ERROR HANDLING-- */
#   ifdef HAVE_ERROR_CHECKING
    {
	mpi_errno = MPIR_Err_create_code(
	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, 
	    "**mpi_barrier", "**mpi_barrier %C", comm);
    }
#   endif
    mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
    goto fn_exit;
    /* --END ERROR HANDLING-- */
}