Actual source code: mtr.c


  2: /*
  3:      Interface to malloc() and free(). This code allows for logging of memory usage and some error checking
  4: */
  5: #include <petsc/private/petscimpl.h>
  6: #include <petscviewer.h>
  7: #if defined(PETSC_HAVE_MALLOC_H)
  8:   #include <malloc.h>
  9: #endif

 11: /*
 12:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
 13: */
 14: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t, PetscBool, int, const char[], const char[], void **);
 15: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void *, int, const char[], const char[]);
 16: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t, int, const char[], const char[], void **);

 18: #define CLASSID_VALUE ((PetscClassId)0xf0e0d0c9)
 19: #define ALREADY_FREED ((PetscClassId)0x0f0e0d9c)

 21: /*  this is the header put at the beginning of each malloc() using for tracking allocated space and checking of allocated space heap */
 22: typedef struct _trSPACE {
 23:   size_t       size, rsize; /* Aligned size and requested size */
 24:   int          id;
 25:   int          lineno;
 26:   const char  *filename;
 27:   const char  *functionname;
 28:   PetscClassId classid;
 29: #if defined(PETSC_USE_DEBUG)
 30:   PetscStack stack;
 31: #endif
 32:   struct _trSPACE *next, *prev;
 33: } TRSPACE;

 35: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
 36:    It is sizeof(trSPACE) padded to be a multiple of PETSC_MEMALIGN.
 37: */
 38: #define HEADER_BYTES ((sizeof(TRSPACE) + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1))

 40: /* This union is used to insure that the block passed to the user retains
 41:    a minimum alignment of PETSC_MEMALIGN.
 42: */
 43: typedef union
 44: {
 45:   TRSPACE sp;
 46:   char    v[HEADER_BYTES];
 47: } TrSPACE;

 49: #define MAXTRMAXMEMS 50
 50: static size_t    TRallocated           = 0;
 51: static int       TRfrags               = 0;
 52: static TRSPACE  *TRhead                = NULL;
 53: static int       TRid                  = 0;
 54: static PetscBool TRdebugLevel          = PETSC_FALSE;
 55: static PetscBool TRdebugIinitializenan = PETSC_FALSE;
 56: static PetscBool TRrequestedSize       = PETSC_FALSE;
 57: static size_t    TRMaxMem              = 0;
 58: static int       NumTRMaxMems          = 0;
 59: static size_t    TRMaxMems[MAXTRMAXMEMS];
 60: static int       TRMaxMemsEvents[MAXTRMAXMEMS];
 61: /*
 62:       Arrays to log information on mallocs for PetscMallocView()
 63: */
 64: static int          PetscLogMallocMax       = 10000;
 65: static int          PetscLogMalloc          = -1;
 66: static size_t       PetscLogMallocThreshold = 0;
 67: static size_t      *PetscLogMallocLength;
 68: static const char **PetscLogMallocFile, **PetscLogMallocFunction;
 69: static int          PetscLogMallocTrace          = -1;
 70: static size_t       PetscLogMallocTraceThreshold = 0;
 71: static PetscViewer  PetscLogMallocTraceViewer    = NULL;

 73: /*@C
 74:    PetscMallocValidate - Test the memory for corruption.  This can be called at any time between `PetscInitialize()` and `PetscFinalize()`

 76:    Input Parameters:
 77: +  line - line number where call originated.
 78: .  function - name of function calling
 79: -  file - file where function is

 81:    Return value:
 82:    The number of errors detected.

 84:    Options Database Keys:.
 85: +  -malloc_test - turns this feature on when PETSc was not configured with --with-debugging=0
 86: -  -malloc_debug - turns this feature on anytime

 88:    Output Effect:
 89:    Error messages are written to stdout.

 91:    Level: advanced

 93:    Notes:
 94:     This is only run if `PetscMallocSetDebug()` has been called which is set by -malloc_test (if debugging is turned on) or -malloc_debug (any time)

 96:     You should generally use `CHKMEMQ` as a short cut for calling this  routine.

 98:     The Fortran calling sequence is simply `PetscMallocValidate(ierr)`

100:    No output is generated if there are no problems detected.

102:    Developers Note:
103:      Uses the flg TRdebugLevel (set as the first argument to `PetscMallocSetDebug()`) to determine if it should run

105: .seealso: `CHKMEMQ`
106: @*/
107: PetscErrorCode PetscMallocValidate(int line, const char function[], const char file[])
108: {
109:   TRSPACE      *head, *lasthead;
110:   char         *a;
111:   PetscClassId *nend;

113:   if (!TRdebugLevel) return 0;
114:   head     = TRhead;
115:   lasthead = NULL;
116:   if (head && head->prev) {
117:     (*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line);
118:     (*PetscErrorPrintf)("Root memory header %p has invalid back pointer %p\n", head, head->prev);
119:     return PETSC_ERR_MEMC;
120:   }
121:   while (head) {
122:     if (head->classid != CLASSID_VALUE) {
123:       (*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line);
124:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n", head);
125:       (*PetscErrorPrintf)("Probably write before beginning of or past end of array\n");
126:       if (lasthead) {
127:         a = (char *)(((TrSPACE *)head) + 1);
128:         (*PetscErrorPrintf)("Last intact block [id=%d(%.0f)] at address %p allocated in %s() at %s:%d\n", lasthead->id, (PetscLogDouble)lasthead->size, a, lasthead->functionname, lasthead->filename, lasthead->lineno);
129:       }
130:       abort();
131:       return PETSC_ERR_MEMC;
132:     }
133:     a    = (char *)(((TrSPACE *)head) + 1);
134:     nend = (PetscClassId *)(a + head->size);
135:     if (*nend != CLASSID_VALUE) {
136:       (*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line);
137:       if (*nend == ALREADY_FREED) {
138:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n", head->id, (PetscLogDouble)head->size, a);
139:         return PETSC_ERR_MEMC;
140:       } else {
141:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a);
142:         (*PetscErrorPrintf)("Memory originally allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
143:         return PETSC_ERR_MEMC;
144:       }
145:     }
146:     if (head->prev && head->prev != lasthead) {
147:       (*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line);
148:       (*PetscErrorPrintf)("Backpointer %p is invalid, should be %p\n", head->prev, lasthead);
149:       (*PetscErrorPrintf)("Previous memory originally allocated in %s() at %s:%d\n", lasthead->functionname, lasthead->filename, lasthead->lineno);
150:       (*PetscErrorPrintf)("Memory originally allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
151:       return PETSC_ERR_MEMC;
152:     }
153:     lasthead = head;
154:     head     = head->next;
155:   }
156:   return 0;
157: }

159: /*
160:     PetscTrMallocDefault - Malloc with tracing.

162:     Input Parameters:
163: +   a   - number of bytes to allocate
164: .   lineno - line number where used.  Use __LINE__ for this
165: -   filename  - file name where used.  Use __FILE__ for this

167:     Returns:
168:     double aligned pointer to requested storage, or null if not  available.
169:  */
170: PetscErrorCode PetscTrMallocDefault(size_t a, PetscBool clear, int lineno, const char function[], const char filename[], void **result)
171: {
172:   TRSPACE *head;
173:   char    *inew;
174:   size_t   nsize;

176:   /* Do not try to handle empty blocks */
177:   if (!a) {
178:     *result = NULL;
179:     return 0;
180:   }

182:   PetscMallocValidate(lineno, function, filename);

184:   nsize = (a + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1);
185:   PetscMallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), clear, lineno, function, filename, (void **)&inew);

