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>
  5: #include <petscsys.h>

  7: PetscBool PCMPIServerActive    = PETSC_FALSE; // PETSc is running in server mode
  8: PetscBool PCMPIServerInSolve   = PETSC_FALSE; // A parallel server solve is occurring
  9: PetscBool PCMPIServerUseShmget = PETSC_TRUE;  // Use Unix shared memory for distributing objects

 11: #if defined(PETSC_HAVE_SHMGET)
 12:   #include <sys/shm.h>
 13:   #include <sys/mman.h>
 14:   #include <errno.h>

 16: typedef struct _PetscShmgetAllocation *PetscShmgetAllocation;
 17: struct _PetscShmgetAllocation {
 18:   void                 *addr; // address on this process; points to same physical address on all processes
 19:   int                   shmkey, shmid;
 20:   size_t                sz;
 21:   PetscShmgetAllocation next;
 22: };
 23: static PetscShmgetAllocation allocations = NULL;

 25: typedef struct {
 26:   size_t shmkey[3];
 27:   size_t sz[3];
 28: } BcastInfo;

 30: #endif

 32: /*@C
 33:   PetscShmgetAddressesFinalize - frees any shared memory that was allocated by `PetscShmgetAllocateArray()` but
 34:   not deallocated with `PetscShmgetDeallocateArray()`

 36:   Not Collective

 38:   Level: developer

 40:   Notes:
 41:   This prevents any shared memory allocated, but not deallocated, from remaining on the system and preventing
 42:   its future use.

 44:   If the program crashes outstanding shared memory allocations may remain.

 46: .seealso: `PetscShmgetAllocateArray()`, `PetscShmgetDeallocateArray()`, `PetscShmgetUnmapAddresses()`
 47: @*/
 48: PetscErrorCode PetscShmgetAddressesFinalize(void)
 49: {
 50:   PetscFunctionBegin;
 51: #if defined(PETSC_HAVE_SHMGET)
 52:   PetscShmgetAllocation next = allocations, previous = NULL;

 54:   while (next) {
 55:     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));
 56:     previous = next;
 57:     next     = next->next;
 58:     PetscCall(PetscFree(previous));
 59:   }
 60: #endif
 61:   PetscFunctionReturn(PETSC_SUCCESS);
 62: }

 64: /* takes a void so can work bsan safe with PetscObjectContainerCompose() */
 65: /*@C
 66:   PCMPIServerAddressesDestroy - Destroys a `PCMPIServerAddresses` context, unmapping its shared-memory addresses

 68:   Logically Collective

 70:   Input Parameter:
 71: . ctx - pointer to the `PCMPIServerAddresses` structure to free

 73:   Level: developer

 75:   Note:
 76:   Intended for use as a destructor callback registered via `PetscObjectContainerCompose()`; the argument type is
 77:   a generic pointer so it satisfies that interface.

 79: .seealso: `PCMPI`, `PetscShmgetMapAddresses()`, `PetscShmgetUnmapAddresses()`, `PetscObjectContainerCompose()`
 80: @*/
 81: PetscErrorCode PCMPIServerAddressesDestroy(PetscCtxRt ctx)
 82: {
 83:   PCMPIServerAddresses *addresses = *(PCMPIServerAddresses **)ctx;

 85:   PetscFunctionBegin;
 86: #if defined(PETSC_HAVE_SHMGET)
 87:   PetscCall(PetscShmgetUnmapAddresses(addresses->n, addresses->addr));
 88:   PetscCall(PetscFree(addresses));
 89: #else
 90:   (void)addresses;
 91: #endif
 92:   PetscFunctionReturn(PETSC_SUCCESS);
 93: }

 95: /*@C
 96:   PetscShmgetMapAddresses - given shared address on the first MPI process determines the
 97:   addresses on the other MPI processes that map to the same physical memory

 99:   Collective

101:   Input Parameters:
102: + comm       - the `MPI_Comm` to scatter the address
103: . n          - the number of addresses, each obtained on MPI process zero by `PetscShmgetAllocateArray()`
104: - baseaddres - the addresses on the first MPI process, ignored on all but first process

106:   Output Parameter:
107: . addres - the addresses on each MPI process, the array of void * must already be allocated

109:   Level: developer

111:   Note:
112:   This routine does nothing if `PETSC_HAVE_SHMGET` is not defined

114: .seealso: `PetscShmgetDeallocateArray()`, `PetscShmgetAllocateArray()`, `PetscShmgetUnmapAddresses()`
115: @*/
116: PetscErrorCode PetscShmgetMapAddresses(MPI_Comm comm, PetscInt n, const void **baseaddres, void **addres)
117: {
118:   PetscFunctionBegin;
119: #if defined(PETSC_HAVE_SHMGET)
120:   if (PetscGlobalRank == 0) {
121:     BcastInfo bcastinfo = {
122:       {0, 0, 0},
123:       {0, 0, 0}
124:     };
125:     for (PetscInt i = 0; i < n; i++) {
126:       PetscShmgetAllocation allocation = allocations;

128:       while (allocation) {
129:         if (allocation->addr == baseaddres[i]) {
130:           bcastinfo.shmkey[i] = allocation->shmkey;
131:           bcastinfo.sz[i]     = allocation->sz;
132:           addres[i]           = (void *)baseaddres[i];
133:           break;
134:         }
135:         allocation = allocation->next;
136:       }
137:       PetscCheck(allocation, comm, PETSC_ERR_PLIB, "Unable to locate PCMPI allocated shared address %p, see PCMPIServerBegin()", baseaddres[i]);
138:     }
139:     PetscCall(PetscInfo(NULL, "Mapping PCMPI Server array %p\n", addres[0]));
140:     PetscCallMPI(MPI_Bcast(&bcastinfo, 6, MPIU_SIZE_T, 0, comm));
141:   } else {
142:     BcastInfo bcastinfo = {
143:       {0, 0, 0},
144:       {0, 0, 0}
145:     };
146:     int    shmkey = 0;
147:     size_t sz     = 0;

149:     PetscCallMPI(MPI_Bcast(&bcastinfo, 6, MPIU_SIZE_T, 0, comm));
150:     for (PetscInt i = 0; i < n; i++) {
151:       PetscShmgetAllocation next = allocations, previous = NULL;

153:       shmkey = (int)bcastinfo.shmkey[i];
154:       sz     = bcastinfo.sz[i];
155:       while (next) {
156:         if (next->shmkey == shmkey) addres[i] = next->addr;
157:         previous = next;
158:         next     = next->next;
159:       }
160:       if (!next) {
161:         PetscShmgetAllocation allocation;
162:         PetscCall(PetscCalloc(sizeof(struct _PetscShmgetAllocation), &allocation));
163:         allocation->shmkey = shmkey;
164:         allocation->sz     = sz;
165:         allocation->shmid  = shmget(allocation->shmkey, allocation->sz, 0666);
166:         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);
167:         allocation->addr = shmat(allocation->shmid, NULL, 0);
168:         PetscCheck(allocation->addr, PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to map PCMPI shared memory key %d, see PCMPIServerBegin()", allocation->shmkey);
169:         addres[i] = allocation->addr;
170:         if (previous) previous->next = allocation;
171:         else allocations = allocation;
172:       }
173:     }
174:   }
175: #endif
176:   PetscFunctionReturn(PETSC_SUCCESS);
177: }

