Actual source code: mtr.c

  1: /*
  2:      Logging of memory usage and some error checking
  3: */
  4: #include <petsc/private/petscimpl.h>
  5: #include <petscviewer.h>
  6: #if defined(PETSC_HAVE_MALLOC_H)
  7:   #include <malloc.h>
  8: #endif

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

 17: #define COOKIE_VALUE  -253701943
 18: #define ALREADY_FREED 252579228

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

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

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

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

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

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

 80:   Options Database Keys:
 81: + -malloc_test  - turns this feature on when PETSc was not configured with `--with-debugging=0`
 82: - -malloc_debug - turns this feature on anytime

 84:   Level: advanced

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

 89:   Error messages are written to `stdout`.

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

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

 95:   Fortran Notes:
 96:   The Fortran calling sequence is simply `PetscMallocValidate(ierr)`

 98: .seealso: `CHKMEMQ`, `PetscMalloc()`, `PetscFree()`, `PetscMallocSetDebug()`
 99: @*/
100: PetscErrorCode PetscMallocValidate(int line, const char function[], const char file[])
101: {
102:   TRSPACE  *head, *lasthead;
103:   char     *a;
104:   PetscInt *nend;

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

156: /*
157:     PetscTrMallocDefault - Malloc with logging and error checking

159: */
160: static PetscErrorCode PetscTrMallocDefault(size_t a, PetscBool clear, int lineno, const char function[], const char filename[], void **result)
161: {
162:   TRSPACE *head;
163:   char    *inew;
164:   size_t   nsize;

166:   PetscFunctionBegin;
167:   if (!a) {
168:     *result = NULL;
169:     PetscFunctionReturn(PETSC_SUCCESS);
170:   }

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

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

177:   head = (TRSPACE *)inew;
178:   inew += sizeof(TrSPACE);

180:   if (TRhead) TRhead->prev = head;
181:   head->next   = TRhead;
182:   TRhead       = head;
183:   head->prev   = NULL;
184:   head->size   = nsize;
185:   head->rsize  = a;
186:   head->id     = TRid++;
187:   head->lineno = lineno;

189:   head->filename              = filename;
190:   head->functionname          = function;
191:   head->specialcookie         = COOKIE_VALUE;
192:   *(PetscInt *)(inew + nsize) = COOKIE_VALUE;

194:   TRallocated += TRrequestedSize ? head->rsize : head->size;
195:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
196:   if (PetscLogMemory) {
197:     for (PetscInt i = 0; i < NumTRMaxMems; i++) {
198:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
199:     }
200:   }
201:   TRfrags++;

203: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
204:   PetscCall(PetscStackCopy(&petscstack, &head->stack));
205:   /* fix the line number to where PetscTrMallocDefault() was called, not the PetscFunctionBegin; */
206:   head->stack.line[PetscMax(head->stack.currentsize - 2, 0)] = lineno;
207:   head->stack.currentsize--;
208:   #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE)
209:   if (!clear && TRdebugIinitializenan) {
210:     size_t     n = a / sizeof(PetscReal);
211:     PetscReal *s = (PetscReal *)inew;
212:       /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */
213:     #if defined(PETSC_USE_REAL_SINGLE)
214:     int nas = 0x7F800002;
215:     #else
216:     PetscInt64 nas = 0x7FF0000000000002;
217:     #endif
218:     for (size_t i = 0; i < n; i++) memcpy(s + i, &nas, sizeof(PetscReal));
219:   }
220:   #endif
221: #endif

223:   /*
224:          Allow logging of all mallocs made.
225:          TODO: Currently this memory is never freed, it should be freed during PetscFinalize()
226:   */
227:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
228:     if (!PetscLogMalloc) {
229:       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));
230:       PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");

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

235:       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
236:       PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
237:     }
238:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
239:     PetscLogMallocFile[PetscLogMalloc]       = filename;
240:     PetscLogMallocFunction[PetscLogMalloc++] = function;
241:   }
242:   if (PetscLogMallocTrace > -1 && a >= PetscLogMallocTraceThreshold) PetscCall(PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Alloc %zu %s:%d (%s)\n", a, filename ? filename : "null", lineno, function ? function : "null"));
243:   *result = (void *)inew;
244:   PetscFunctionReturn(PETSC_SUCCESS);
245: }