187:   head = (TRSPACE *)inew;
188:   inew += sizeof(TrSPACE);

190:   if (TRhead) TRhead->prev = head;
191:   head->next   = TRhead;
192:   TRhead       = head;
193:   head->prev   = NULL;
194:   head->size   = nsize;
195:   head->rsize  = a;
196:   head->id     = TRid++;
197:   head->lineno = lineno;

199:   head->filename                  = filename;
200:   head->functionname              = function;
201:   head->classid                   = CLASSID_VALUE;
202:   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;

204:   TRallocated += TRrequestedSize ? head->rsize : head->size;
205:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
206:   if (PetscLogMemory) {
207:     PetscInt i;
208:     for (i = 0; i < NumTRMaxMems; i++) {
209:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
210:     }
211:   }
212:   TRfrags++;

214: #if defined(PETSC_USE_DEBUG)
215:   PetscStackCopy(&petscstack, &head->stack);
216:   head->stack.line[head->stack.currentsize - 2] = lineno;
217:   #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE)
218:   if (!clear && TRdebugIinitializenan) {
219:     size_t     i, n = a / sizeof(PetscReal);
220:     PetscReal *s = (PetscReal *)inew;
221:       /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */
222:     #if defined(PETSC_USE_REAL_SINGLE)
223:     int nas = 0x7F800002;
224:     #else
225:     PetscInt64 nas = 0x7FF0000000000002;
226:     #endif
227:     for (i = 0; i < n; i++) memcpy(s + i, &nas, sizeof(PetscReal));
228:   }
229:   #endif
230: #endif