179: /*@C
180:   PetscShmgetUnmapAddresses - unlinks given shared addresses on a MPI process that is not of `PetscGlobalRank` 0

182:   Not Collective

184:   Input Parameters:
185: + n      - the number of addresses, each obtained originally on MPI `PetscGlobalRank` zero by `PetscShmgetAllocateArray()`
186: - addres - the addresses

188:   Level: developer

190:   Note:
191:   This routine does nothing if `PETSC_HAVE_SHMGET` is not defined

193: .seealso: `PetscShmgetDeallocateArray()`, `PetscShmgetAllocateArray()`, `PetscShmgetMapAddresses()`
194: @*/
195: PetscErrorCode PetscShmgetUnmapAddresses(PetscInt n, void **addres) PeNS
196: {
197:   PetscFunctionBegin;
198: #if defined(PETSC_HAVE_SHMGET)
199:   if (PetscGlobalRank > 0) {
200:     for (PetscInt i = 0; i < n; i++) {
201:       PetscShmgetAllocation next = allocations, previous = NULL;
202:       PetscBool             found = PETSC_FALSE;

204:       while (next) {
205:         if (next->addr == addres[i]) {
206:           PetscCheck(!shmdt(next->addr), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to shmdt() location %s, see PCMPIServerBegin()", strerror(errno));
207:           if (previous) previous->next = next->next;
208:           else allocations = next->next;
209:           PetscCall(PetscFree(next));
210:           found = PETSC_TRUE;
211:           break;
212:         }
213:         previous = next;
214:         next     = next->next;
215:       }
216:       PetscCheck(found, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unable to find address %p to unmap, see PCMPIServerBegin()", addres[i]);
217:     }
218:   }
219: #endif
220:   PetscFunctionReturn(PETSC_SUCCESS);
221: }

223: /*@C
224:   PetscShmgetAllocateArray - allocates shared memory that will later be made accessible by all MPI processes in the server

226:   Not Collective, only called on the first MPI process

228:   Input Parameters:
229: + sz  - the number of elements in the array
230: - asz - the size of an entry in the array, for example `sizeof(PetscScalar)`

232:   Output Parameters:
233: . addr - the address of the array

235:   Level: developer

237:   Notes:
238:   Uses `PetscMalloc()` if `PETSC_HAVE_SHMGET` is not defined or the MPI linear solver server is not running

240:   Sometimes when a program crashes, shared memory IDs may remain, making it impossible to rerun the program.
241:   Use
242: .vb
243:   $PETSC_DIR/lib/petsc/bin/petscfreesharedmemory.sh
244: .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`
245:   will also free the memory.

247:   Use the Unix command `ipcs -m` to see what memory IDs are currently allocated and `ipcrm -m ID` to remove a memory ID

249:   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)
250:   and the machine rebooted before using shared memory
251: .vb
252: <?xml version="1.0" encoding="UTF-8"?>
253: <!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
254: <plist version="1.0">
255: <dict>
256:  <key>Label</key>
257:  <string>shmemsetup</string>
258:  <key>UserName</key>
259:  <string>root</string>
260:  <key>GroupName</key>
261:  <string>wheel</string>
262:  <key>ProgramArguments</key>
263:  <array>
264:  <string>/usr/sbin/sysctl</string>
265:  <string>-w</string>
266:  <string>kern.sysv.shmmax=4194304000</string>
267:  <string>kern.sysv.shmmni=2064</string>
268:  <string>kern.sysv.shmseg=2064</string>
269:  <string>kern.sysv.shmall=131072000</string>
270:   </array>
271:  <key>KeepAlive</key>
272:  <false/>
273:  <key>RunAtLoad</key>
274:  <true/>
275: </dict>
276: </plist>
277: .ve

279:   Use the command
280: .vb
281:   /usr/sbin/sysctl -a | grep shm
282: .ve
283:   to confirm that the shared memory limits you have requested are available.

285:   Fortran Note:
286:   The calling sequence is `PetscShmgetAllocateArray[Scalar,Int](PetscInt start, PetscInt len, Petsc[Scalar,Int], pointer :: d1(:), ierr)`

288:   Developer Note:
289:   More specifically this uses `PetscMalloc()` if `!PCMPIServerUseShmget` || `!PCMPIServerActive` || `PCMPIServerInSolve`
290:   where `PCMPIServerInSolve` indicates that the solve is nested inside a MPI linear solver server solve and hence should
291:   not allocate the vector and matrix memory in shared memory.

293: .seealso: [](sec_pcmpi), `PCMPIServerBegin()`, `PCMPI`, `KSPCheckPCMPI()`, `PetscShmgetDeallocateArray()`
294: @*/
295: PetscErrorCode PetscShmgetAllocateArray(size_t sz, size_t asz, void *addr[])
296: {
297:   PetscFunctionBegin;
298:   if (!PCMPIServerUseShmget || !PCMPIServerActive || PCMPIServerInSolve) PetscCall(PetscMalloc(sz * asz, addr));
299: #if defined(PETSC_HAVE_SHMGET)
300:   else {
301:     PetscShmgetAllocation allocation;
302:     static int            shmkeys = 10;

304:     PetscCall(PetscCalloc(sizeof(struct _PetscShmgetAllocation), &allocation));
305:     allocation->shmkey = shmkeys++;
306:     allocation->sz     = sz * asz;
307:     allocation->shmid  = shmget(allocation->shmkey, allocation->sz, 0666 | IPC_CREAT);
308:     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));
309:     allocation->addr = shmat(allocation->shmid, NULL, 0);
310:     PetscCheck(allocation->addr, PETSC_COMM_SELF, PETSC_ERR_LIB, "Unable to shmat() of shmid %d %s", allocation->shmid, strerror(errno));
311:   #if PETSC_SIZEOF_VOID_P == 8
312:     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));
313:   #endif