247: /*
248:    PetscTrFreeDefault - Free with logging and error checking

250: */
251: static PetscErrorCode PetscTrFreeDefault(void *aa, int lineno, const char function[], const char filename[])
252: {
253:   char     *a = (char *)aa;
254:   TRSPACE  *head;
255:   char     *ahead;
256:   size_t    asize;
257:   PetscInt *nend;

259:   PetscFunctionBegin;
260:   if (!a) PetscFunctionReturn(PETSC_SUCCESS);

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

264:   ahead = a;
265:   a     = a - sizeof(TrSPACE);
266:   head  = (TRSPACE *)a;

268:   if (head->specialcookie != COOKIE_VALUE) {
269:     TRdebug = PETSC_FALSE;
270:     PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno));
271:     PetscCall((*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a));
272:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory");
273:   }
274:   nend = (PetscInt *)(ahead + head->size);
275:   if (*nend != COOKIE_VALUE) {
276:     TRdebug = PETSC_FALSE;
277:     if (*nend == ALREADY_FREED) {
278:       PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno));
279:       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE)));
280:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
281:         PetscCall((*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
282:       } else {
283:         PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno));
284:       }
285:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed");
286:     } else {
287:       /* Damaged tail */
288:       PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno));
289:       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a));
290:       PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
291:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory");
292:     }
293:   }
294:   if (PetscLogMallocTrace > -1 && head->rsize >= PetscLogMallocTraceThreshold) PetscCall(PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Free  %zu %s:%d (%s)\n", head->rsize, filename ? filename : "null", lineno, function ? function : "null"));
295:   *nend = ALREADY_FREED;
296:   /* Save location where freed.  If we suspect the line number, mark as allocated location */
297:   if (lineno > 0 && lineno < 50000) {
298:     head->lineno       = lineno;
299:     head->filename     = filename;
300:     head->functionname = function;
301:   } else {
302:     head->lineno = -head->lineno;
303:   }
304:   asize = TRrequestedSize ? head->rsize : head->size;
305:   PetscCheck(TRallocated >= asize, PETSC_COMM_SELF, PETSC_ERR_MEMC, "TRallocate is smaller than memory just freed");
306:   TRallocated -= asize;
307:   TRfrags--;
308:   if (head->prev) head->prev->next = head->next;
309:   else TRhead = head->next;

311:   if (head->next) head->next->prev = head->prev;
312:   PetscCall(PetscFreeAlign(a, lineno, function, filename));
313:   PetscFunctionReturn(PETSC_SUCCESS);
314: }

316: /*
317:   PetscTrReallocDefault - Realloc with logging and error checking

319: */
320: static PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
321: {
322:   char     *a = (char *)*result;
323:   TRSPACE  *head;
324:   char     *ahead, *inew;
325:   PetscInt *nend;
326:   size_t    nsize;

328:   PetscFunctionBegin;
329:   /* Realloc requests zero space so just free the current space */
330:   if (!len) {
331:     PetscCall(PetscTrFreeDefault(*result, lineno, function, filename));
332:     *result = NULL;
333:     PetscFunctionReturn(PETSC_SUCCESS);
334:   }
335:   /* If the original space was NULL just use the regular malloc() */
336:   if (!*result) {
337:     PetscCall(PetscTrMallocDefault(len, PETSC_FALSE, lineno, function, filename, result));
338:     PetscFunctionReturn(PETSC_SUCCESS);
339:   }

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

343:   ahead = a;
344:   a     = a - sizeof(TrSPACE);
345:   head  = (TRSPACE *)a;
346:   inew  = a;

348:   if (head->specialcookie != COOKIE_VALUE) {
349:     TRdebug = PETSC_FALSE;
350:     PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
351:     PetscCall((*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a));
352:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory");
353:   }
354:   nend = (PetscInt *)(ahead + head->size);
355:   if (*nend != COOKIE_VALUE) {
356:     TRdebug = PETSC_FALSE;
357:     if (*nend == ALREADY_FREED) {
358:       PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
359:       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE)));
360:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
361:         PetscCall((*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
362:       } else {
363:         PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno));
364:       }
365:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed");
366:     } else {
367:       /* Damaged tail */
368:       PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
369:       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a));
370:       PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
371:       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory");
372:     }
373:   }