232:   /*
233:          Allow logging of all mallocs made.
234:          TODO: Currently this memory is never freed, it should be freed during PetscFinalize()
235:   */
236:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
237:     if (!PetscLogMalloc) {
238:       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));

241:       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));

244:       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
246:     }
247:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
248:     PetscLogMallocFile[PetscLogMalloc]       = filename;
249:     PetscLogMallocFunction[PetscLogMalloc++] = function;
250:   }
251:   if (PetscLogMallocTrace > -1 && a >= PetscLogMallocTraceThreshold) PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Alloc %zu %s:%d (%s)\n", a, filename ? filename : "null", lineno, function ? function : "null");
252:   *result = (void *)inew;
253:   return 0;
254: }

256: /*
257:    PetscTrFreeDefault - Free with tracing.

259:    Input Parameters:
260: .   a    - pointer to a block allocated with PetscTrMalloc
261: .   lineno - line number where used.  Use __LINE__ for this
262: .   filename  - file name where used.  Use __FILE__ for this
263:  */
264: PetscErrorCode PetscTrFreeDefault(void *aa, int lineno, const char function[], const char filename[])
265: {
266:   char         *a = (char *)aa;
267:   TRSPACE      *head;
268:   char         *ahead;
269:   size_t        asize;
270:   PetscClassId *nend;

272:   /* Do not try to handle empty blocks */
273:   if (!a) return 0;

275:   PetscMallocValidate(lineno, function, filename);

277:   ahead = a;
278:   a     = a - sizeof(TrSPACE);
279:   head  = (TRSPACE *)a;

281:   if (head->classid != CLASSID_VALUE) {
282:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno);
283:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a);
284:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory");
285:   }
286:   nend = (PetscClassId *)(ahead + head->size);
287:   if (*nend != CLASSID_VALUE) {
288:     if (*nend == ALREADY_FREED) {
289:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno);
290:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE));
291:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
292:         (*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
293:       } else {
294:         (*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno);
295:       }
296:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed");
297:     } else {
298:       /* Damaged tail */
299:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno);
300:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a);
301:       (*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
302:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory");
303:     }
304:   }
305:   if (PetscLogMallocTrace > -1 && head->rsize >= PetscLogMallocTraceThreshold) {
306:     PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Free  %zu %s:%d (%s)\n", head->rsize, filename ? filename : "null", lineno, function ? function : "null");
307:   }
308:   /* Mark the location freed */
309:   *nend = ALREADY_FREED;
310:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
311:   if (lineno > 0 && lineno < 50000) {
312:     head->lineno       = lineno;
313:     head->filename     = filename;
314:     head->functionname = function;
315:   } else {
316:     head->lineno = -head->lineno;
317:   }
318:   asize = TRrequestedSize ? head->rsize : head->size;
320:   TRallocated -= asize;
321:   TRfrags--;
322:   if (head->prev) head->prev->next = head->next;
323:   else TRhead = head->next;

325:   if (head->next) head->next->prev = head->prev;
326:   PetscFreeAlign(a, lineno, function, filename);
327:   return 0;
328: }