315:     if (!allocations) allocations = allocation;
316:     else {
317:       PetscShmgetAllocation next = allocations;
318:       while (next->next) next = next->next;
319:       next->next = allocation;
320:     }
321:     *addr = allocation->addr;
322:     PetscCall(PetscInfo(NULL, "Allocating PCMPI Server array %p shmkey %d shmid %d size %d\n", *addr, allocation->shmkey, allocation->shmid, (int)allocation->sz));
323:   }
324: #endif
325:   PetscFunctionReturn(PETSC_SUCCESS);
326: }

328: /*@C
329:   PetscShmgetDeallocateArray - deallocates shared memory accessible by all MPI processes in the server obtained with `PetscShmgetAllocateArray()`

331:   Not Collective, only called on the first MPI process

333:   Input Parameter:
334: . addr - the address of array

336:   Level: developer

338:   Note:
339:   Uses `PetscFree()` if `PETSC_HAVE_SHMGET` is not defined or the MPI linear solver server is not running

341:   Fortran Note:
342:   The calling sequence is `PetscShmgetDeallocateArray[Scalar,Int](Petsc[Scalar,Int], pointer :: d1(:), ierr)`

344: .seealso: [](sec_pcmpi), `PCMPIServerBegin()`, `PCMPI`, `KSPCheckPCMPI()`, `PetscShmgetAllocateArray()`
345: @*/
346: PetscErrorCode PetscShmgetDeallocateArray(void *addr[])
347: {
348:   PetscFunctionBegin;
349:   if (!*addr) PetscFunctionReturn(PETSC_SUCCESS);
350:   if (!PCMPIServerUseShmget || !PCMPIServerActive || PCMPIServerInSolve) PetscCall(PetscFree(*addr));
351: #if defined(PETSC_HAVE_SHMGET)
352:   else {
353:     PetscShmgetAllocation next = allocations, previous = NULL;

355:     while (next) {
356:       if (next->addr == *addr) {
357:         PetscCall(PetscInfo(NULL, "Deallocating PCMPI Server array %p shmkey %d shmid %d size %d\n", *addr, next->shmkey, next->shmid, (int)next->sz));
358:         PetscCheck(!shmdt(next->addr), PETSC_COMM_SELF, PETSC_ERR_SYS, "Unable to shmdt() location %s, see PCMPIServerBegin()", strerror(errno));
359:         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));
360:         *addr = NULL;
361:         if (previous) previous->next = next->next;
362:         else allocations = next->next;
363:         PetscCall(PetscFree(next));
364:         PetscFunctionReturn(PETSC_SUCCESS);
365:       }
366:       previous = next;
367:       next     = next->next;
368:     }
369:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unable to locate PCMPI allocated shared memory address %p", *addr);
370:   }
371: #endif
372:   PetscFunctionReturn(PETSC_SUCCESS);
373: }

