barrier.c 12.5 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
 *
 *  (C) 2001 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

#include "mpiimpl.h"

/* -- 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 */

20
PMPI_LOCAL int MPIR_Barrier_or_coll_fn(MPID_Comm *comm_ptr );
21

22
23
24
25
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
/* 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!
*/

/* not declared static because it is called in ch3_comm_connect/accept */
51
#undef FUNCNAME
52
#define FUNCNAME MPIR_Barrier_intra
53
54
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
55
int MPIR_Barrier_intra( MPID_Comm *comm_ptr )
56
57
{
    int size, rank, src, dst, mask, mpi_errno=MPI_SUCCESS;
58
    int mpi_errno_ret = MPI_SUCCESS;
59
60
    MPI_Comm comm;

61
62
63
64
    /* Only one collective operation per communicator can be active at any
       time */
    MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );

65
66
    size = comm_ptr->local_size;
    /* Trivial barriers return immediately */
67
    if (size == 1) goto fn_exit;
68
69
70
71
72
73
74
75
76
77
78
79

    rank = comm_ptr->rank;
    comm = comm_ptr->handle;

    mask = 0x1;
    while (mask < size) {
        dst = (rank + mask) % size;
        src = (rank - mask + size) % size;
        mpi_errno = MPIC_Sendrecv(NULL, 0, MPI_BYTE, dst,
                                  MPIR_BARRIER_TAG, NULL, 0, MPI_BYTE,
                                  src, MPIR_BARRIER_TAG, comm,
                                  MPI_STATUS_IGNORE);
80
81
82
83
84
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
85
86
87
        mask <<= 1;
    }

88
 fn_exit:
89
    MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
90
91
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
92
    return mpi_errno;
93
94
 fn_fail:
    goto fn_exit;
95
96
}

97
/* A simple utility function to that calls the comm_ptr->coll_fns->Barrier
98
override if it exists or else it calls MPIR_Barrier_intra with the same arguments. */
99
100
/* Note that this function must *not* be inline - if weak symbols are not 
   available, this function must be a global symbol. */
101
102
103
104
#undef FUNCNAME
#define FUNCNAME MPIR_Barrier_or_coll_fn
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
105
PMPI_LOCAL int MPIR_Barrier_or_coll_fn(MPID_Comm *comm_ptr )
106
107
108
109
110
111
112
{
    int mpi_errno = MPI_SUCCESS;

    if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Barrier != NULL)
    {
        /* --BEGIN USEREXTENSION-- */
        mpi_errno = comm_ptr->node_roots_comm->coll_fns->Barrier(comm_ptr);
113
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
114
115
116
        /* --END USEREXTENSION-- */
    }
    else {
117
118
        mpi_errno = MPIR_Barrier_intra(comm_ptr);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
119
120
    }

121
 fn_exit:
122
    return mpi_errno;
123
124
 fn_fail:
    goto fn_exit;
125
126
127
}


128
129
/* not declared static because a machine-specific function may call this one 
   in some cases */
130
131
132
133
#undef FUNCNAME
#define FUNCNAME MPIR_Barrier_inter
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
134
135
int MPIR_Barrier_inter( MPID_Comm *comm_ptr )
{
136
    int rank, mpi_errno = MPI_SUCCESS, root;
137
    int mpi_errno_ret = MPI_SUCCESS;
138
    int i = 0;
139
140
141
142
143
    MPID_Comm *newcomm_ptr = NULL;

    rank = comm_ptr->rank;

    /* Get the local intracommunicator */
144
145
146
147
    if (!comm_ptr->local_comm) {
	mpi_errno = MPIR_Setup_intercomm_localcomm( comm_ptr );
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    }
148
149
150
151

    newcomm_ptr = comm_ptr->local_comm;

    /* do a barrier on the local intracommunicator */
152
    mpi_errno = MPIR_Barrier_intra(newcomm_ptr);
153
154
155
156
157
    if (mpi_errno) {
        /* for communication errors, just record the error but continue */
        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
        MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
    }
158
159
160
161
162
163
164
165
166
167
168

    /* 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;
169
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr);
170
171
172
173
174
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
175
176
        /* receive bcast from right */
        root = 0;
177
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr);
178
179
180
181
182
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
183
184
185
186
    }
    else {
        /* receive bcast from left */
        root = 0;
187
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr);
188
189
190
191
192
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
193
194
        /* bcast to left */
        root = (rank == 0) ? MPI_ROOT : MPI_PROC_NULL;
