Actual source code: server.c
1: /*
2: Code for allocating Unix shared memory on MPI rank 0 and later accessing it from other MPI processes
3: */
4: #include <petsc/private/petscimpl.h>
6: PetscBool PCMPIServerActive = PETSC_FALSE; // PETSc is running in server mode
7: PetscBool PCMPIServerInSolve = PETSC_FALSE; // A parallel server solve is occurring
8: PetscBool PCMPIServerUseShmget = PETSC_TRUE; // Use Unix shared memory for distributing objects
10: #if PetscDefined(HAVE_SHMGET)
11: #include <sys/shm.h>
12: #include <sys/mman.h>
13: #include <errno.h>
15: typedef struct _PetscShmgetAllocation *PetscShmgetAllocation;
16: struct _PetscShmgetAllocation {
17: void *addr; // address on this process; points to same physical address on all processes
18: int shmkey, shmid;
19: size_t sz;
20: PetscShmgetAllocation next;
21: };
22: static PetscShmgetAllocation allocations = NULL;
24: typedef struct {
25: size_t shmkey[3];
26: size_t sz[3];
27: } BcastInfo;
29: #endif
31: /*@
32: PetscShmgetAddressesFinalize - frees any shared memory that was allocated by `PetscShmgetAllocateArray()` but
33: not deallocated with `PetscShmgetDeallocateArray()`
35: Not Collective
37: Level: developer
39: Notes:
40: This prevents any shared memory allocated, but not deallocated, from remaining on the system and preventing
41: its future use.
43: If the program crashes outstanding shared memory allocations may remain.
45: .seealso: `PetscShmgetAllocateArray()`, `PetscShmgetDeallocateArray()`, `PetscShmgetUnmapAddresses()`
46: @*/
47: PetscErrorCode PetscShmgetAddressesFinalize(void)
48: {
49: PetscFunctionBegin;
50: #if PetscDefined(HAVE_SHMGET)
51: PetscShmgetAllocation next = allocations, previous = NULL;
53: while (next) {
54: PetscCheck(!shmctl(next->shmid, IPC_RMID, NULL), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to free shared memory key %d shmid %d %s, see PCMPIServerBegin()", next->shmkey, next->shmid, strerror(errno));
55: previous = next;
56: next = next->next;
57: PetscCall(PetscFree(previous));
58: }
59: #endif
60: PetscFunctionReturn(PETSC_SUCCESS);
61: }
63: /* takes a void so can work bsan safe with PetscObjectContainerCompose() */
64: /*@
65: PCMPIServerAddressesDestroy - Destroys a `PCMPIServerAddresses` context, unmapping its shared-memory addresses
67: Logically Collective
69: Input Parameter:
70: . ctx - pointer to the `PCMPIServerAddresses` structure to free
72: Level: developer
74: Note:
75: Intended for use as a destructor callback registered via `PetscObjectContainerCompose()`; the argument type is
76: a generic pointer so it satisfies that interface.
78: .seealso: `PCMPI`, `PetscShmgetMapAddresses()`, `PetscShmgetUnmapAddresses()`, `PetscObjectContainerCompose()`
79: @*/
80: PetscErrorCode PCMPIServerAddressesDestroy(PetscCtxRt ctx)
81: {
82: PCMPIServerAddresses *addresses = *(PCMPIServerAddresses **)ctx;
84: PetscFunctionBegin;
85: #if PetscDefined(HAVE_SHMGET)
86: PetscCall(PetscShmgetUnmapAddresses(addresses->n, addresses->addr));
87: PetscCall(PetscFree(addresses));
88: #else
89: (void)addresses;
90: #endif
91: PetscFunctionReturn(PETSC_SUCCESS);
92: }
94: /*@
95: PetscShmgetMapAddresses - given shared address on the first MPI process determines the
96: addresses on the other MPI processes that map to the same physical memory
98: Collective
100: Input Parameters:
101: + comm - the `MPI_Comm` to scatter the address
102: . n - the number of addresses, each obtained on MPI process zero by `PetscShmgetAllocateArray()`
103: - baseaddres - the addresses on the first MPI process, ignored on all but first process
105: Output Parameter:
106: . addres - the addresses on each MPI process, the array of void * must already be allocated
108: Level: developer
110: Note:
111: This routine does nothing if `PETSC_HAVE_SHMGET` is not defined
113: .seealso: `PetscShmgetDeallocateArray()`, `PetscShmgetAllocateArray()`, `PetscShmgetUnmapAddresses()`
114: @*/
115: PetscErrorCode PetscShmgetMapAddresses(MPI_Comm comm, PetscInt n, const void **baseaddres, void **addres)
116: {
117: PetscFunctionBegin;
118: #if PetscDefined(HAVE_SHMGET)
119: if (PetscGlobalRank == 0) {
120: BcastInfo bcastinfo = {
121: {0, 0, 0},
122: {0, 0, 0}
123: };
124: for (PetscInt i = 0; i < n; i++) {
125: PetscShmgetAllocation allocation = allocations;
127: while (allocation) {
128: if (allocation->addr == baseaddres[i]) {
129: bcastinfo.shmkey[i] = allocation->shmkey;
130: bcastinfo.sz[i] = allocation->sz;
131: addres[i] = (void *)baseaddres[i];
132: break;
133: }
134: allocation = allocation->next;
135: }
136: PetscCheck(allocation, comm, PETSC_ERR_PLIB, "Unable to locate PCMPI allocated shared address %p, see PCMPIServerBegin()", baseaddres[i]);
137: }
138: PetscCall(PetscInfo(NULL, "Mapping PCMPI Server array %p\n", addres[0]));
139: PetscCallMPI(MPI_Bcast(&bcastinfo, 6, MPIU_SIZE_T, 0, comm));
140: } else {
141: BcastInfo bcastinfo = {
142: {0, 0, 0},
143: {0, 0, 0}
144: };
145: int shmkey = 0;
146: size_t sz = 0;
148: PetscCallMPI(MPI_Bcast(&bcastinfo, 6, MPIU_SIZE_T, 0, comm));
149: for (PetscInt i = 0; i < n; i++) {
150: PetscShmgetAllocation next = allocations, previous = NULL;
152: shmkey = (int)bcastinfo.shmkey[i];
153: sz = bcastinfo.sz[i];
154: while (next) {
155: if (next->shmkey == shmkey) addres[i] = next->addr;
156: previous = next;
157: next = next->next;
158: }
159: if (!next) {
160: PetscShmgetAllocation allocation;
161: PetscCall(PetscCalloc(sizeof(struct _PetscShmgetAllocation), &allocation));
162: allocation->shmkey = shmkey;
163: allocation->sz = sz;
164: allocation->shmid = shmget(allocation->shmkey, allocation->sz, 0666);
165: PetscCheck(allocation->shmid != -1, PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to map PCMPI shared memory key %d of size %d, see PCMPIServerBegin()", allocation->shmkey, (int)allocation->sz);
166: allocation->addr = shmat(allocation->shmid, NULL, 0);
167: PetscCheck(allocation->addr, PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to map PCMPI shared memory key %d, see PCMPIServerBegin()", allocation->shmkey);
168: addres[i] = allocation->addr;
169: if (previous) previous->next = allocation;
170: else allocations = allocation;
171: }
172: }
173: }
174: #endif
175: PetscFunctionReturn(PETSC_SUCCESS);
176: }
178: /*@
179: PetscShmgetUnmapAddresses - unlinks given shared addresses on a MPI process that is not of `PetscGlobalRank` 0
181: Not Collective
183: Input Parameters:
184: + n - the number of addresses, each obtained originally on MPI `PetscGlobalRank` zero by `PetscShmgetAllocateArray()`
185: - addres - the addresses
187: Level: developer
189: Note:
190: This routine does nothing if `PETSC_HAVE_SHMGET` is not defined
192: .seealso: `PetscShmgetDeallocateArray()`, `PetscShmgetAllocateArray()`, `PetscShmgetMapAddresses()`
193: @*/
194: PetscErrorCode PetscShmgetUnmapAddresses(PetscInt n, void **addres) PeNS
195: {
196: PetscFunctionBegin;
197: #if PetscDefined(HAVE_SHMGET)
198: if (PetscGlobalRank > 0) {
199: for (PetscInt i = 0; i < n; i++) {
200: PetscShmgetAllocation next = allocations, previous = NULL;
201: PetscBool found = PETSC_FALSE;
203: while (next) {
204: if (next->addr == addres[i]) {
205: PetscCheck(!shmdt(next->addr), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to shmdt() location %s, see PCMPIServerBegin()", strerror(errno));
206: if (previous) previous->next = next->next;
207: else allocations = next->next;
208: PetscCall(PetscFree(next));
209: found = PETSC_TRUE;
210: break;
211: }
212: previous = next;
213: next = next->next;
214: }
215: PetscCheck(found, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unable to find address %p to unmap, see PCMPIServerBegin()", addres[i]);
216: }
217: }
218: #endif
219: PetscFunctionReturn(PETSC_SUCCESS);
220: }
222: /*@
223: PetscShmgetAllocateArray - allocates shared memory that will later be made accessible by all MPI processes in the server
225: Not Collective, only called on the first MPI process
227: Input Parameters:
228: + sz - the number of elements in the array
229: - asz - the size of an entry in the array, for example `sizeof(PetscScalar)`
231: Output Parameters:
232: . addr - the address of the array
234: Level: developer
236: Notes:
237: Uses `PetscMalloc()` if `PETSC_HAVE_SHMGET` is not defined or the MPI linear solver server is not running
239: Sometimes when a program crashes, shared memory IDs may remain, making it impossible to rerun the program.
240: Use
241: .vb
242: $PETSC_DIR/lib/petsc/bin/petscfreesharedmemory.sh
243: .ve to free that memory. The Linux command `ipcrm --all` or macOS command `for i in $(ipcs -m | tail -$(expr $(ipcs -m | wc -l) - 3) | tr -s ' ' | cut -d" " -f3); do ipcrm -M $i; done`
244: will also free the memory.
246: Use the Unix command `ipcs -m` to see what memory IDs are currently allocated and `ipcrm -m ID` to remove a memory ID
248: Under Apple macOS the following file must be copied to /Library/LaunchDaemons/sharedmemory.plist (ensure this file is owned by root and not the user)
249: and the machine rebooted before using shared memory
250: .vb
251: <?xml version="1.0" encoding="UTF-8"?>
252: <!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
253: <plist version="1.0">
254: <dict>
255: <key>Label</key>
256: <string>shmemsetup</string>
257: <key>UserName</key>
258: <string>root</string>
259: <key>GroupName</key>
260: <string>wheel</string>
261: <key>ProgramArguments</key>
262: <array>
263: <string>/usr/sbin/sysctl</string>
264: <string>-w</string>
265: <string>kern.sysv.shmmax=4194304000</string>
266: <string>kern.sysv.shmmni=2064</string>
267: <string>kern.sysv.shmseg=2064</string>
268: <string>kern.sysv.shmall=131072000</string>
269: </array>
270: <key>KeepAlive</key>
271: <false/>
272: <key>RunAtLoad</key>
273: <true/>
274: </dict>
275: </plist>
276: .ve
278: Use the command
279: .vb
280: /usr/sbin/sysctl -a | grep shm
281: .ve
282: to confirm that the shared memory limits you have requested are available.
284: Fortran Note:
285: The calling sequence is `PetscShmgetAllocateArray[Scalar,Int](PetscInt start, PetscInt len, Petsc[Scalar,Int], pointer :: d1(:), ierr)`
287: Developer Note:
288: More specifically this uses `PetscMalloc()` if `!PCMPIServerUseShmget` || `!PCMPIServerActive` || `PCMPIServerInSolve`
289: where `PCMPIServerInSolve` indicates that the solve is nested inside a MPI linear solver server solve and hence should
290: not allocate the vector and matrix memory in shared memory.
292: .seealso: [](sec_pcmpi), `PCMPIServerBegin()`, `PCMPI`, `KSPCheckPCMPI()`, `PetscShmgetDeallocateArray()`
293: @*/
294: PetscErrorCode PetscShmgetAllocateArray(size_t sz, size_t asz, void *addr[])
295: {
296: PetscFunctionBegin;
297: if (!PCMPIServerUseShmget || !PCMPIServerActive || PCMPIServerInSolve) PetscCall(PetscMalloc(sz * asz, addr));
298: #if PetscDefined(HAVE_SHMGET)
299: else {
300: PetscShmgetAllocation allocation;
301: static int shmkeys = 10;
303: PetscCall(PetscCalloc(sizeof(struct _PetscShmgetAllocation), &allocation));
304: allocation->shmkey = shmkeys++;
305: allocation->sz = sz * asz;
306: allocation->shmid = shmget(allocation->shmkey, allocation->sz, 0666 | IPC_CREAT);
307: PetscCheck(allocation->shmid != -1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Unable to schmget() of size %d with key %d %s see PetscShmgetAllocateArray()", (int)allocation->sz, allocation->shmkey, strerror(errno));
308: allocation->addr = shmat(allocation->shmid, NULL, 0);
309: PetscCheck(allocation->addr, PETSC_COMM_SELF, PETSC_ERR_LIB, "Unable to shmat() of shmid %d %s", allocation->shmid, strerror(errno));
310: #if PETSC_SIZEOF_VOID_P == 8
311: PetscCheck((uint64_t)allocation->addr != 0xffffffffffffffff, PETSC_COMM_SELF, PETSC_ERR_LIB, "shmat() of shmid %d returned 0xffffffffffffffff %s, see PCMPIServerBegin()", allocation->shmid, strerror(errno));
312: #endif
314: if (!allocations) allocations = allocation;
315: else {
316: PetscShmgetAllocation next = allocations;
317: while (next->next) next = next->next;
318: next->next = allocation;
319: }
320: *addr = allocation->addr;
321: PetscCall(PetscInfo(NULL, "Allocating PCMPI Server array %p shmkey %d shmid %d size %d\n", *addr, allocation->shmkey, allocation->shmid, (int)allocation->sz));
322: }
323: #endif
324: PetscFunctionReturn(PETSC_SUCCESS);
325: }
327: /*@
328: PetscShmgetDeallocateArray - deallocates shared memory accessible by all MPI processes in the server obtained with `PetscShmgetAllocateArray()`
330: Not Collective, only called on the first MPI process
332: Input Parameter:
333: . addr - the address of array
335: Level: developer
337: Note:
338: Uses `PetscFree()` if `PETSC_HAVE_SHMGET` is not defined or the MPI linear solver server is not running
340: Fortran Note:
341: The calling sequence is `PetscShmgetDeallocateArray[Scalar,Int](Petsc[Scalar,Int], pointer :: d1(:), ierr)`
343: .seealso: [](sec_pcmpi), `PCMPIServerBegin()`, `PCMPI`, `KSPCheckPCMPI()`, `PetscShmgetAllocateArray()`
344: @*/
345: PetscErrorCode PetscShmgetDeallocateArray(void *addr[])
346: {
347: PetscFunctionBegin;
348: if (!*addr) PetscFunctionReturn(PETSC_SUCCESS);
349: if (!PCMPIServerUseShmget || !PCMPIServerActive || PCMPIServerInSolve) PetscCall(PetscFree(*addr));
350: #if PetscDefined(HAVE_SHMGET)
351: else {
352: PetscShmgetAllocation next = allocations, previous = NULL;
354: while (next) {
355: if (next->addr == *addr) {
356: PetscCall(PetscInfo(NULL, "Deallocating PCMPI Server array %p shmkey %d shmid %d size %d\n", *addr, next->shmkey, next->shmid, (int)next->sz));
357: PetscCheck(!shmdt(next->addr), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to shmdt() location %s, see PCMPIServerBegin()", strerror(errno));
358: PetscCheck(!shmctl(next->shmid, IPC_RMID, NULL), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to free shared memory addr %p key %d shmid %d %s, see PCMPIServerBegin()", *addr, next->shmkey, next->shmid, strerror(errno));
359: *addr = NULL;
360: if (previous) previous->next = next->next;
361: else allocations = next->next;
362: PetscCall(PetscFree(next));
363: PetscFunctionReturn(PETSC_SUCCESS);
364: }
365: previous = next;
366: next = next->next;
367: }
368: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unable to locate PCMPI allocated shared memory address %p", *addr);
369: }
370: #endif
371: PetscFunctionReturn(PETSC_SUCCESS);
372: }
374: #if PetscDefined(USE_FORTRAN_BINDINGS)
375: #include <petsc/private/ftnimpl.h>
377: #if PetscDefined(HAVE_FORTRAN_CAPS)
378: #define petscshmgetallocatearrayscalar_ PETSCSHMGETALLOCATEARRAYSCALAR
379: #define petscshmgetdeallocatearrayscalar_ PETSCSHMGETDEALLOCATEARRAYSCALAR
380: #define petscshmgetallocatearrayint_ PETSCSHMGETALLOCATEARRAYINT
381: #define petscshmgetdeallocatearrayint_ PETSCSHMGETDEALLOCATEARRAYINT
382: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
383: #define petscshmgetallocatearrayscalar_ petscshmgetallocatearrayscalar
384: #define petscshmgetdeallocatearrayscalar_ petscshmgetdeallocatearrayscalar
385: #define petscshmgetallocatearrayint_ petscshmgetallocatearrayint
386: #define petscshmgetdeallocatearrayint_ petscshmgetdeallocatearrayint
387: #endif
389: PETSC_EXTERN void petscshmgetallocatearrayscalar_(PetscInt *start, PetscInt *len, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
390: {
391: PetscScalar *aa;
393: *ierr = PetscShmgetAllocateArray(*len, sizeof(PetscScalar), (void **)&aa);
394: if (*ierr) return;
395: *ierr = F90Array1dCreate(aa, MPIU_SCALAR, *start, *len, a PETSC_F90_2PTR_PARAM(ptrd));
396: }
398: PETSC_EXTERN void petscshmgetdeallocatearrayscalar_(F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
399: {
400: PetscScalar *aa;
402: *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&aa PETSC_F90_2PTR_PARAM(ptrd));
403: if (*ierr) return;
404: *ierr = PetscShmgetDeallocateArray((void **)&aa);
405: if (*ierr) return;
406: *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
407: }
409: PETSC_EXTERN void petscshmgetallocatearrayint_(PetscInt *start, PetscInt *len, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
410: {
411: PetscInt *aa;
413: *ierr = PetscShmgetAllocateArray(*len, sizeof(PetscInt), (void **)&aa);
414: if (*ierr) return;
415: *ierr = F90Array1dCreate(aa, MPIU_INT, *start, *len, a PETSC_F90_2PTR_PARAM(ptrd));
416: }
418: PETSC_EXTERN void petscshmgetdeallocatearrayint_(F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
419: {
420: PetscInt *aa;
422: *ierr = F90Array1dAccess(a, MPIU_INT, (void **)&aa PETSC_F90_2PTR_PARAM(ptrd));
423: if (*ierr) return;
424: *ierr = PetscShmgetDeallocateArray((void **)&aa);
425: if (*ierr) return;
426: *ierr = F90Array1dDestroy(a, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
427: }
429: #endif