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) && !defined(PETSC_HAVE_THREADSAFETY)
 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:    Level: advanced

 90:    Notes:
 91:    Error messages are written to `stdout`.

 93:    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)

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

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

 99:    Fortran Note:
100:     The Fortran calling sequence is simply `PetscMallocValidate(ierr)`

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

105: .seealso: `CHKMEMQ`, `PetscMalloc()`, `PetscFree()`, `PetscMallocSetDebug()`
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 PETSC_SUCCESS;
114:   head     = TRhead;
115:   lasthead = NULL;
116:   if (head && head->prev) {
117:     PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line));
118:     PetscCall((*PetscErrorPrintf)("Root memory header %p has invalid back pointer %p\n", (void *)head, (void *)head->prev));
119:     return PETSC_ERR_MEMC;
120:   }
121:   while (head) {
122:     if (head->classid != CLASSID_VALUE) {
123:       PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line));
124:       PetscCall((*PetscErrorPrintf)("Memory at address %p is corrupted\n", (void *)head));
125:       PetscCall((*PetscErrorPrintf)("Probably write before beginning of or past end of array\n"));
126:       if (lasthead) {
127:         a = (char *)(((TrSPACE *)head) + 1);
128:         PetscCall((*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:       PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line));
137:       if (*nend == ALREADY_FREED) {
138:         PetscCall((*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:         PetscCall((*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a));
142:         PetscCall((*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:       PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line));
148:       PetscCall((*PetscErrorPrintf)("Backpointer %p is invalid, should be %p\n", (void *)head->prev, (void *)lasthead));
149:       PetscCall((*PetscErrorPrintf)("Previous memory originally allocated in %s() at %s:%d\n", lasthead->functionname, lasthead->filename, lasthead->lineno));
150:       PetscCall((*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 PETSC_SUCCESS;
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:     Output Parameter:
168:     double aligned pointer to requested storage
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:   PetscFunctionBegin;
177:   /* Do not try to handle empty blocks */
178:   if (!a) {
179:     *result = NULL;
180:     PetscFunctionReturn(PETSC_SUCCESS);
181:   }

183:   PetscCall(PetscMallocValidate(lineno, function, filename));

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

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

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

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

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

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

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

243:       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
244:       PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");

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

258: /*
259:    PetscTrFreeDefault - Free with tracing.

261:    Input Parameters:
262: +   a    - pointer to a block allocated with `PetscTrMallocDefault()`
263: .   lineno - line number where used.  Use `__LINE__` for this
264: -   filename  - file name where used.  Use `__FILE__` for this

266:   Level: developer
267:  */
268: PetscErrorCode PetscTrFreeDefault(void *aa, int lineno, const char function[], const char filename[])
269: {
270:   char         *a = (char *)aa;
271:   TRSPACE      *head;
272:   char         *ahead;
273:   size_t        asize;
274:   PetscClassId *nend;

276:   PetscFunctionBegin;
277:   /* Do not try to handle empty blocks */
278:   if (!a) PetscFunctionReturn(PETSC_SUCCESS);

280:   PetscCall(PetscMallocValidate(lineno, function, filename));

282:   ahead = a;
283:   a     = a - sizeof(TrSPACE);
284:   head  = (TRSPACE *)a;

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

330:   if (head->next) head->next->prev = head->prev;
331:   PetscCall(PetscFreeAlign(a, lineno, function, filename));
332:   PetscFunctionReturn(PETSC_SUCCESS);
333: }

335: /*
336:   PetscTrReallocDefault - Realloc with tracing.

338:   Input Parameters:
339: + len      - number of bytes to allocate
340: . lineno   - line number where used.  Use `__LINE__` for this
341: . filename - file name where used.  Use `__FILE__` for this
342: - result - original memory

344:   Output Parameter:
345: . result - double aligned pointer to requested storage

347:   Level: developer

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

359:   PetscFunctionBegin;
360:   /* Realloc requests zero space so just free the current space */
361:   if (!len) {
362:     PetscCall(PetscTrFreeDefault(*result, lineno, function, filename));
363:     *result = NULL;
364:     PetscFunctionReturn(PETSC_SUCCESS);
365:   }
366:   /* If the original space was NULL just use the regular malloc() */
367:   if (!*result) {
368:     PetscCall(PetscTrMallocDefault(len, PETSC_FALSE, lineno, function, filename, result));
369:     PetscFunctionReturn(PETSC_SUCCESS);
370:   }

372:   PetscCall(PetscMallocValidate(lineno, function, filename));

374:   ahead = a;
375:   a     = a - sizeof(TrSPACE);
376:   head  = (TRSPACE *)a;
377:   inew  = a;

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

404:   /* remove original reference to the memory allocated from the PETSc debugging heap */
405:   TRallocated -= TRrequestedSize ? head->rsize : head->size;
406:   TRfrags--;
407:   if (head->prev) head->prev->next = head->next;
408:   else TRhead = head->next;
409:   if (head->next) head->next->prev = head->prev;

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

414:   head = (TRSPACE *)inew;
415:   inew += sizeof(TrSPACE);

417:   if (TRhead) TRhead->prev = head;
418:   head->next   = TRhead;
419:   TRhead       = head;
420:   head->prev   = NULL;
421:   head->size   = nsize;
422:   head->rsize  = len;
423:   head->id     = TRid++;
424:   head->lineno = lineno;

426:   head->filename                  = filename;
427:   head->functionname              = function;
428:   head->classid                   = CLASSID_VALUE;
429:   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;

431:   TRallocated += TRrequestedSize ? head->rsize : head->size;
432:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
433:   if (PetscLogMemory) {
434:     PetscInt i;
435:     for (i = 0; i < NumTRMaxMems; i++) {
436:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
437:     }
438:   }
439:   TRfrags++;

441: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
442:   PetscCall(PetscStackCopy(&petscstack, &head->stack));
443:   /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */
444:   head->stack.line[head->stack.currentsize - 2] = lineno;
445: #endif

447:   /*
448:          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
449:          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
450:   */
451:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
452:     if (!PetscLogMalloc) {
453:       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));
454:       PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");

456:       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
457:       PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");

459:       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
460:       PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
461:     }
462:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
463:     PetscLogMallocFile[PetscLogMalloc]       = filename;
464:     PetscLogMallocFunction[PetscLogMalloc++] = function;
465:   }
466:   *result = (void *)inew;
467:   PetscFunctionReturn(PETSC_SUCCESS);
468: }

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

473:     Collective

475:     Input Parameters:
476: +    viewer - the viewer to output the information on
477: -    message - string printed before values

479:     Options Database Keys:
480: +    -malloc_debug - have PETSc track how much memory it has allocated
481: .    -log_view_memory - print memory usage per event when `-log_view` is used
482: -    -memory_view - during `PetscFinalize()` have this routine called

484:     Level: intermediate

486: .seealso: `PetscMallocDump()`, `PetscMemoryGetCurrentUsage()`, `PetscMemorySetGetMaximumUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
487:  @*/
488: PetscErrorCode PetscMemoryView(PetscViewer viewer, const char message[])
489: {
490:   PetscLogDouble allocated, allocatedmax, resident, residentmax, gallocated, gallocatedmax, gresident, gresidentmax, maxgallocated, maxgallocatedmax, maxgresident, maxgresidentmax;
491:   PetscLogDouble mingallocated, mingallocatedmax, mingresident, mingresidentmax;
492:   MPI_Comm       comm;

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

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

556:     Not Collective

558:     Output Parameter:
559: .   space - number of bytes currently allocated

561:     Level: intermediate

563: .seealso: `PetscMallocDump()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
564:           `PetscMemoryGetMaximumUsage()`
565:  @*/
566: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
567: {
568:   PetscFunctionBegin;
569:   *space = (PetscLogDouble)TRallocated;
570:   PetscFunctionReturn(PETSC_SUCCESS);
571: }

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

577:     Not Collective

579:     Output Parameter:
580: .   space - maximum number of bytes ever allocated at one time

582:     Level: intermediate

584: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
585:           `PetscMallocPushMaximumUsage()`
586:  @*/
587: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
588: {
589:   PetscFunctionBegin;
590:   *space = (PetscLogDouble)TRMaxMem;
591:   PetscFunctionReturn(PETSC_SUCCESS);
592: }

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

597:     Not Collective

599:     Input Parameter:
600: .   event - an event id; this is just for error checking

602:     Level: developer

604: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
605:           `PetscMallocPopMaximumUsage()`
606:  @*/
607: PetscErrorCode PetscMallocPushMaximumUsage(int event)
608: {
609:   PetscFunctionBegin;
610:   if (++NumTRMaxMems > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
611:   TRMaxMems[NumTRMaxMems - 1]       = TRallocated;
612:   TRMaxMemsEvents[NumTRMaxMems - 1] = event;
613:   PetscFunctionReturn(PETSC_SUCCESS);
614: }

616: /*@
617:     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

619:     Not Collective

621:     Input Parameter:
622: .   event - an event id; this is just for error checking

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

627:     Level: developer

629: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
630:           `PetscMallocPushMaximumUsage()`
631:  @*/
632: PetscErrorCode PetscMallocPopMaximumUsage(int event, PetscLogDouble *mu)
633: {
634:   PetscFunctionBegin;
635:   *mu = 0;
636:   if (NumTRMaxMems-- > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
637:   PetscCheck(TRMaxMemsEvents[NumTRMaxMems] == event, PETSC_COMM_SELF, PETSC_ERR_MEMC, "PetscMallocPush/PopMaximumUsage() are not nested");
638:   *mu = TRMaxMems[NumTRMaxMems];
639:   PetscFunctionReturn(PETSC_SUCCESS);
640: }

642: /*@C
643:    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to `PetscMalloc()` was used to obtain that memory

645:    Not Collective

647:    Input Parameter:
648: .    ptr - the memory location

650:    Output Parameter:
651: .    stack - the stack indicating where the program allocated this memory

653:    Level: intermediate

655: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
656: @*/
657: PetscErrorCode PetscMallocGetStack(void *ptr, PetscStack **stack)
658: {
659: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
660:   TRSPACE *head;

662:   PetscFunctionBegin;
663:   head   = (TRSPACE *)(((char *)ptr) - HEADER_BYTES);
664:   *stack = &head->stack;
665:   PetscFunctionReturn(PETSC_SUCCESS);
666: #else
667:   *stack = NULL;
668:   return PETSC_SUCCESS;
669: #endif
670: }

672: /*@C
673:    PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
674:    printed is: size of space (in bytes), address of space, id of space,
675:    file in which space was allocated, and line number at which it was
676:    allocated.

678:    Not Collective

680:    Input Parameter:
681: .  fp  - file pointer.  If `fp` is `NULL`, `stdout` is assumed.

683:    Options Database Key:
684: .  -malloc_dump <optional filename> - Print summary of unfreed memory during call to `PetscFinalize()`, writing to filename if given

686:    Level: intermediate

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

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

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

695:    Fortran Note:
696:    The calling sequence is `PetscMallocDump`(PetscErrorCode ierr). A `fp` parameter is not supported.

698: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMallocViewSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()`
699: @*/
700: PetscErrorCode PetscMallocDump(FILE *fp)
701: {
702:   TRSPACE    *head;
703:   size_t      libAlloc = 0;
704:   PetscMPIInt rank;

706:   PetscFunctionBegin;
707:   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
708:   if (!fp) fp = PETSC_STDOUT;
709:   head = TRhead;
710:   while (head) {
711:     libAlloc += TRrequestedSize ? head->rsize : head->size;
712:     head = head->next;
713:   }
714:   if (TRallocated - libAlloc > 0) fprintf(fp, "[%d]Total space allocated %.0f bytes\n", rank, (PetscLogDouble)TRallocated);
715:   head = TRhead;
716:   while (head) {
717:     PetscBool isLib;

719:     PetscCall(PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib));
720:     if (!isLib) {
721:       fprintf(fp, "[%2d] %.0f bytes %s() at %s:%d\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size), head->functionname, head->filename, head->lineno);
722: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
723:       PetscCall(PetscStackPrint(&head->stack, fp));
724: #endif
725:     }
726:     head = head->next;
727:   }
728:   PetscFunctionReturn(PETSC_SUCCESS);
729: }

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

734:     Not Collective

736:     Input Parameter:
737: .   logmin - minimum allocation size to log, or `PETSC_DEFAULT` to log all memory allocations

739:     Options Database Keys:
740: +  -malloc_view <optional filename> - Activates `PetscMallocView()` in `PetscFinalize()`
741: .  -malloc_view_threshold <min> - Sets a minimum size if -malloc_view is used
742: -  -log_view_memory - view the memory usage also with the -log_view option

744:     Level: advanced

746:     Note:
747:     Must be called after `PetscMallocSetDebug()`

749:     Developer Note:
750:     Uses `MPI_COMM_WORLD` to determine rank because PETSc communicators may not be available

752: .seealso: `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()`
753: @*/
754: PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
755: {
756:   PetscFunctionBegin;
757:   PetscLogMalloc = 0;
758:   PetscCall(PetscMemorySetGetMaximumUsage());
759:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
760:   PetscLogMallocThreshold = (size_t)logmin;
761:   PetscFunctionReturn(PETSC_SUCCESS);
762: }

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

767:     Not Collective

769:     Output Parameter
770: .   logging - `PETSC_TRUE` if logging is active

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

775:     Level: advanced

777: .seealso: `PetscMallocViewSet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceGet()`, `PetscMalloc()`, `PetscFree()`
778: @*/
779: PetscErrorCode PetscMallocViewGet(PetscBool *logging)
780: {
781:   PetscFunctionBegin;
782:   *logging = (PetscBool)(PetscLogMalloc >= 0);
783:   PetscFunctionReturn(PETSC_SUCCESS);
784: }

786: /*@
787:   PetscMallocTraceSet - Trace all calls to `PetscMalloc()`

789:   Not Collective

791:   Input Parameters:
792: + viewer - The viewer to use for tracing, or `NULL` to use `PETSC_VIEWER_STDOUT_SELF`
793: . active - Flag to activate or deactivate tracing
794: - logmin - The smallest memory size that will be logged

796:   Level: advanced

798:   Note:
799:   The viewer should not be collective.

801: .seealso: `PetscMallocTraceGet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
802: @*/
803: PetscErrorCode PetscMallocTraceSet(PetscViewer viewer, PetscBool active, PetscLogDouble logmin)
804: {
805:   PetscFunctionBegin;
806:   if (!active) {
807:     PetscLogMallocTrace = -1;
808:     PetscFunctionReturn(PETSC_SUCCESS);
809:   }
810:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
812:   PetscLogMallocTraceViewer = viewer;
813:   PetscLogMallocTrace       = 0;
814:   PetscCall(PetscMemorySetGetMaximumUsage());
815:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
816:   PetscLogMallocTraceThreshold = (size_t)logmin;
817:   PetscFunctionReturn(PETSC_SUCCESS);
818: }

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

823:   Not Collective

825:   Output Parameter:
826: . logging - `PETSC_TRUE` if logging is active

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

831:   Level: advanced

833: .seealso: `PetscMallocTraceSet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
834: @*/
835: PetscErrorCode PetscMallocTraceGet(PetscBool *logging)
836: {
837:   PetscFunctionBegin;
838:   *logging = (PetscBool)(PetscLogMallocTrace >= 0);
839:   PetscFunctionReturn(PETSC_SUCCESS);
840: }

842: /*@C
843:     PetscMallocView - Saves the log of all calls to `PetscMalloc()`; also calls
844:        `PetscMemoryGetMaximumUsage()`

846:     Not Collective

848:     Input Parameter:
849: .   fp - file pointer; or `NULL`

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

854:     Level: advanced

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

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

861:    Fortran Notes:
862:    The calling sequence in Fortran is `PetscMallocView`(integer ierr)

864: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocDump()`, `PetscMallocViewSet()`, `PetscMemoryView()`, `PetscMalloc()`, `PetscFree()`
865: @*/
866: PetscErrorCode PetscMallocView(FILE *fp)
867: {
868:   PetscInt       i, j, n, *perm;
869:   size_t        *shortlength;
870:   int           *shortcount;
871:   PetscMPIInt    rank;
872:   PetscBool      match;
873:   const char   **shortfunction;
874:   PetscLogDouble rss;

876:   PetscFunctionBegin;
877:   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
878:   PetscCall(PetscFFlush(fp));

880:   PetscCheck(PetscLogMalloc >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscMallocView() called without call to PetscMallocViewSet() this is often due to\n                      setting the option -malloc_view AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");

882:   if (!fp) fp = PETSC_STDOUT;
883:   PetscCall(PetscMemoryGetMaximumUsage(&rss));
884:   if (rss) {
885:     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n", rank, (PetscLogDouble)TRMaxMem, rss);
886:   } else {
887:     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n", rank, (PetscLogDouble)TRMaxMem);
888:   }
889:   if (PetscLogMalloc > 0) {
890:     shortcount = (int *)malloc(PetscLogMalloc * sizeof(int));
891:     PetscCheck(shortcount, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
892:     shortlength = (size_t *)malloc(PetscLogMalloc * sizeof(size_t));
893:     PetscCheck(shortlength, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
894:     shortfunction = (const char **)malloc(PetscLogMalloc * sizeof(char *));
895:     PetscCheck(shortfunction, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
896:     for (i = 0, n = 0; i < PetscLogMalloc; i++) {
897:       for (j = 0; j < n; j++) {
898:         PetscCall(PetscStrcmp(shortfunction[j], PetscLogMallocFunction[i], &match));
899:         if (match) {
900:           shortlength[j] += PetscLogMallocLength[i];
901:           shortcount[j]++;
902:           goto foundit;
903:         }
904:       }
905:       shortfunction[n] = PetscLogMallocFunction[i];
906:       shortlength[n]   = PetscLogMallocLength[i];
907:       shortcount[n]    = 1;
908:       n++;
909:     foundit:;
910:     }

912:     perm = (PetscInt *)malloc(n * sizeof(PetscInt));
913:     PetscCheck(perm, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
914:     for (i = 0; i < n; i++) perm[i] = i;
915:     PetscCall(PetscSortStrWithPermutation(n, (const char **)shortfunction, perm));

917:     (void)fprintf(fp, "[%d] Memory usage sorted by function\n", rank);
918:     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]]);
919:     free(perm);
920:     free(shortlength);
921:     free(shortcount);
922:     free((char **)shortfunction);
923:   }
924:   PetscCall(PetscFFlush(fp));
925:   PetscFunctionReturn(PETSC_SUCCESS);
926: }

928: /*@
929:     PetscMallocSetDebug - Set's PETSc memory debugging

931:     Not Collective

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

937:     Options Database Keys:
938: +   -malloc_debug <true or false> - turns on or off debugging
939: .   -malloc_test - turns on all debugging if PETSc was configured with debugging including `-malloc_dump`, otherwise ignored
940: .   -malloc_view_threshold t - log only allocations larger than t
941: .   -malloc_dump <filename> - print a list of all memory that has not been freed
942: .   -malloc no - (deprecated) same as `-malloc_debug no`
943: -   -malloc_log - (deprecated) same as `-malloc_view`

945:    Level: developer

947:     Note:
948:     This is called in `PetscInitialize()` and should not be called elsewhere

950: .seealso: `CHKMEMQ()`, `PetscMallocValidate()`, `PetscMallocGetDebug()`, `PetscMalloc()`, `PetscFree()`
951: @*/
952: PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
953: {
954:   PetscFunctionBegin;
955:   PetscCheck(PetscTrMalloc != PetscTrMallocDefault, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Cannot call this routine more than once, it can only be called in PetscInitialize()");
956:   PetscCall(PetscMallocSet(PetscTrMallocDefault, PetscTrFreeDefault, PetscTrReallocDefault));

958:   TRallocated           = 0;
959:   TRfrags               = 0;
960:   TRhead                = NULL;
961:   TRid                  = 0;
962:   TRdebugLevel          = eachcall;
963:   TRMaxMem              = 0;
964:   PetscLogMallocMax     = 10000;
965:   PetscLogMalloc        = -1;
966:   TRdebugIinitializenan = initializenan;
967:   PetscFunctionReturn(PETSC_SUCCESS);
968: }

970: /*@
971:     PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.

973:     Not Collective

975:     Output Parameters:
976: +    basic - doing basic debugging
977: .    eachcall - checks the entire memory heap at each `PetscMalloc()`/`PetscFree()`
978: -    initializenan - initializes memory with `NaN`

980:    Level: intermediate

982:    Note:
983:      By default, the debug version always does some debugging unless you run with `-malloc_debug no`

985: .seealso: `CHKMEMQ()`, `PetscMallocValidate()`, `PetscMallocSetDebug()`, `PetscMalloc()`, `PetscFree()`
986: @*/
987: PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
988: {
989:   PetscFunctionBegin;
990:   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
991:   if (eachcall) *eachcall = TRdebugLevel;
992:   if (initializenan) *initializenan = TRdebugIinitializenan;
993:   PetscFunctionReturn(PETSC_SUCCESS);
994: }

996: /*@
997:   PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size

999:   Not Collective

1001:   Input Parameter:
1002: . flg - `PETSC_TRUE` to log the requested memory size

1004:   Options Database Key:
1005: . -malloc_requested_size <bool> - Sets this flag

1007:   Level: developer

1009: .seealso: `PetscMallocLogRequestedSizeGet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1010: @*/
1011: PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg)
1012: {
1013:   PetscFunctionBegin;
1014:   TRrequestedSize = flg;
1015:   PetscFunctionReturn(PETSC_SUCCESS);
1016: }

1018: /*@
1019:   PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size

1021:   Not Collective

1023:   Output Parameter:
1024: . flg - `PETSC_TRUE` if we log the requested memory size

1026:   Level: developer

1028: .seealso: `PetscMallocLogRequestedSizeSet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1029: @*/
1030: PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg)
1031: {
1032:   PetscFunctionBegin;
1033:   *flg = TRrequestedSize;
1034:   PetscFunctionReturn(PETSC_SUCCESS);
1035: }