330: /*
331:   PetscTrReallocDefault - Realloc with tracing.

333:   Input Parameters:
334: + len      - number of bytes to allocate
335: . lineno   - line number where used.  Use __LINE__ for this
336: . filename - file name where used.  Use __FILE__ for this
337: - result - original memory

339:   Output Parameter:
340: . result - double aligned pointer to requested storage, or null if not available.

342:   Level: developer

344: .seealso: `PetscTrMallocDefault()`, `PetscTrFreeDefault()`
345: */
346: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
347: {
348:   char         *a = (char *)*result;
349:   TRSPACE      *head;
350:   char         *ahead, *inew;
351:   PetscClassId *nend;
352:   size_t        nsize;

354:   /* Realloc requests zero space so just free the current space */
355:   if (!len) {
356:     PetscTrFreeDefault(*result, lineno, function, filename);
357:     *result = NULL;
358:     return 0;
359:   }
360:   /* If the orginal space was NULL just use the regular malloc() */
361:   if (!*result) {
362:     PetscTrMallocDefault(len, PETSC_FALSE, lineno, function, filename, result);
363:     return 0;
364:   }

366:   PetscMallocValidate(lineno, function, filename);

368:   ahead = a;
369:   a     = a - sizeof(TrSPACE);
370:   head  = (TRSPACE *)a;
371:   inew  = a;

373:   if (head->classid != CLASSID_VALUE) {
374:     (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno);
375:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a);
376:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory");
377:   }
378:   nend = (PetscClassId *)(ahead + head->size);
379:   if (*nend != CLASSID_VALUE) {
380:     if (*nend == ALREADY_FREED) {
381:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno);
382:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE));
383:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
384:         (*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
385:       } else {
386:         (*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno);
387:       }
388:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed");
389:     } else {
390:       /* Damaged tail */
391:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno);
392:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a);
393:       (*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno);
394:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory");
395:     }
396:   }

398:   /* remove original reference to the memory allocated from the PETSc debugging heap */
399:   TRallocated -= TRrequestedSize ? head->rsize : head->size;
400:   TRfrags--;
401:   if (head->prev) head->prev->next = head->next;
402:   else TRhead = head->next;
403:   if (head->next) head->next->prev = head->prev;

405:   nsize = (len + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1);
406:   PetscReallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), lineno, function, filename, (void **)&inew);

408:   head = (TRSPACE *)inew;
409:   inew += sizeof(TrSPACE);

411:   if (TRhead) TRhead->prev = head;
412:   head->next   = TRhead;
413:   TRhead       = head;
414:   head->prev   = NULL;
415:   head->size   = nsize;
416:   head->rsize  = len;
417:   head->id     = TRid++;
418:   head->lineno = lineno;

420:   head->filename                  = filename;
421:   head->functionname              = function;
422:   head->classid                   = CLASSID_VALUE;
423:   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;

425:   TRallocated += TRrequestedSize ? head->rsize : head->size;
426:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
427:   if (PetscLogMemory) {
428:     PetscInt i;
429:     for (i = 0; i < NumTRMaxMems; i++) {
430:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
431:     }
432:   }
433:   TRfrags++;

435: #if defined(PETSC_USE_DEBUG)
436:   PetscStackCopy(&petscstack, &head->stack);
437:   head->stack.line[head->stack.currentsize - 2] = lineno;
438: #endif

440:   /*
441:          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
442:          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
443:   */
444:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
445:     if (!PetscLogMalloc) {
446:       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));

449:       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));

452:       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
454:     }
455:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
456:     PetscLogMallocFile[PetscLogMalloc]       = filename;
457:     PetscLogMallocFunction[PetscLogMalloc++] = function;
458:   }
459:   *result = (void *)inew;
460:   return 0;
461: }