195
        mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr);
196
197
198
199
200
        if (mpi_errno) {
            /* for communication errors, just record the error but continue */
            MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
            MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
        }
201
202
    }
 fn_exit:
203
204
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

/* MPIR_Barrier performs an barrier using point-to-point messages.
   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)
int MPIR_Barrier(MPID_Comm *comm_ptr)
{
    int mpi_errno = MPI_SUCCESS;

    if (comm_ptr->comm_kind == MPID_INTRACOMM) {
        /* intracommunicator */
        mpi_errno = MPIR_Barrier_intra( comm_ptr );
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
    } else {
        /* intercommunicator */
        mpi_errno = MPIR_Barrier_inter( comm_ptr );
        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)
int MPIR_Barrier_impl(MPID_Comm *comm_ptr)
{
    int mpi_errno = MPI_SUCCESS;
249
    int mpi_errno_ret = MPI_SUCCESS;
250
251
252
253
254
    
    if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Barrier != NULL)
    {
	mpi_errno = comm_ptr->coll_fns->Barrier(comm_ptr);
        if (mpi_errno) MPIU_ERR_POP(mpi_errno);
255
    }
256
257
258
259
260
261
262
263
264
265
    else
    {
        if (comm_ptr->comm_kind == MPID_INTRACOMM) {
#if defined(USE_SMP_COLLECTIVES)
            if (MPIR_Comm_is_node_aware(comm_ptr)) {

                /* do the intranode barrier on all nodes */
                if (comm_ptr->node_comm != NULL)
                {
                    mpi_errno = MPIR_Barrier_or_coll_fn(comm_ptr->node_comm);
266
267
268
269
270
                    if (mpi_errno) {
                        /* for communication errors, just record the error but continue */
                        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
                        MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
                    }
271
272
273
274
275
                }

                /* do the barrier across roots of all nodes */
                if (comm_ptr->node_roots_comm != NULL) {
                    mpi_errno = MPIR_Barrier_or_coll_fn(comm_ptr->node_roots_comm);
276
277
278
279
280
                    if (mpi_errno) {
                        /* for communication errors, just record the error but continue */
                        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
                        MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
                    }
281
                }
282

283
284
285
286
287
                /* 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;
288
                    mpi_errno = MPIR_Bcast_impl(&i, 1, MPI_BYTE, 0, comm_ptr->node_comm);
289
290
291
292
293
                    if (mpi_errno) {
                        /* for communication errors, just record the error but continue */
                        MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail");
                        MPIU_ERR_ADD(mpi_errno_ret, mpi_errno);
                    }
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
                }
            }
            else {
                mpi_errno = MPIR_Barrier_intra( comm_ptr );
                if (mpi_errno) MPIU_ERR_POP(mpi_errno);
            }
#else
            mpi_errno = MPIR_Barrier_intra( comm_ptr );
            if (mpi_errno) MPIU_ERR_POP(mpi_errno);
#endif
        }
        else {
            /* intercommunicator */ 
            mpi_errno = MPIR_Barrier_inter( comm_ptr );
            if (mpi_errno) MPIU_ERR_POP(mpi_errno);
	}
    }
        
 fn_exit:
313
314
    if (mpi_errno_ret)
        mpi_errno = mpi_errno_ret;
315
    return mpi_errno;
316
317
 fn_fail:
    goto fn_exit;
318
319
320
321
}

#endif

322

323
324


325
326
#undef FUNCNAME
#define FUNCNAME MPI_Barrier
327
328
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358

/*@

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

Input Parameter:
. 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;
    MPID_MPI_STATE_DECL(MPID_STATE_MPI_BARRIER);

    MPIR_ERRTEST_INITIALIZED_ORDIE();
    
359
    MPIU_THREAD_CS_ENTER(ALLFUNC,);
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
    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);
            if (mpi_errno != MPI_SUCCESS) goto fn_fail;
	}
        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 ...  */

392
393
394
    mpi_errno = MPIR_Barrier_impl(comm_ptr);
    if (mpi_errno) goto fn_fail;
    
395
396
397
398
    /* ... end of body of routine ... */

  fn_exit:
    MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BARRIER);
399
    MPIU_THREAD_CS_EXIT(ALLFUNC,);
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    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-- */
}