375:   /* remove original reference to the memory allocated from the PETSc debugging heap */
376:   TRallocated -= TRrequestedSize ? head->rsize : head->size;
377:   TRfrags--;
378:   if (head->prev) head->prev->next = head->next;
379:   else TRhead = head->next;
380:   if (head->next) head->next->prev = head->prev;

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

385:   head = (TRSPACE *)inew;
386:   inew += sizeof(TrSPACE);

388:   if (TRhead) TRhead->prev = head;
389:   head->next   = TRhead;
390:   TRhead       = head;
391:   head->prev   = NULL;
392:   head->size   = nsize;
393:   head->rsize  = len;
394:   head->id     = TRid++;
395:   head->lineno = lineno;

397:   head->filename              = filename;
398:   head->functionname          = function;
399:   head->specialcookie         = COOKIE_VALUE;
400:   *(PetscInt *)(inew + nsize) = COOKIE_VALUE;

402:   TRallocated += TRrequestedSize ? head->rsize : head->size;
403:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
404:   if (PetscLogMemory) {
405:     for (PetscInt i = 0; i < NumTRMaxMems; i++) {
406:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
407:     }
408:   }
409:   TRfrags++;

411: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
412:   PetscCall(PetscStackCopy(&petscstack, &head->stack));
413:   /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */
414:   head->stack.line[PetscMax(head->stack.currentsize - 2, 0)] = lineno;
415: #endif

417:   /*
418:          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
419:          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
420:   */
421:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
422:     if (!PetscLogMalloc) {
423:       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));
424:       PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");

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

429:       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
430:       PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
431:     }
432:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
433:     PetscLogMallocFile[PetscLogMalloc]       = filename;
434:     PetscLogMallocFunction[PetscLogMalloc++] = function;
435:   }
436:   *result = (void *)inew;
437:   PetscFunctionReturn(PETSC_SUCCESS);
438: }

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

443:   Collective

445:   Input Parameters:
446: + viewer  - the viewer to output the information on
447: - message - string printed before values

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

454:   Level: intermediate