375: #if defined(PETSC_USE_FORTRAN_BINDINGS)
376: #include <petsc/private/ftnimpl.h>

378:   #if defined(PETSC_HAVE_FORTRAN_CAPS)
379:     #define petscshmgetallocatearrayscalar_   PETSCSHMGETALLOCATEARRAYSCALAR
380:     #define petscshmgetdeallocatearrayscalar_ PETSCSHMGETDEALLOCATEARRAYSCALAR
381:     #define petscshmgetallocatearrayint_      PETSCSHMGETALLOCATEARRAYINT
382:     #define petscshmgetdeallocatearrayint_    PETSCSHMGETDEALLOCATEARRAYINT
383:   #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
384:     #define petscshmgetallocatearrayscalar_   petscshmgetallocatearrayscalar
385:     #define petscshmgetdeallocatearrayscalar_ petscshmgetdeallocatearrayscalar
386:     #define petscshmgetallocatearrayint_      petscshmgetallocatearrayint
387:     #define petscshmgetdeallocatearrayint_    petscshmgetdeallocatearrayint
388:   #endif

390: PETSC_EXTERN void petscshmgetallocatearrayscalar_(PetscInt *start, PetscInt *len, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
391: {
392:   PetscScalar *aa;

394:   *ierr = PetscShmgetAllocateArray(*len, sizeof(PetscScalar), (void **)&aa);
395:   if (*ierr) return;
396:   *ierr = F90Array1dCreate(aa, MPIU_SCALAR, *start, *len, a PETSC_F90_2PTR_PARAM(ptrd));
397: }

399: PETSC_EXTERN void petscshmgetdeallocatearrayscalar_(F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
400: {
401:   PetscScalar *aa;

403:   *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&aa PETSC_F90_2PTR_PARAM(ptrd));
404:   if (*ierr) return;
405:   *ierr = PetscShmgetDeallocateArray((void **)&aa);
406:   if (*ierr) return;
407:   *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
408: }

410: PETSC_EXTERN void petscshmgetallocatearrayint_(PetscInt *start, PetscInt *len, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
411: {
412:   PetscInt *aa;

414:   *ierr = PetscShmgetAllocateArray(*len, sizeof(PetscInt), (void **)&aa);
415:   if (*ierr) return;
416:   *ierr = F90Array1dCreate(aa, MPIU_INT, *start, *len, a PETSC_F90_2PTR_PARAM(ptrd));
417: }

419: PETSC_EXTERN void petscshmgetdeallocatearrayint_(F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
420: {
421:   PetscInt *aa;

423:   *ierr = F90Array1dAccess(a, MPIU_INT, (void **)&aa PETSC_F90_2PTR_PARAM(ptrd));
424:   if (*ierr) return;
425:   *ierr = PetscShmgetDeallocateArray((void **)&aa);
426:   if (*ierr) return;
427:   *ierr = F90Array1dDestroy(a, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
428: }

430: #endif