463: /*@C
464:     PetscMemoryView - Shows the amount of memory currently being used in a communicator.

466:     Collective

468:     Input Parameters:
469: +    viewer - the viewer that defines the communicator
470: -    message - string printed before values

472:     Options Database Keys:
473: +    -malloc_debug - have PETSc track how much memory it has allocated
474: .    -log_view_memory - print memory usage per event
475: -    -memory_view - during PetscFinalize() have this routine called

477:     Level: intermediate

479: .seealso: `PetscMallocDump()`, `PetscMemoryGetCurrentUsage()`, `PetscMemorySetGetMaximumUsage()`, `PetscMallocView()`
480:  @*/
481: PetscErrorCode PetscMemoryView(PetscViewer viewer, const char message[])
482: {
483:   PetscLogDouble allocated, allocatedmax, resident, residentmax, gallocated, gallocatedmax, gresident, gresidentmax, maxgallocated, maxgallocatedmax, maxgresident, maxgresidentmax;
484:   PetscLogDouble mingallocated, mingallocatedmax, mingresident, mingresidentmax;
485:   MPI_Comm       comm;

487:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
488:   PetscMallocGetCurrentUsage(&allocated);
489:   PetscMallocGetMaximumUsage(&allocatedmax);
490:   PetscMemoryGetCurrentUsage(&resident);
491:   PetscMemoryGetMaximumUsage(&residentmax);
492:   if (residentmax > 0) residentmax = PetscMax(resident, residentmax);
493:   PetscObjectGetComm((PetscObject)viewer, &comm);
494:   PetscViewerASCIIPrintf(viewer, "%s", message);
495:   if (resident && residentmax && allocated) {
496:     MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
497:     MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
498:     MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
499:     PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax);
500:     MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
501:     MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
502:     MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
503:     PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident);
504:     MPI_Reduce(&allocatedmax, &gallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
505:     MPI_Reduce(&allocatedmax, &maxgallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
506:     MPI_Reduce(&allocatedmax, &mingallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
507:     PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocatedmax, maxgallocatedmax, mingallocatedmax);
508:     MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
509:     MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
510:     MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
511:     PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated);
512:   } else if (resident && residentmax) {
513:     MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
514:     MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
515:     MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
516:     PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax);
517:     MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
518:     MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
519:     MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
520:     PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident);
521:   } else if (resident && allocated) {
522:     MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
523:     MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
524:     MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
525:     PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident);
526:     MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
527:     MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
528:     MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
529:     PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated);
530:     PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n");
531:   } else if (allocated) {
532:     MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm);
533:     MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm);
534:     MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm);
535:     PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated);
536:     PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n");
537:     PetscViewerASCIIPrintf(viewer, "OS cannot compute process memory\n");
538:   } else {
539:     PetscViewerASCIIPrintf(viewer, "Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
540:   }
541:   PetscViewerFlush(viewer);
542:   return 0;
543: }

545: /*@
546:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was allocated with `PetscMalloc()`

548:     Not Collective

550:     Output Parameters:
551: .   space - number of bytes currently allocated

553:     Level: intermediate

555: .seealso: `PetscMallocDump()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`,
556:           `PetscMemoryGetMaximumUsage()`
557:  @*/
558: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
559: {
560:   *space = (PetscLogDouble)TRallocated;
561:   return 0;
562: }

564: /*@
565:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was obtained with `PetscMalloc()` at any time
566:         during this run, the high water mark.

568:     Not Collective

570:     Output Parameters:
571: .   space - maximum number of bytes ever allocated at one time

573:     Level: intermediate

575: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`,
576:           `PetscMallocPushMaximumUsage()`
577:  @*/
578: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
579: {
580:   *space = (PetscLogDouble)TRMaxMem;
581:   return 0;
582: }

584: /*@
585:     PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event

587:     Not Collective

589:     Input Parameter:
590: .   event - an event id; this is just for error checking

592:     Level: developer

594: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`,
595:           `PetscMallocPopMaximumUsage()`
596:  @*/
597: PetscErrorCode PetscMallocPushMaximumUsage(int event)
598: {
599:   if (++NumTRMaxMems > MAXTRMAXMEMS) return 0;
600:   TRMaxMems[NumTRMaxMems - 1]       = TRallocated;
601:   TRMaxMemsEvents[NumTRMaxMems - 1] = event;
602:   return 0;
603: }

605: /*@
606:     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

608:     Not Collective

610:     Input Parameter:
611: .   event - an event id; this is just for error checking

613:     Output Parameter:
614: .   mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event

616:     Level: developer

618: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`,
619:           `PetscMallocPushMaximumUsage()`
620:  @*/
621: PetscErrorCode PetscMallocPopMaximumUsage(int event, PetscLogDouble *mu)
622: {
623:   *mu = 0;
624:   if (NumTRMaxMems-- > MAXTRMAXMEMS) return 0;
626:   *mu = TRMaxMems[NumTRMaxMems];
627:   return 0;
628: }