456: .seealso: `PetscMallocDump()`, `PetscMemoryGetCurrentUsage()`, `PetscMemorySetGetMaximumUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
457:  @*/
458: PetscErrorCode PetscMemoryView(PetscViewer viewer, const char message[])
459: {
460:   PetscLogDouble allocated, allocatedmax, resident, residentmax, gallocated, gallocatedmax, gresident, gresidentmax, maxgallocated, maxgallocatedmax;
461:   PetscLogDouble mingallocated, mingallocatedmax, mingresident, mingresidentmax, maxgresident, maxgresidentmax;
462:   MPI_Comm       comm;

464:   PetscFunctionBegin;
465:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
466:   PetscCall(PetscMallocGetCurrentUsage(&allocated));
467:   PetscCall(PetscMallocGetMaximumUsage(&allocatedmax));
468:   PetscCall(PetscMemoryGetCurrentUsage(&resident));
469:   PetscCall(PetscMemoryGetMaximumUsage(&residentmax));
470:   if (residentmax > 0) residentmax = PetscMax(resident, residentmax);
471:   PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm));
472:   PetscCall(PetscViewerASCIIPrintf(viewer, "%s", message));
473:   if (resident && residentmax && allocated) {
474:     PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
475:     PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
476:     PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
477:     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax));
478:     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
479:     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
480:     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
481:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
482:     PetscCallMPI(MPI_Reduce(&allocatedmax, &gallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
483:     PetscCallMPI(MPI_Reduce(&allocatedmax, &maxgallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
484:     PetscCallMPI(MPI_Reduce(&allocatedmax, &mingallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
485:     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocatedmax, maxgallocatedmax, mingallocatedmax));
486:     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
487:     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
488:     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
489:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
490:   } else if (resident && residentmax) {
491:     PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
492:     PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
493:     PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
494:     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax));
495:     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
496:     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
497:     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
498:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
499:   } else if (resident && allocated) {
500:     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
501:     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
502:     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
503:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
504:     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
505:     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
506:     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
507:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
508:     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n"));
509:   } else if (allocated) {
510:     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
511:     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
512:     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
513:     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
514:     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n"));
515:     PetscCall(PetscViewerASCIIPrintf(viewer, "OS cannot compute process memory\n"));
516:   } else {
517:     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n"));
518:   }
519:   PetscCall(PetscViewerFlush(viewer));
520:   PetscFunctionReturn(PETSC_SUCCESS);
521: }

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

526:   Not Collective

528:   Output Parameter:
529: . space - number of bytes currently allocated

531:   Level: intermediate

533:   Note:
534:   This only works if `-memory_view` or `-log_view_memory` have been used

536: .seealso: `PetscMallocDump()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
537:           `PetscMemoryGetMaximumUsage()`
538:  @*/
539: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
540: {
541:   PetscFunctionBegin;
542:   *space = (PetscLogDouble)TRallocated;
543:   PetscFunctionReturn(PETSC_SUCCESS);
544: }

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

550:   Not Collective

552:   Output Parameter:
553: . space - maximum number of bytes ever allocated at one time

555:   Level: intermediate

557:   Note:
558:   This only works if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used

560: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
561:           `PetscMallocPushMaximumUsage()`
562:  @*/
563: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
564: {
565:   PetscFunctionBegin;
566:   *space = (PetscLogDouble)TRMaxMem;
567:   PetscFunctionReturn(PETSC_SUCCESS);
568: }

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

573:   Not Collective

575:   Input Parameter:
576: . event - an event id; this is just for error checking

578:   Level: developer

580:   Note:
581:   This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used

