Actual source code: mpmpishm.c
1: #include <petsc/private/petscimpl.h>
2: #include <pthread.h>
3: #include <hwloc.h>
4: #include <omp.h>
6: /* Use mmap() to allocate shared mmeory (for the pthread_barrier_t object) if it is available,
7: otherwise use MPI_Win_allocate_shared. They should have the same effect except MPI-3 is much
8: simpler to use. However, on a Cori Haswell node with Cray MPI, MPI-3 worsened a test's performance
9: by 50%. Until the reason is found out, we use mmap() instead.
10: */
11: #define USE_MMAP_ALLOCATE_SHARED_MEMORY
13: #if defined(USE_MMAP_ALLOCATE_SHARED_MEMORY) && PetscDefined(HAVE_MMAP)
14: #include <sys/mman.h>
15: #include <sys/types.h>
16: #include <sys/stat.h>
17: #include <fcntl.h>
18: #endif
20: struct _n_PetscOmpCtrl {
21: MPI_Comm omp_comm; /* a shared memory communicator to spawn omp threads */
22: MPI_Comm omp_master_comm; /* a communicator to give to third party libraries */
23: PetscMPIInt omp_comm_size; /* size of omp_comm, a kind of OMP_NUM_THREADS */
24: PetscBool is_omp_master; /* rank 0's in omp_comm */
25: MPI_Win omp_win; /* a shared memory window containing a barrier */
26: pthread_barrier_t *barrier; /* pointer to the barrier */
27: hwloc_topology_t topology;
28: hwloc_cpuset_t cpuset; /* cpu bindings of omp master */
29: hwloc_cpuset_t omp_cpuset; /* union of cpu bindings of ranks in omp_comm */
30: };
32: /* Allocate and initialize a pthread_barrier_t object in memory shared by processes in omp_comm
33: contained by the controller.
35: PETSc OpenMP controller users do not call this function directly. This function exists
36: only because we want to separate shared memory allocation methods from other code.
37: */
38: static inline PetscErrorCode PetscOmpCtrlCreateBarrier(PetscOmpCtrl ctrl)
39: {
40: MPI_Aint size;
41: void *baseptr;
42: pthread_barrierattr_t attr;
44: #if defined(USE_MMAP_ALLOCATE_SHARED_MEMORY) && PetscDefined(HAVE_MMAP)
45: int fd;
46: char pathname[PETSC_MAX_PATH_LEN];
47: #else
48: PetscMPIInt disp_unit;
49: #endif
51: PetscFunctionBegin;
52: #if defined(USE_MMAP_ALLOCATE_SHARED_MEMORY) && PetscDefined(HAVE_MMAP)
53: size = sizeof(pthread_barrier_t);
54: if (ctrl->is_omp_master) {
55: /* use PETSC_COMM_SELF in PetscGetTmp, since it is a collective call. Using omp_comm would otherwise bcast the partially populated pathname to slaves */
56: PetscCall(PetscGetTmp(PETSC_COMM_SELF, pathname, PETSC_MAX_PATH_LEN));
57: PetscCall(PetscStrlcat(pathname, "/petsc-shm-XXXXXX", PETSC_MAX_PATH_LEN));
58: /* mkstemp replaces XXXXXX with a unique file name and opens the file for us */
59: fd = mkstemp(pathname);
60: PetscCheck(fd != -1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Could not create tmp file %s with mkstemp", pathname);
61: PetscCallExternal(ftruncate, fd, size);
62: baseptr = mmap(NULL, size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0);
63: PetscCheck(baseptr != MAP_FAILED, PETSC_COMM_SELF, PETSC_ERR_LIB, "mmap() failed");
64: PetscCallExternal(close, fd);
65: PetscCallMPI(MPI_Bcast(pathname, PETSC_MAX_PATH_LEN, MPI_CHAR, 0, ctrl->omp_comm));
66: /* this MPI_Barrier is to wait slaves to open the file before master unlinks it */
67: PetscCallMPI(MPI_Barrier(ctrl->omp_comm));
68: PetscCallExternal(unlink, pathname);
69: } else {
70: PetscCallMPI(MPI_Bcast(pathname, PETSC_MAX_PATH_LEN, MPI_CHAR, 0, ctrl->omp_comm));
71: fd = open(pathname, O_RDWR);
72: PetscCheck(fd != -1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Could not open tmp file %s", pathname);
73: baseptr = mmap(NULL, size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0);
74: PetscCheck(baseptr != MAP_FAILED, PETSC_COMM_SELF, PETSC_ERR_LIB, "mmap() failed");
75: PetscCallExternal(close, fd);
76: PetscCallMPI(MPI_Barrier(ctrl->omp_comm));
77: }
78: #else
79: size = ctrl->is_omp_master ? sizeof(pthread_barrier_t) : 0;
80: PetscCallMPI(MPI_Win_allocate_shared(size, 1, MPI_INFO_NULL, ctrl->omp_comm, &baseptr, &ctrl->omp_win));
81: PetscCallMPI(MPI_Win_shared_query(ctrl->omp_win, 0, &size, &disp_unit, &baseptr));
82: #endif
83: ctrl->barrier = (pthread_barrier_t *)baseptr;
85: /* omp master initializes the barrier */
86: if (ctrl->is_omp_master) {
87: PetscCallMPI(MPI_Comm_size(ctrl->omp_comm, &ctrl->omp_comm_size));
88: PetscCallExternal(pthread_barrierattr_init, &attr);
89: PetscCallExternal(pthread_barrierattr_setpshared, &attr, PTHREAD_PROCESS_SHARED); /* make the barrier also work for processes */
90: PetscCallExternal(pthread_barrier_init, ctrl->barrier, &attr, (unsigned int)ctrl->omp_comm_size);
91: PetscCallExternal(pthread_barrierattr_destroy, &attr);
92: }
94: /* this MPI_Barrier is to make sure the omp barrier is initialized before slaves use it */
95: PetscCallMPI(MPI_Barrier(ctrl->omp_comm));
96: PetscFunctionReturn(PETSC_SUCCESS);
97: }
99: /* Destroy the pthread barrier in the PETSc OpenMP controller */
100: static inline PetscErrorCode PetscOmpCtrlDestroyBarrier(PetscOmpCtrl ctrl)
101: {
102: PetscFunctionBegin;
103: /* this MPI_Barrier is to make sure slaves have finished using the omp barrier before master destroys it */
104: PetscCallMPI(MPI_Barrier(ctrl->omp_comm));
105: if (ctrl->is_omp_master) PetscCallExternal(pthread_barrier_destroy, ctrl->barrier);
107: #if defined(USE_MMAP_ALLOCATE_SHARED_MEMORY) && PetscDefined(HAVE_MMAP)
108: PetscCallExternal(munmap, ctrl->barrier, sizeof(pthread_barrier_t));
109: #else
110: PetscCallMPI(MPI_Win_free(&ctrl->omp_win));
111: #endif
112: PetscFunctionReturn(PETSC_SUCCESS);
113: }
115: /*@
116: PetscOmpCtrlCreate - create a PETSc OpenMP controller, which manages PETSc's interaction with third party libraries that use OpenMP
118: Input Parameters:
119: + petsc_comm - a communicator some PETSc object (for example, a matrix) lives in
120: - nthreads - number of threads per MPI rank to spawn in a library using OpenMP. If nthreads = -1, let PETSc decide a suitable value
122: Output Parameter:
123: . pctrl - a PETSc OpenMP controller
125: Level: developer
127: Developer Note:
128: Possibly use the variable `PetscNumOMPThreads` to determine the number for threads to use
130: .seealso: `PetscOmpCtrlDestroy()`, `PetscOmpCtrlGetOmpComms()`, `PetscOmpCtrlBarrier()`, `PetscOmpCtrlOmpRegionOnMasterBegin()`, `PetscOmpCtrlOmpRegionOnMasterEnd()`
131: @*/
132: PetscErrorCode PetscOmpCtrlCreate(MPI_Comm petsc_comm, PetscInt nthreads, PetscOmpCtrl *pctrl)
133: {
134: PetscOmpCtrl ctrl;
135: unsigned long *cpu_ulongs = NULL;
136: PetscShmComm pshmcomm;
137: MPI_Comm shm_comm;
138: PetscMPIInt shm_rank, shm_comm_size, omp_rank, color, nr_cpu_ulongs;
139: PetscInt num_packages, num_cores;
141: PetscFunctionBegin;
142: PetscCall(PetscNew(&ctrl));
144: /*=================================================================================
145: Init hwloc
146: ==================================================================================*/
147: PetscCallExternal(hwloc_topology_init, &ctrl->topology);
148: #if HWLOC_API_VERSION >= 0x00020000
149: /* to filter out unneeded info and have faster hwloc_topology_load */
150: PetscCallExternal(hwloc_topology_set_all_types_filter, ctrl->topology, HWLOC_TYPE_FILTER_KEEP_NONE);
151: PetscCallExternal(hwloc_topology_set_type_filter, ctrl->topology, HWLOC_OBJ_CORE, HWLOC_TYPE_FILTER_KEEP_ALL);
152: #endif
153: PetscCallExternal(hwloc_topology_load, ctrl->topology);
155: /*=================================================================================
156: Split petsc_comm into multiple omp_comms. Ranks in an omp_comm have access to
157: physically shared memory. Rank 0 of each omp_comm is called an OMP master, and
158: others are called slaves. OMP Masters make up a new comm called omp_master_comm,
159: which is usually passed to third party libraries.
160: ==================================================================================*/
162: /* fetch the stored shared memory communicator */
163: PetscCall(PetscShmCommGet(petsc_comm, &pshmcomm));
164: PetscCall(PetscShmCommGetMpiShmComm(pshmcomm, &shm_comm));
166: PetscCallMPI(MPI_Comm_rank(shm_comm, &shm_rank));
167: PetscCallMPI(MPI_Comm_size(shm_comm, &shm_comm_size));
169: /* PETSc decides nthreads, which is the smaller of shm_comm_size or cores per package(socket) */
170: if (nthreads == -1) {
171: num_packages = hwloc_get_nbobjs_by_type(ctrl->topology, HWLOC_OBJ_PACKAGE) <= 0 ? 1 : hwloc_get_nbobjs_by_type(ctrl->topology, HWLOC_OBJ_PACKAGE);
172: num_cores = hwloc_get_nbobjs_by_type(ctrl->topology, HWLOC_OBJ_CORE) <= 0 ? 1 : hwloc_get_nbobjs_by_type(ctrl->topology, HWLOC_OBJ_CORE);
173: nthreads = num_cores / num_packages;
174: if (nthreads > shm_comm_size) nthreads = shm_comm_size;
175: }
177: PetscCheck(nthreads >= 1 && nthreads <= shm_comm_size, petsc_comm, PETSC_ERR_ARG_OUTOFRANGE, "number of OpenMP threads %" PetscInt_FMT " can not be < 1 or > the MPI shared memory communicator size %d", nthreads, shm_comm_size);
178: if (shm_comm_size % nthreads) PetscCall(PetscPrintf(petsc_comm, "Warning: number of OpenMP threads %" PetscInt_FMT " is not a factor of the MPI shared memory communicator size %d, which may cause load-imbalance!\n", nthreads, shm_comm_size));
180: /* split shm_comm into a set of omp_comms with each of size nthreads. Ex., if
181: shm_comm_size=16, nthreads=8, then ranks 0~7 get color 0 and ranks 8~15 get
182: color 1. They are put in two omp_comms. Note that petsc_ranks may or may not
183: be consecutive in a shm_comm, but shm_ranks always run from 0 to shm_comm_size-1.
184: Use 0 as key so that rank ordering wont change in new comm.
185: */
186: color = shm_rank / nthreads;
187: PetscCallMPI(MPI_Comm_split(shm_comm, color, 0 /*key*/, &ctrl->omp_comm));
189: /* put rank 0's in omp_comms (i.e., master ranks) into a new comm - omp_master_comm */
190: PetscCallMPI(MPI_Comm_rank(ctrl->omp_comm, &omp_rank));
191: if (!omp_rank) {
192: ctrl->is_omp_master = PETSC_TRUE; /* master */
193: color = 0;
194: } else {
195: ctrl->is_omp_master = PETSC_FALSE; /* slave */
196: color = MPI_UNDEFINED; /* to make slaves get omp_master_comm = MPI_COMM_NULL in MPI_Comm_split */
197: }
198: PetscCallMPI(MPI_Comm_split(petsc_comm, color, 0 /*key*/, &ctrl->omp_master_comm));
200: /*=================================================================================
201: Each omp_comm has a pthread_barrier_t in its shared memory, which is used to put
202: slave ranks in sleep and idle their CPU, so that the master can fork OMP threads
203: and run them on the idle CPUs.
204: ==================================================================================*/
205: PetscCall(PetscOmpCtrlCreateBarrier(ctrl));
207: /*=================================================================================
208: omp master logs its cpu binding (i.e., cpu set) and computes a new binding that
209: is the union of the bindings of all ranks in the omp_comm
210: =================================================================================*/
212: ctrl->cpuset = hwloc_bitmap_alloc();
213: PetscCheck(ctrl->cpuset, PETSC_COMM_SELF, PETSC_ERR_LIB, "hwloc_bitmap_alloc() failed");
214: PetscCallExternal(hwloc_get_cpubind, ctrl->topology, ctrl->cpuset, HWLOC_CPUBIND_PROCESS);
216: /* hwloc main developer said they will add new APIs hwloc_bitmap_{nr,to,from}_ulongs in 2.1 to help us simplify the following bitmap pack/unpack code */
217: nr_cpu_ulongs = (hwloc_bitmap_last(hwloc_topology_get_topology_cpuset(ctrl->topology)) + sizeof(unsigned long) * 8) / sizeof(unsigned long) / 8;
218: PetscCall(PetscMalloc1(nr_cpu_ulongs, &cpu_ulongs));
219: if (nr_cpu_ulongs == 1) {
220: cpu_ulongs[0] = hwloc_bitmap_to_ulong(ctrl->cpuset);
221: } else {
222: for (PetscMPIInt i = 0; i < nr_cpu_ulongs; i++) cpu_ulongs[i] = hwloc_bitmap_to_ith_ulong(ctrl->cpuset, (unsigned)i);
223: }
225: PetscCallMPI(MPI_Reduce(ctrl->is_omp_master ? MPI_IN_PLACE : cpu_ulongs, cpu_ulongs, nr_cpu_ulongs, MPI_UNSIGNED_LONG, MPI_BOR, 0, ctrl->omp_comm));
227: if (ctrl->is_omp_master) {
228: ctrl->omp_cpuset = hwloc_bitmap_alloc();
229: PetscCheck(ctrl->omp_cpuset, PETSC_COMM_SELF, PETSC_ERR_LIB, "hwloc_bitmap_alloc() failed");
230: if (nr_cpu_ulongs == 1) {
231: #if HWLOC_API_VERSION >= 0x00020000
232: PetscCallExternal(hwloc_bitmap_from_ulong, ctrl->omp_cpuset, cpu_ulongs[0]);
233: #else
234: hwloc_bitmap_from_ulong(ctrl->omp_cpuset, cpu_ulongs[0]);
235: #endif
236: } else {
237: for (PetscMPIInt i = 0; i < nr_cpu_ulongs; i++) {
238: #if HWLOC_API_VERSION >= 0x00020000
239: PetscCallExternal(hwloc_bitmap_set_ith_ulong, ctrl->omp_cpuset, (unsigned)i, cpu_ulongs[i]);
240: #else
241: hwloc_bitmap_set_ith_ulong(ctrl->omp_cpuset, (unsigned)i, cpu_ulongs[i]);
242: #endif
243: }
244: }
245: }
246: PetscCall(PetscFree(cpu_ulongs));
247: *pctrl = ctrl;
248: PetscFunctionReturn(PETSC_SUCCESS);
249: }
251: /*@
252: PetscOmpCtrlDestroy - destroy the PETSc OpenMP controller
254: Input Parameter:
255: . pctrl - a PETSc OpenMP controller
257: Level: developer
259: .seealso: `PetscOmpCtrlCreate()`, `PetscOmpCtrlGetOmpComms()`, `PetscOmpCtrlBarrier()`, `PetscOmpCtrlOmpRegionOnMasterBegin()`, `PetscOmpCtrlOmpRegionOnMasterEnd()`
260: @*/
261: PetscErrorCode PetscOmpCtrlDestroy(PetscOmpCtrl *pctrl)
262: {
263: PetscOmpCtrl ctrl = *pctrl;
265: PetscFunctionBegin;
266: hwloc_bitmap_free(ctrl->cpuset);
267: hwloc_topology_destroy(ctrl->topology);
268: PetscCall(PetscOmpCtrlDestroyBarrier(ctrl));
269: PetscCallMPI(MPI_Comm_free(&ctrl->omp_comm));
270: if (ctrl->is_omp_master) {
271: hwloc_bitmap_free(ctrl->omp_cpuset);
272: PetscCallMPI(MPI_Comm_free(&ctrl->omp_master_comm));
273: }
274: PetscCall(PetscFree(ctrl));
275: PetscFunctionReturn(PETSC_SUCCESS);
276: }
278: /*@
279: PetscOmpCtrlGetOmpComms - Get MPI communicators from a PETSc OMP controller
281: Input Parameter:
282: . ctrl - a PETSc OMP controller
284: Output Parameters:
285: + omp_comm - a communicator that includes a master rank and slave ranks where master spawns threads
286: . omp_master_comm - on master ranks, return a communicator that include master ranks of each omp_comm;
287: on slave ranks, `MPI_COMM_NULL` will be return in reality.
288: - is_omp_master - true if the calling process is an OMP master rank.
290: Note:
291: Any output parameter can be `NULL`. The parameter is just ignored.
293: Level: developer
295: .seealso: `PetscOmpCtrlCreate()`, `PetscOmpCtrlDestroy()`, `PetscOmpCtrlBarrier()`, `PetscOmpCtrlOmpRegionOnMasterBegin()`, `PetscOmpCtrlOmpRegionOnMasterEnd()`
296: @*/
297: PetscErrorCode PetscOmpCtrlGetOmpComms(PetscOmpCtrl ctrl, MPI_Comm *omp_comm, MPI_Comm *omp_master_comm, PetscBool *is_omp_master)
298: {
299: PetscFunctionBegin;
300: if (omp_comm) *omp_comm = ctrl->omp_comm;
301: if (omp_master_comm) *omp_master_comm = ctrl->omp_master_comm;
302: if (is_omp_master) *is_omp_master = ctrl->is_omp_master;
303: PetscFunctionReturn(PETSC_SUCCESS);
304: }
306: /*@
307: PetscOmpCtrlBarrier - Do barrier on MPI ranks in omp_comm contained by the PETSc OMP controller (to let slave ranks free their CPU)
309: Input Parameter:
310: . ctrl - a PETSc OMP controller
312: Notes:
313: This is a pthread barrier on MPI ranks. Using `MPI_Barrier()` instead is conceptually correct. But MPI standard does not
314: require processes blocked by `MPI_Barrier()` free their CPUs to let other processes progress. In practice, to minilize latency,
315: MPI ranks stuck in `MPI_Barrier()` keep polling and do not free CPUs. In contrast, pthread_barrier has this requirement.
317: A code using `PetscOmpCtrlBarrier()` would be like this,
318: .vb
319: if (is_omp_master) {
320: PetscOmpCtrlOmpRegionOnMasterBegin(ctrl);
321: Call the library using OpenMP
322: PetscOmpCtrlOmpRegionOnMasterEnd(ctrl);
323: }
324: PetscOmpCtrlBarrier(ctrl);
325: .ve
327: Level: developer
329: .seealso: `PetscOmpCtrlOmpRegionOnMasterBegin()`, `PetscOmpCtrlOmpRegionOnMasterEnd()`, `PetscOmpCtrlCreate()`, `PetscOmpCtrlDestroy()`
330: @*/
331: PetscErrorCode PetscOmpCtrlBarrier(PetscOmpCtrl ctrl)
332: {
333: int err;
335: PetscFunctionBegin;
336: err = pthread_barrier_wait(ctrl->barrier);
337: PetscCheck(!err || err == PTHREAD_BARRIER_SERIAL_THREAD, PETSC_COMM_SELF, PETSC_ERR_LIB, "pthread_barrier_wait failed within PetscOmpCtrlBarrier with return code %d", err);
338: PetscFunctionReturn(PETSC_SUCCESS);
339: }
341: /*@
342: PetscOmpCtrlOmpRegionOnMasterBegin - Mark the beginning of an OpenMP library call on master ranks
344: Input Parameter:
345: . ctrl - a PETSc OMP controller
347: Note:
348: Only master ranks can call this function. Call `PetscOmpCtrlGetOmpComms()` to know if this is a master rank.
349: This function changes CPU binding of master ranks and nthreads-var of OpenMP runtime
351: Level: developer
353: .seealso: `PetscOmpCtrlOmpRegionOnMasterEnd()`, `PetscOmpCtrlCreate()`, `PetscOmpCtrlDestroy()`, `PetscOmpCtrlBarrier()`
354: @*/
355: PetscErrorCode PetscOmpCtrlOmpRegionOnMasterBegin(PetscOmpCtrl ctrl)
356: {
357: PetscFunctionBegin;
358: PetscCallExternal(hwloc_set_cpubind, ctrl->topology, ctrl->omp_cpuset, HWLOC_CPUBIND_PROCESS);
359: omp_set_num_threads(ctrl->omp_comm_size); /* may override the OMP_NUM_THREAD env var */
360: PetscFunctionReturn(PETSC_SUCCESS);
361: }
363: /*@
364: PetscOmpCtrlOmpRegionOnMasterEnd - Mark the end of an OpenMP library call on master ranks
366: Input Parameter:
367: . ctrl - a PETSc OMP controller
369: Note:
370: Only master ranks can call this function. Call `PetscOmpCtrlGetOmpComms()` to know if this is a master rank.
371: This function restores the CPU binding of master ranks and set and nthreads-var of OpenMP runtime to 1.
373: Level: developer
375: .seealso: `PetscOmpCtrlOmpRegionOnMasterBegin()`, `PetscOmpCtrlCreate()`, `PetscOmpCtrlDestroy()`, `PetscOmpCtrlBarrier()`
376: @*/
377: PetscErrorCode PetscOmpCtrlOmpRegionOnMasterEnd(PetscOmpCtrl ctrl)
378: {
379: PetscFunctionBegin;
380: PetscCallExternal(hwloc_set_cpubind, ctrl->topology, ctrl->cpuset, HWLOC_CPUBIND_PROCESS);
381: omp_set_num_threads(1);
382: PetscFunctionReturn(PETSC_SUCCESS);
383: }
385: #undef USE_MMAP_ALLOCATE_SHARED_MEMORY