630: #if defined(PETSC_USE_DEBUG)
631: /*@C
632:    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to `PetscMalloc()` was used to obtain that memory

634:    Collective on `PETSC_COMM_WORLD`

636:    Input Parameter:
637: .    ptr - the memory location

639:    Output Parameter:
640: .    stack - the stack indicating where the program allocated this memory

642:    Level: intermediate

644: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`
645: @*/
646: PetscErrorCode PetscMallocGetStack(void *ptr, PetscStack **stack)
647: {
648:   TRSPACE *head;

650:   head   = (TRSPACE *)(((char *)ptr) - HEADER_BYTES);
651:   *stack = &head->stack;
652:   return 0;
653: }
654: #else
655: PetscErrorCode PetscMallocGetStack(void *ptr, void **stack)
656: {
657:   *stack = NULL;
658:   return 0;
659: }
660: #endif

662: /*@C
663:    PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
664:    printed is: size of space (in bytes), address of space, id of space,
665:    file in which space was allocated, and line number at which it was
666:    allocated.

668:    Not Collective

670:    Input Parameter:
671: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

673:    Options Database Key:
674: .  -malloc_dump <optional filename> - Dumps unfreed memory during call to `PetscFinalize()`

676:    Level: intermediate

678:    Fortran Note:
679:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
680:    The fp defaults to stdout.

682:    Notes:
683:      Uses `MPI_COMM_WORLD` to display rank, because this may be called in `PetscFinalize()` after `PETSC_COMM_WORLD` has been freed.

685:      When called in `PetscFinalize()` dumps only the allocations that have not been properly freed

687:      `PetscMallocView()` prints a list of all memory ever allocated

689: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMallocViewSet()`, `PetscMallocValidate()`
690: @*/
691: PetscErrorCode PetscMallocDump(FILE *fp)
692: {
693:   TRSPACE    *head;
694:   size_t      libAlloc = 0;
695:   PetscMPIInt rank;

697:   MPI_Comm_rank(MPI_COMM_WORLD, &rank);
698:   if (!fp) fp = PETSC_STDOUT;
699:   head = TRhead;
700:   while (head) {
701:     libAlloc += TRrequestedSize ? head->rsize : head->size;
702:     head = head->next;
703:   }
704:   if (TRallocated - libAlloc > 0) fprintf(fp, "[%d]Total space allocated %.0f bytes\n", rank, (PetscLogDouble)TRallocated);
705:   head = TRhead;
706:   while (head) {
707:     PetscBool isLib;

709:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
710:     if (!isLib) {
711:       fprintf(fp, "[%2d] %.0f bytes %s() at %s:%d\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size), head->functionname, head->filename, head->lineno);
712: #if defined(PETSC_USE_DEBUG)
713:       PetscStackPrint(&head->stack, fp);
714: #endif
715:     }
716:     head = head->next;
717:   }
718:   return 0;
719: }

721: /*@
722:     PetscMallocViewSet - Activates logging of all calls to `PetscMalloc()` with a minimum size to view

724:     Not Collective

726:     Input Parameter:
727: .   logmin - minimum allocation size to log, or `PETSC_DEFAULT`

729:     Options Database Key:
730: +  -malloc_view <optional filename> - Activates `PetscMallocView()` in `PetscFinalize()`
731: .  -malloc_view_threshold <min> - Sets a minimum size if -malloc_view is used
732: -  -log_view_memory - view the memory usage also with the -log_view option

734:     Level: advanced

736:     Notes:
737:     Must be called after `PetscMallocSetDebug()`

739:     Uses `MPI_COMM_WORLD` to determine rank because PETSc communicators may not be available

741: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocViewSet()`, `PetscMallocTraceSet()`, `PetscMallocValidate()`
742: @*/
743: PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
744: {
745:   PetscLogMalloc = 0;
746:   PetscMemorySetGetMaximumUsage();
747:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
748:   PetscLogMallocThreshold = (size_t)logmin;
749:   return 0;
750: }

752: /*@
753:     PetscMallocViewGet - Determine whether calls to `PetscMalloc()` are being logged

755:     Not Collective

757:     Output Parameter
758: .   logging - `PETSC_TRUE` if logging is active

760:     Options Database Key:
761: .  -malloc_view <optional filename> - Activates `PetscMallocView()`

763:     Level: advanced

765: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceGet()`
766: @*/
767: PetscErrorCode PetscMallocViewGet(PetscBool *logging)
768: {
769:   *logging = (PetscBool)(PetscLogMalloc >= 0);
770:   return 0;
771: }

773: /*@
774:   PetscMallocTraceSet - Trace all calls to `PetscMalloc()`

776:   Not Collective

778:   Input Parameters:
779: + viewer - The viewer to use for tracing, or NULL to use stdout
780: . active - Flag to activate or deactivate tracing
781: - logmin - The smallest memory size that will be logged

783:   Note:
784:   The viewer should not be collective.

786:   Level: advanced

788: .seealso: `PetscMallocTraceGet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`
789: @*/
790: PetscErrorCode PetscMallocTraceSet(PetscViewer viewer, PetscBool active, PetscLogDouble logmin)
791: {
792:   if (!active) {
793:     PetscLogMallocTrace = -1;
794:     return 0;
795:   }
796:   PetscLogMallocTraceViewer = !viewer ? PETSC_VIEWER_STDOUT_SELF : viewer;
797:   PetscLogMallocTrace       = 0;
798:   PetscMemorySetGetMaximumUsage();
799:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
800:   PetscLogMallocTraceThreshold = (size_t)logmin;
801:   return 0;
802: }

804: /*@
805:   PetscMallocTraceGet - Determine whether all calls to `PetscMalloc()` are being traced

807:   Not Collective

809:   Output Parameter:
810: . logging - `PETSC_TRUE` if logging is active

812:   Options Database Key:
813: . -malloc_view <optional filename> - Activates PetscMallocView()

815:   Level: advanced

817: .seealso: `PetscMallocTraceSet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`
818: @*/
819: PetscErrorCode PetscMallocTraceGet(PetscBool *logging)
820: {
821:   *logging = (PetscBool)(PetscLogMallocTrace >= 0);
822:   return 0;
823: }

825: /*@C
826:     PetscMallocView - Saves the log of all calls to `PetscMalloc()`; also calls
827:        `PetscMemoryGetMaximumUsage()`

829:     Not Collective

831:     Input Parameter:
832: .   fp - file pointer; or NULL

834:     Options Database Key:
835: .  -malloc_view <optional filename> - Activates `PetscMallocView()` in `PetscFinalize()`

837:     Level: advanced

839:    Fortran Note:
840:    The calling sequence in Fortran is PetscMallocView(integer ierr)
841:    The fp defaults to stdout.

843:    Notes:
844:      `PetscMallocDump()` dumps only the currently unfreed memory, this dumps all memory ever allocated

846:      `PetscMemoryView()` gives a brief summary of current memory usage

848: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocDump()`, `PetscMallocViewSet()`, `PetscMemoryView()`
849: @*/
850: PetscErrorCode PetscMallocView(FILE *fp)
851: {
852:   PetscInt       i, j, n, *perm;
853:   size_t        *shortlength;
854:   int           *shortcount, err;
855:   PetscMPIInt    rank;
856:   PetscBool      match;
857:   const char   **shortfunction;
858:   PetscLogDouble rss;

860:   MPI_Comm_rank(MPI_COMM_WORLD, &rank);
861:   err = fflush(fp);


866:   if (!fp) fp = PETSC_STDOUT;
867:   PetscMemoryGetMaximumUsage(&rss);
868:   if (rss) {
869:     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n", rank, (PetscLogDouble)TRMaxMem, rss);
870:   } else {
871:     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n", rank, (PetscLogDouble)TRMaxMem);
872:   }
873:   shortcount = (int *)malloc(PetscLogMalloc * sizeof(int));
875:   shortlength = (size_t *)malloc(PetscLogMalloc * sizeof(size_t));
877:   shortfunction = (const char **)malloc(PetscLogMalloc * sizeof(char *));
879:   for (i = 0, n = 0; i < PetscLogMalloc; i++) {
880:     for (j = 0; j < n; j++) {
881:       PetscStrcmp(shortfunction[j], PetscLogMallocFunction[i], &match);
882:       if (match) {
883:         shortlength[j] += PetscLogMallocLength[i];
884:         shortcount[j]++;
885:         goto foundit;
886:       }
887:     }
888:     shortfunction[n] = PetscLogMallocFunction[i];
889:     shortlength[n]   = PetscLogMallocLength[i];
890:     shortcount[n]    = 1;
891:     n++;
892:   foundit:;
893:   }

895:   perm = (PetscInt *)malloc(n * sizeof(PetscInt));
897:   for (i = 0; i < n; i++) perm[i] = i;
898:   PetscSortStrWithPermutation(n, (const char **)shortfunction, perm);

900:   (void)fprintf(fp, "[%d] Memory usage sorted by function\n", rank);
901:   for (i = 0; i < n; i++) (void)fprintf(fp, "[%d] %d %.0f %s()\n", rank, shortcount[perm[i]], (PetscLogDouble)shortlength[perm[i]], shortfunction[perm[i]]);
902:   free(perm);
903:   free(shortlength);
904:   free(shortcount);
905:   free((char **)shortfunction);
906:   err = fflush(fp);
908:   return 0;
909: }

911: /* ---------------------------------------------------------------------------- */

913: /*@
914:     PetscMallocSetDebug - Set's PETSc memory debugging

916:     Not Collective

918:     Input Parameters:
919: +   eachcall - checks the entire heap of allocated memory for issues on each call to `PetscMalloc()` and `PetscFree()`, slow
920: -   initializenan - initializes all memory with NaN to catch use of uninitialized floating point arrays

922:     Options Database Keys:
923: +   -malloc_debug <true or false> - turns on or off debugging
924: .   -malloc_test - turns on all debugging if PETSc was configured with debugging including -malloc_dump, otherwise ignored
925: .   -malloc_view_threshold t - log only allocations larger than t
926: .   -malloc_dump <filename> - print a list of all memory that has not been freed
927: .   -malloc no - (deprecated) same as -malloc_debug no
928: -   -malloc_log - (deprecated) same as -malloc_view

930:    Level: developer

932:     Note:
933:     This is called in `PetscInitialize()` and should not be called elsewhere

935: .seealso: `CHKMEMQ()`, `PetscMallocValidate()`, `PetscMallocGetDebug()`
936: @*/
937: PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
938: {
940:   PetscMallocSet(PetscTrMallocDefault, PetscTrFreeDefault, PetscTrReallocDefault);

942:   TRallocated           = 0;
943:   TRfrags               = 0;
944:   TRhead                = NULL;
945:   TRid                  = 0;
946:   TRdebugLevel          = eachcall;
947:   TRMaxMem              = 0;
948:   PetscLogMallocMax     = 10000;
949:   PetscLogMalloc        = -1;
950:   TRdebugIinitializenan = initializenan;
951:   return 0;
952: }

954: /*@
955:     PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.

957:     Not Collective

959:     Output Parameters:
960: +    basic - doing basic debugging
961: .    eachcall - checks the entire memory heap at each `PetscMalloc()`/`PetscFree()`
962: -    initializenan - initializes memory with NaN

964:    Level: intermediate

966:    Note:
967:      By default, the debug version always does some debugging unless you run with -malloc_debug no

969: .seealso: `CHKMEMQ()`, `PetscMallocValidate()`, `PetscMallocSetDebug()`
970: @*/
971: PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
972: {
973:   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
974:   if (eachcall) *eachcall = TRdebugLevel;
975:   if (initializenan) *initializenan = TRdebugIinitializenan;
976:   return 0;
977: }

979: /*@
980:   PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size

982:   Not Collective

984:   Input Parameter:
985: . flg - `PETSC_TRUE` to log the requested memory size

987:   Options Database Key:
988: . -malloc_requested_size <bool> - Sets this flag

990:   Level: developer

992: .seealso: `PetscMallocLogRequestedSizeGet()`, `PetscMallocViewSet()`
993: @*/
994: PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg)
995: {
996:   TRrequestedSize = flg;
997:   return 0;
998: }

1000: /*@
1001:   PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size

1003:   Not Collective

1005:   Output Parameter:
1006: . flg - `PETSC_TRUE` if we log the requested memory size

1008:   Level: developer

1010: .seealso: `PetscMallocLogRequestedSizeSetinalSizeSet()`, `PetscMallocViewSet()`
1011: @*/
1012: PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg)
1013: {
1014:   *flg = TRrequestedSize;
1015:   return 0;
1016: }