583: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
584:           `PetscMallocPopMaximumUsage()`
585:  @*/
586: PetscErrorCode PetscMallocPushMaximumUsage(int event)
587: {
588:   PetscFunctionBegin;
589:   if (event < 0 || ++NumTRMaxMems > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
590:   TRMaxMems[NumTRMaxMems - 1]       = TRallocated;
591:   TRMaxMemsEvents[NumTRMaxMems - 1] = event;
592:   PetscFunctionReturn(PETSC_SUCCESS);
593: }

595: /*@
596:   PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

598:   Not Collective

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

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

606:   Level: developer

608:   Note:
609:   This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used

611: .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
612:           `PetscMallocPushMaximumUsage()`
613:  @*/
614: PetscErrorCode PetscMallocPopMaximumUsage(int event, PetscLogDouble *mu)
615: {
616:   PetscFunctionBegin;
617:   *mu = 0;
618:   if (event < 0 || NumTRMaxMems-- > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
619:   PetscCheck(TRMaxMemsEvents[NumTRMaxMems] == event, PETSC_COMM_SELF, PETSC_ERR_MEMC, "PetscMallocPush/PopMaximumUsage() are not nested");
620:   *mu = (PetscLogDouble)TRMaxMems[NumTRMaxMems];
621:   PetscFunctionReturn(PETSC_SUCCESS);
622: }

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

627:   Not Collective, No Fortran Support

629:   Input Parameter:
630: . ptr - the memory location

632:   Output Parameter:
633: . stack - the stack indicating where the program allocated this memory

635:   Level: intermediate

637:   Note:
638:   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used

640: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
641: @*/
642: PetscErrorCode PetscMallocGetStack(void *ptr, PetscStack **stack)
643: {
644: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
645:   TRSPACE *head;

647:   PetscFunctionBegin;
648:   head   = (TRSPACE *)((char *)ptr - HEADER_BYTES);
649:   *stack = &head->stack;
650:   PetscFunctionReturn(PETSC_SUCCESS);
651: #else
652:   *stack = NULL;
653:   return PETSC_SUCCESS;
654: #endif
655: }

657: /*@C
658:   PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
659:   printed is: size of space (in bytes), address of space, id of space,
660:   file in which space was allocated, and line number at which it was
661:   allocated.

663:   Not Collective

665:   Input Parameter:
666: . fp - file pointer.  If `fp` is `NULL`, `stdout` is assumed.

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

671:   Level: intermediate

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

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

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

680:   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used

682:   Fortran Notes:
683:   The calling sequence is `PetscMallocDump`(PetscErrorCode ierr). A `fp` parameter is not supported.

685:   Developer Notes:
686:   This should be absorbed into `PetscMallocView()`

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

696:   PetscFunctionBegin;
697:   PetscCallMPI(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:     PetscCall(PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib));
710:     if (!isLib) {
711: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
712:       fprintf(fp, "[%2d] %.0f bytes\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size));
713:       PetscCall(PetscStackPrint(&head->stack, fp));
714: #else
715:       fprintf(fp, "[%2d] %.0f bytes %s() at %s:%d\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size), head->functionname, head->filename, head->lineno);
716: #endif
717:     }
718:     head = head->next;
719:   }
720:   PetscFunctionReturn(PETSC_SUCCESS);
721: }

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

726:   Not Collective

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

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

736:   Level: advanced

738:   Note:
739:   Must be called after `PetscMallocSetDebug()`

741:   Developer Notes:
742:   Uses `MPI_COMM_WORLD` to determine rank because PETSc communicators may not be available

744: .seealso: `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()`
745: @*/
746: PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
747: {
748:   PetscFunctionBegin;
749:   PetscLogMalloc = 0;
750:   PetscCall(PetscMemorySetGetMaximumUsage());
751:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
752:   PetscLogMallocThreshold = (size_t)logmin;
753:   PetscFunctionReturn(PETSC_SUCCESS);
754: }

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

759:   Not Collective

761:   Output Parameter:
762: . logging - `PETSC_TRUE` if logging is active

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

767:   Level: advanced

769: .seealso: `PetscMallocViewSet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceGet()`, `PetscMalloc()`, `PetscFree()`
770: @*/
771: PetscErrorCode PetscMallocViewGet(PetscBool *logging)
772: {
773:   PetscFunctionBegin;
774:   *logging = (PetscBool)(PetscLogMalloc >= 0);
775:   PetscFunctionReturn(PETSC_SUCCESS);
776: }

778: /*@
779:   PetscMallocTraceSet - Trace all calls to `PetscMalloc()`. That is print each `PetscMalloc()` and `PetscFree()` call to a viewer.

781:   Not Collective

783:   Input Parameters:
784: + viewer - The viewer to use for tracing, or `NULL` to use `PETSC_VIEWER_STDOUT_SELF`
785: . active - Flag to activate or deactivate tracing
786: - logmin - The smallest memory size that will be logged

788:   Level: advanced

790:   Note:
791:   The viewer should not be collective.

793:   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used

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

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

817:   Not Collective

819:   Output Parameter:
820: . logging - `PETSC_TRUE` if logging is active

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

825:   Level: advanced

827:   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used

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

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

841:   Not Collective

843:   Input Parameter:
844: . fp - file pointer; or `NULL`

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

849:   Level: advanced

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

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

856:   Fortran Notes:
857:   The calling sequence in Fortran is `PetscMallocView`(integer ierr)

859: .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocDump()`, `PetscMallocViewSet()`, `PetscMemoryView()`, `PetscMalloc()`, `PetscFree()`
860: @*/
861: PetscErrorCode PetscMallocView(FILE *fp)
862: {
863:   PetscInt       n, *perm;
864:   size_t        *shortlength;
865:   int           *shortcount;
866:   PetscMPIInt    rank;
867:   PetscBool      match;
868:   const char   **shortfunction;
869:   PetscLogDouble rss;

871:   PetscFunctionBegin;
872:   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
873:   PetscCall(PetscFFlush(fp));

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

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

908:     perm = (PetscInt *)malloc(n * sizeof(PetscInt));
909:     PetscCheck(perm, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
910:     for (PetscInt i = 0; i < n; i++) perm[i] = i;
911:     PetscCall(PetscSortStrWithPermutation(n, shortfunction, perm));

913:     (void)fprintf(fp, "[%d] Memory usage sorted by function\n", rank);
914:     for (PetscInt i = 0; i < n; i++) (void)fprintf(fp, "[%d] %d %.0f %s()\n", rank, shortcount[perm[i]], (PetscLogDouble)shortlength[perm[i]], shortfunction[perm[i]]);
915:     free(perm);
916:     free(shortlength);
917:     free(shortcount);
918:     free((char **)shortfunction);
919:   }
920:   PetscCall(PetscFFlush(fp));
921:   PetscFunctionReturn(PETSC_SUCCESS);
922: }

924: /*@
925:   PetscMallocSetDebug - Set's PETSc memory debugging

927:   Not Collective

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

933:   Options Database Keys:
934: + -malloc_debug <true or false> - turns on or off debugging
935: . -malloc_test                  - turns on all debugging if PETSc was configured with debugging including `-malloc_dump`, otherwise ignored
936: . -malloc_view_threshold t      - log only allocations larger than t
937: - -malloc_dump <filename>       - print a list of all memory that has not been freed, in `PetscFinalize()`

939:   Level: developer

941:   Note:
942:   This is called in `PetscInitialize()` and should not be called elsewhere

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

952:   TRallocated           = 0;
953:   TRfrags               = 0;
954:   TRhead                = NULL;
955:   TRid                  = 0;
956:   TRdebug               = eachcall;
957:   TRMaxMem              = 0;
958:   PetscLogMallocMax     = 10000;
959:   PetscLogMalloc        = -1;
960:   TRdebugIinitializenan = initializenan;
961:   PetscFunctionReturn(PETSC_SUCCESS);
962: }

964: /*@
965:   PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.

967:   Not Collective

969:   Output Parameters:
970: + basic         - doing basic debugging
971: . eachcall      - checks the entire memory heap at each `PetscMalloc()`/`PetscFree()`
972: - initializenan - initializes memory with `NaN`

974:   Level: intermediate

976:   Note:
977:   By default, the debug configuration of PETSc always does some debugging unless you run with `-malloc_debug no`

979: .seealso: `CHKMEMQ`, `PetscMallocValidate()`, `PetscMallocSetDebug()`, `PetscMalloc()`, `PetscFree()`
980: @*/
981: PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
982: {
983:   PetscFunctionBegin;
984:   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
985:   if (eachcall) *eachcall = TRdebug;
986:   if (initializenan) *initializenan = TRdebugIinitializenan;
987:   PetscFunctionReturn(PETSC_SUCCESS);
988: }

990: /*@
991:   PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size

993:   Not Collective

995:   Input Parameter:
996: . flg - `PETSC_TRUE` to log the requested memory size

998:   Options Database Key:
999: . -malloc_requested_size <bool> - Sets this flag

1001:   Level: developer

1003: .seealso: `PetscMallocLogRequestedSizeGet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1004: @*/
1005: PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg)
1006: {
1007:   PetscFunctionBegin;
1008:   TRrequestedSize = flg;
1009:   PetscFunctionReturn(PETSC_SUCCESS);
1010: }

1012: /*@
1013:   PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size

1015:   Not Collective

1017:   Output Parameter:
1018: . flg - `PETSC_TRUE` if we log the requested memory size

1020:   Level: developer

1022: .seealso: `PetscMallocLogRequestedSizeSet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1023: @*/
1024: PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg)
1025: {
1026:   PetscFunctionBegin;
1027:   *flg = TRrequestedSize;
1028:   PetscFunctionReturn(PETSC_SUCCESS);
1029: }