xref: /petsc/src/sys/memory/mtr.c (revision 66af8762ec03dbef0e079729eb2a1734a35ed7ff)
1 /*
2      Logging of memory usage and some error checking
3 */
4 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/
5 #include <petscviewer.h>
6 #if defined(PETSC_HAVE_MALLOC_H)
7   #include <malloc.h>
8 #endif
9 
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 **);
16 
17 #define CLASSID_VALUE ((PetscClassId)0xf0e0d0c9)
18 #define ALREADY_FREED ((PetscClassId)0x0f0e0d9c)
19 
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   PetscClassId classid;
28 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
29   PetscStack stack;
30 #endif
31   struct _trSPACE *next, *prev;
32 } TRSPACE;
33 
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))
38 
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;
47 
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;
71 
72 /*@C
73   PetscMallocValidate - Test the memory for corruption.  This can be called at any time between `PetscInitialize()` and `PetscFinalize()`
74 
75   Input Parameters:
76 + line     - line number where call originated.
77 . function - name of function calling
78 - file     - file where function is
79 
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
83 
84   Level: advanced
85 
86   Notes:
87   You should generally use `CHKMEMQ` as a short cut for calling this routine.
88 
89   Error messages are written to `stdout`.
90 
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)
92 
93   No output is generated if there are no problems detected.
94 
95   Fortran Notes:
96   The Fortran calling sequence is simply `PetscMallocValidate(ierr)`
97 
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   PetscClassId *nend;
105 
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->classid != CLASSID_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 = (PetscClassId *)(a + head->size);
130     if (*nend != CLASSID_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 }
155 
156 /*
157     PetscTrMallocDefault - Malloc with logging and error checking
158 
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;
165 
166   PetscFunctionBegin;
167   if (!a) {
168     *result = NULL;
169     PetscFunctionReturn(PETSC_SUCCESS);
170   }
171 
172   PetscCall(PetscMallocValidate(lineno, function, filename));
173 
174   nsize = (a + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1);
175   PetscCall(PetscMallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), clear, lineno, function, filename, (void **)&inew));
176 
177   head = (TRSPACE *)inew;
178   inew += sizeof(TrSPACE);
179 
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;
188 
189   head->filename                  = filename;
190   head->functionname              = function;
191   head->classid                   = CLASSID_VALUE;
192   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;
193 
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++;
202 
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[head->stack.currentsize - 2] = 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
222 
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, " ");
231 
232       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
233       PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
234 
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 }
246 
247 /*
248    PetscTrFreeDefault - Free with logging and error checking
249 
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   PetscClassId *nend;
258 
259   PetscFunctionBegin;
260   if (!a) PetscFunctionReturn(PETSC_SUCCESS);
261 
262   PetscCall(PetscMallocValidate(lineno, function, filename));
263 
264   ahead = a;
265   a     = a - sizeof(TrSPACE);
266   head  = (TRSPACE *)a;
267 
268   if (head->classid != CLASSID_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 = (PetscClassId *)(ahead + head->size);
275   if (*nend != CLASSID_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) {
295     PetscCall(PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Free  %zu %s:%d (%s)\n", head->rsize, filename ? filename : "null", lineno, function ? function : "null"));
296   }
297   *nend = ALREADY_FREED;
298   /* Save location where freed.  If we suspect the line number, mark as allocated location */
299   if (lineno > 0 && lineno < 50000) {
300     head->lineno       = lineno;
301     head->filename     = filename;
302     head->functionname = function;
303   } else {
304     head->lineno = -head->lineno;
305   }
306   asize = TRrequestedSize ? head->rsize : head->size;
307   PetscCheck(TRallocated >= asize, PETSC_COMM_SELF, PETSC_ERR_MEMC, "TRallocate is smaller than memory just freed");
308   TRallocated -= asize;
309   TRfrags--;
310   if (head->prev) head->prev->next = head->next;
311   else TRhead = head->next;
312 
313   if (head->next) head->next->prev = head->prev;
314   PetscCall(PetscFreeAlign(a, lineno, function, filename));
315   PetscFunctionReturn(PETSC_SUCCESS);
316 }
317 
318 /*
319   PetscTrReallocDefault - Realloc with logging and error checking
320 
321 */
322 static PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
323 {
324   char         *a = (char *)*result;
325   TRSPACE      *head;
326   char         *ahead, *inew;
327   PetscClassId *nend;
328   size_t        nsize;
329 
330   PetscFunctionBegin;
331   /* Realloc requests zero space so just free the current space */
332   if (!len) {
333     PetscCall(PetscTrFreeDefault(*result, lineno, function, filename));
334     *result = NULL;
335     PetscFunctionReturn(PETSC_SUCCESS);
336   }
337   /* If the original space was NULL just use the regular malloc() */
338   if (!*result) {
339     PetscCall(PetscTrMallocDefault(len, PETSC_FALSE, lineno, function, filename, result));
340     PetscFunctionReturn(PETSC_SUCCESS);
341   }
342 
343   PetscCall(PetscMallocValidate(lineno, function, filename));
344 
345   ahead = a;
346   a     = a - sizeof(TrSPACE);
347   head  = (TRSPACE *)a;
348   inew  = a;
349 
350   if (head->classid != CLASSID_VALUE) {
351     TRdebug = PETSC_FALSE;
352     PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
353     PetscCall((*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a));
354     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory");
355   }
356   nend = (PetscClassId *)(ahead + head->size);
357   if (*nend != CLASSID_VALUE) {
358     TRdebug = PETSC_FALSE;
359     if (*nend == ALREADY_FREED) {
360       PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
361       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE)));
362       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
363         PetscCall((*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
364       } else {
365         PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno));
366       }
367       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed");
368     } else {
369       /* Damaged tail */
370       PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno));
371       PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a));
372       PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno));
373       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory");
374     }
375   }
376 
377   /* remove original reference to the memory allocated from the PETSc debugging heap */
378   TRallocated -= TRrequestedSize ? head->rsize : head->size;
379   TRfrags--;
380   if (head->prev) head->prev->next = head->next;
381   else TRhead = head->next;
382   if (head->next) head->next->prev = head->prev;
383 
384   nsize = (len + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1);
385   PetscCall(PetscReallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), lineno, function, filename, (void **)&inew));
386 
387   head = (TRSPACE *)inew;
388   inew += sizeof(TrSPACE);
389 
390   if (TRhead) TRhead->prev = head;
391   head->next   = TRhead;
392   TRhead       = head;
393   head->prev   = NULL;
394   head->size   = nsize;
395   head->rsize  = len;
396   head->id     = TRid++;
397   head->lineno = lineno;
398 
399   head->filename                  = filename;
400   head->functionname              = function;
401   head->classid                   = CLASSID_VALUE;
402   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;
403 
404   TRallocated += TRrequestedSize ? head->rsize : head->size;
405   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
406   if (PetscLogMemory) {
407     for (PetscInt i = 0; i < NumTRMaxMems; i++) {
408       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
409     }
410   }
411   TRfrags++;
412 
413 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
414   PetscCall(PetscStackCopy(&petscstack, &head->stack));
415   /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */
416   head->stack.line[head->stack.currentsize - 2] = lineno;
417 #endif
418 
419   /*
420          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
421          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
422   */
423   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
424     if (!PetscLogMalloc) {
425       PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t));
426       PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
427 
428       PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
429       PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
430 
431       PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *));
432       PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " ");
433     }
434     PetscLogMallocLength[PetscLogMalloc]     = nsize;
435     PetscLogMallocFile[PetscLogMalloc]       = filename;
436     PetscLogMallocFunction[PetscLogMalloc++] = function;
437   }
438   *result = (void *)inew;
439   PetscFunctionReturn(PETSC_SUCCESS);
440 }
441 
442 /*@C
443   PetscMemoryView - Shows the amount of memory currently being used in a communicator.
444 
445   Collective
446 
447   Input Parameters:
448 + viewer  - the viewer to output the information on
449 - message - string printed before values
450 
451   Options Database Keys:
452 + -malloc_debug    - have PETSc track how much memory it has allocated
453 . -log_view_memory - print memory usage per event when `-log_view` is used
454 - -memory_view     - during `PetscFinalize()` have this routine called
455 
456   Level: intermediate
457 
458 .seealso: `PetscMallocDump()`, `PetscMemoryGetCurrentUsage()`, `PetscMemorySetGetMaximumUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
459  @*/
460 PetscErrorCode PetscMemoryView(PetscViewer viewer, const char message[])
461 {
462   PetscLogDouble allocated, allocatedmax, resident, residentmax, gallocated, gallocatedmax, gresident, gresidentmax, maxgallocated, maxgallocatedmax;
463   PetscLogDouble mingallocated, mingallocatedmax, mingresident, mingresidentmax, maxgresident, maxgresidentmax;
464   MPI_Comm       comm;
465 
466   PetscFunctionBegin;
467   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
468   PetscCall(PetscMallocGetCurrentUsage(&allocated));
469   PetscCall(PetscMallocGetMaximumUsage(&allocatedmax));
470   PetscCall(PetscMemoryGetCurrentUsage(&resident));
471   PetscCall(PetscMemoryGetMaximumUsage(&residentmax));
472   if (residentmax > 0) residentmax = PetscMax(resident, residentmax);
473   PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm));
474   PetscCall(PetscViewerASCIIPrintf(viewer, "%s", message));
475   if (resident && residentmax && allocated) {
476     PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
477     PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
478     PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
479     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax));
480     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
481     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
482     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
483     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
484     PetscCallMPI(MPI_Reduce(&allocatedmax, &gallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
485     PetscCallMPI(MPI_Reduce(&allocatedmax, &maxgallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
486     PetscCallMPI(MPI_Reduce(&allocatedmax, &mingallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
487     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocatedmax, maxgallocatedmax, mingallocatedmax));
488     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
489     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
490     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
491     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
492   } else if (resident && residentmax) {
493     PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
494     PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
495     PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
496     PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax));
497     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
498     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
499     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
500     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
501   } else if (resident && allocated) {
502     PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
503     PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
504     PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
505     PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory:                                  total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident));
506     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
507     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
508     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
509     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
510     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n"));
511   } else if (allocated) {
512     PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm));
513     PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm));
514     PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm));
515     PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated));
516     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n"));
517     PetscCall(PetscViewerASCIIPrintf(viewer, "OS cannot compute process memory\n"));
518   } else {
519     PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n"));
520   }
521   PetscCall(PetscViewerFlush(viewer));
522   PetscFunctionReturn(PETSC_SUCCESS);
523 }
524 
525 /*@
526   PetscMallocGetCurrentUsage - gets the current amount of memory used that was allocated with `PetscMalloc()`
527 
528   Not Collective
529 
530   Output Parameter:
531 . space - number of bytes currently allocated
532 
533   Level: intermediate
534 
535   Note:
536   This only works if `-memory_view` or `-log_view_memory` have been used
537 
538 .seealso: `PetscMallocDump()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
539           `PetscMemoryGetMaximumUsage()`
540  @*/
541 PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
542 {
543   PetscFunctionBegin;
544   *space = (PetscLogDouble)TRallocated;
545   PetscFunctionReturn(PETSC_SUCCESS);
546 }
547 
548 /*@
549   PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was obtained with `PetscMalloc()` at any time
550   during this run, the high water mark.
551 
552   Not Collective
553 
554   Output Parameter:
555 . space - maximum number of bytes ever allocated at one time
556 
557   Level: intermediate
558 
559   Note:
560   This only works if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used
561 
562 .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
563           `PetscMallocPushMaximumUsage()`
564  @*/
565 PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
566 {
567   PetscFunctionBegin;
568   *space = (PetscLogDouble)TRMaxMem;
569   PetscFunctionReturn(PETSC_SUCCESS);
570 }
571 
572 /*@
573   PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event
574 
575   Not Collective
576 
577   Input Parameter:
578 . event - an event id; this is just for error checking
579 
580   Level: developer
581 
582   Note:
583   This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used
584 
585 .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
586           `PetscMallocPopMaximumUsage()`
587  @*/
588 PetscErrorCode PetscMallocPushMaximumUsage(int event)
589 {
590   PetscFunctionBegin;
591   if (event < 0 || ++NumTRMaxMems > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
592   TRMaxMems[NumTRMaxMems - 1]       = TRallocated;
593   TRMaxMemsEvents[NumTRMaxMems - 1] = event;
594   PetscFunctionReturn(PETSC_SUCCESS);
595 }
596 
597 /*@
598   PetscMallocPopMaximumUsage - collect the maximum memory usage over an event
599 
600   Not Collective
601 
602   Input Parameter:
603 . event - an event id; this is just for error checking
604 
605   Output Parameter:
606 . mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event
607 
608   Level: developer
609 
610   Note:
611   This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used
612 
613 .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`,
614           `PetscMallocPushMaximumUsage()`
615  @*/
616 PetscErrorCode PetscMallocPopMaximumUsage(int event, PetscLogDouble *mu)
617 {
618   PetscFunctionBegin;
619   *mu = 0;
620   if (event < 0 || NumTRMaxMems-- > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS);
621   PetscCheck(TRMaxMemsEvents[NumTRMaxMems] == event, PETSC_COMM_SELF, PETSC_ERR_MEMC, "PetscMallocPush/PopMaximumUsage() are not nested");
622   *mu = TRMaxMems[NumTRMaxMems];
623   PetscFunctionReturn(PETSC_SUCCESS);
624 }
625 
626 /*@C
627   PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to `PetscMalloc()` was used to obtain that memory
628 
629   Not Collective
630 
631   Input Parameter:
632 . ptr - the memory location
633 
634   Output Parameter:
635 . stack - the stack indicating where the program allocated this memory
636 
637   Level: intermediate
638 
639   Note:
640   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used
641 
642 .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
643 @*/
644 PetscErrorCode PetscMallocGetStack(void *ptr, PetscStack **stack)
645 {
646 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
647   TRSPACE *head;
648 
649   PetscFunctionBegin;
650   head   = (TRSPACE *)(((char *)ptr) - HEADER_BYTES);
651   *stack = &head->stack;
652   PetscFunctionReturn(PETSC_SUCCESS);
653 #else
654   *stack = NULL;
655   return PETSC_SUCCESS;
656 #endif
657 }
658 
659 /*@C
660   PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
661   printed is: size of space (in bytes), address of space, id of space,
662   file in which space was allocated, and line number at which it was
663   allocated.
664 
665   Not Collective
666 
667   Input Parameter:
668 . fp - file pointer.  If `fp` is `NULL`, `stdout` is assumed.
669 
670   Options Database Key:
671 . -malloc_dump <optional filename> - Print summary of unfreed memory during call to `PetscFinalize()`, writing to filename if given
672 
673   Level: intermediate
674 
675   Notes:
676   Uses `MPI_COMM_WORLD` to display rank, because this may be called in `PetscFinalize()` after `PETSC_COMM_WORLD` has been freed.
677 
678   When called in `PetscFinalize()` dumps only the allocations that have not been properly freed
679 
680   `PetscMallocView()` prints a list of all memory ever allocated
681 
682   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used
683 
684   Fortran Notes:
685   The calling sequence is `PetscMallocDump`(PetscErrorCode ierr). A `fp` parameter is not supported.
686 
687   Developer Notes:
688   This should be absorbed into `PetscMallocView()`
689 
690 .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMallocViewSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()`
691 @*/
692 PetscErrorCode PetscMallocDump(FILE *fp)
693 {
694   TRSPACE    *head;
695   size_t      libAlloc = 0;
696   PetscMPIInt rank;
697 
698   PetscFunctionBegin;
699   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
700   if (!fp) fp = PETSC_STDOUT;
701   head = TRhead;
702   while (head) {
703     libAlloc += TRrequestedSize ? head->rsize : head->size;
704     head = head->next;
705   }
706   if (TRallocated - libAlloc > 0) fprintf(fp, "[%d]Total space allocated %.0f bytes\n", rank, (PetscLogDouble)TRallocated);
707   head = TRhead;
708   while (head) {
709     PetscBool isLib;
710 
711     PetscCall(PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib));
712     if (!isLib) {
713 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
714       fprintf(fp, "[%2d] %.0f bytes\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size));
715       PetscCall(PetscStackPrint(&head->stack, fp));
716 #else
717       fprintf(fp, "[%2d] %.0f bytes %s() at %s:%d\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size), head->functionname, head->filename, head->lineno);
718 #endif
719     }
720     head = head->next;
721   }
722   PetscFunctionReturn(PETSC_SUCCESS);
723 }
724 
725 /*@
726   PetscMallocViewSet - Activates logging of all calls to `PetscMalloc()` with a minimum size to view
727 
728   Not Collective
729 
730   Input Parameter:
731 . logmin - minimum allocation size to log, or `PETSC_DEFAULT` to log all memory allocations
732 
733   Options Database Keys:
734 + -malloc_view <optional filename> - Activates `PetscMallocView()` in `PetscFinalize()`
735 . -malloc_view_threshold <min>     - Sets a minimum size if `-malloc_view` is used
736 - -log_view_memory                 - view the memory usage also with the -log_view option
737 
738   Level: advanced
739 
740   Note:
741   Must be called after `PetscMallocSetDebug()`
742 
743   Developer Notes:
744   Uses `MPI_COMM_WORLD` to determine rank because PETSc communicators may not be available
745 
746 .seealso: `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()`
747 @*/
748 PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
749 {
750   PetscFunctionBegin;
751   PetscLogMalloc = 0;
752   PetscCall(PetscMemorySetGetMaximumUsage());
753   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
754   PetscLogMallocThreshold = (size_t)logmin;
755   PetscFunctionReturn(PETSC_SUCCESS);
756 }
757 
758 /*@
759   PetscMallocViewGet - Determine whether calls to `PetscMalloc()` are being logged
760 
761   Not Collective
762 
763   Output Parameter:
764 . logging - `PETSC_TRUE` if logging is active
765 
766   Options Database Key:
767 . -malloc_view <optional filename> - Activates `PetscMallocView()`
768 
769   Level: advanced
770 
771 .seealso: `PetscMallocViewSet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceGet()`, `PetscMalloc()`, `PetscFree()`
772 @*/
773 PetscErrorCode PetscMallocViewGet(PetscBool *logging)
774 {
775   PetscFunctionBegin;
776   *logging = (PetscBool)(PetscLogMalloc >= 0);
777   PetscFunctionReturn(PETSC_SUCCESS);
778 }
779 
780 /*@
781   PetscMallocTraceSet - Trace all calls to `PetscMalloc()`. That is print each `PetscMalloc()` and `PetscFree()` call to a viewer.
782 
783   Not Collective
784 
785   Input Parameters:
786 + viewer - The viewer to use for tracing, or `NULL` to use `PETSC_VIEWER_STDOUT_SELF`
787 . active - Flag to activate or deactivate tracing
788 - logmin - The smallest memory size that will be logged
789 
790   Level: advanced
791 
792   Note:
793   The viewer should not be collective.
794 
795   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used
796 
797 .seealso: `PetscMallocTraceGet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
798 @*/
799 PetscErrorCode PetscMallocTraceSet(PetscViewer viewer, PetscBool active, PetscLogDouble logmin)
800 {
801   PetscFunctionBegin;
802   if (!active) {
803     PetscLogMallocTrace = -1;
804     PetscFunctionReturn(PETSC_SUCCESS);
805   }
806   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
807   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
808   PetscLogMallocTraceViewer = viewer;
809   PetscLogMallocTrace       = 0;
810   PetscCall(PetscMemorySetGetMaximumUsage());
811   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
812   PetscLogMallocTraceThreshold = (size_t)logmin;
813   PetscFunctionReturn(PETSC_SUCCESS);
814 }
815 
816 /*@
817   PetscMallocTraceGet - Determine whether all calls to `PetscMalloc()` are being traced
818 
819   Not Collective
820 
821   Output Parameter:
822 . logging - `PETSC_TRUE` if logging is active
823 
824   Options Database Key:
825 . -malloc_view <optional filename> - Activates `PetscMallocView()`
826 
827   Level: advanced
828 
829   This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used
830 
831 .seealso: `PetscMallocTraceSet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()`
832 @*/
833 PetscErrorCode PetscMallocTraceGet(PetscBool *logging)
834 {
835   PetscFunctionBegin;
836   *logging = (PetscBool)(PetscLogMallocTrace >= 0);
837   PetscFunctionReturn(PETSC_SUCCESS);
838 }
839 
840 /*@C
841   PetscMallocView - Saves the log of all calls to `PetscMalloc()`; also calls `PetscMemoryGetMaximumUsage()`
842 
843   Not Collective
844 
845   Input Parameter:
846 . fp - file pointer; or `NULL`
847 
848   Options Database Key:
849 . -malloc_view <optional filename> - Activates `PetscMallocView()` in `PetscFinalize()`
850 
851   Level: advanced
852 
853   Notes:
854   `PetscMallocDump()` dumps only the currently unfreed memory, this dumps all memory ever allocated
855 
856   `PetscMemoryView()` gives a brief summary of current memory usage
857 
858   Fortran Notes:
859   The calling sequence in Fortran is `PetscMallocView`(integer ierr)
860 
861 .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocDump()`, `PetscMallocViewSet()`, `PetscMemoryView()`, `PetscMalloc()`, `PetscFree()`
862 @*/
863 PetscErrorCode PetscMallocView(FILE *fp)
864 {
865   PetscInt       n, *perm;
866   size_t        *shortlength;
867   int           *shortcount;
868   PetscMPIInt    rank;
869   PetscBool      match;
870   const char   **shortfunction;
871   PetscLogDouble rss;
872 
873   PetscFunctionBegin;
874   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
875   PetscCall(PetscFFlush(fp));
876 
877   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()");
878 
879   if (!fp) fp = PETSC_STDOUT;
880   PetscCall(PetscMemoryGetMaximumUsage(&rss));
881   if (rss) {
882     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n", rank, (PetscLogDouble)TRMaxMem, rss);
883   } else {
884     (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n", rank, (PetscLogDouble)TRMaxMem);
885   }
886   if (PetscLogMalloc > 0) {
887     shortcount = (int *)malloc(PetscLogMalloc * sizeof(int));
888     PetscCheck(shortcount, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
889     shortlength = (size_t *)malloc(PetscLogMalloc * sizeof(size_t));
890     PetscCheck(shortlength, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
891     shortfunction = (const char **)malloc(PetscLogMalloc * sizeof(char *));
892     PetscCheck(shortfunction, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
893     n = 0;
894     for (PetscInt i = 0; i < PetscLogMalloc; i++) {
895       for (PetscInt j = 0; j < n; j++) {
896         PetscCall(PetscStrcmp(shortfunction[j], PetscLogMallocFunction[i], &match));
897         if (match) {
898           shortlength[j] += PetscLogMallocLength[i];
899           shortcount[j]++;
900           goto foundit;
901         }
902       }
903       shortfunction[n] = PetscLogMallocFunction[i];
904       shortlength[n]   = PetscLogMallocLength[i];
905       shortcount[n]    = 1;
906       n++;
907     foundit:;
908     }
909 
910     perm = (PetscInt *)malloc(n * sizeof(PetscInt));
911     PetscCheck(perm, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory");
912     for (PetscInt i = 0; i < n; i++) perm[i] = i;
913     PetscCall(PetscSortStrWithPermutation(n, (const char **)shortfunction, perm));
914 
915     (void)fprintf(fp, "[%d] Memory usage sorted by function\n", rank);
916     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]]);
917     free(perm);
918     free(shortlength);
919     free(shortcount);
920     free((char **)shortfunction);
921   }
922   PetscCall(PetscFFlush(fp));
923   PetscFunctionReturn(PETSC_SUCCESS);
924 }
925 
926 /*@
927   PetscMallocSetDebug - Set's PETSc memory debugging
928 
929   Not Collective
930 
931   Input Parameters:
932 + eachcall      - checks the entire heap of allocated memory for issues on each call to `PetscMalloc()` and `PetscFree()`, slow
933 - initializenan - initializes all memory with `NaN` to catch use of uninitialized floating point arrays
934 
935   Options Database Keys:
936 + -malloc_debug <true or false> - turns on or off debugging
937 . -malloc_test                  - turns on all debugging if PETSc was configured with debugging including `-malloc_dump`, otherwise ignored
938 . -malloc_view_threshold t      - log only allocations larger than t
939 - -malloc_dump <filename>       - print a list of all memory that has not been freed, in `PetscFinalize()`
940 
941   Level: developer
942 
943   Note:
944   This is called in `PetscInitialize()` and should not be called elsewhere
945 
946 .seealso: `CHKMEMQ`, `PetscMallocValidate()`, `PetscMallocGetDebug()`, `PetscMalloc()`, `PetscFree()`
947 @*/
948 PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
949 {
950   PetscFunctionBegin;
951   PetscCheck(PetscTrMalloc != PetscTrMallocDefault, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Cannot call this routine more than once, it can only be called in PetscInitialize()");
952   PetscCall(PetscMallocSet(PetscTrMallocDefault, PetscTrFreeDefault, PetscTrReallocDefault));
953 
954   TRallocated           = 0;
955   TRfrags               = 0;
956   TRhead                = NULL;
957   TRid                  = 0;
958   TRdebug               = eachcall;
959   TRMaxMem              = 0;
960   PetscLogMallocMax     = 10000;
961   PetscLogMalloc        = -1;
962   TRdebugIinitializenan = initializenan;
963   PetscFunctionReturn(PETSC_SUCCESS);
964 }
965 
966 /*@
967   PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.
968 
969   Not Collective
970 
971   Output Parameters:
972 + basic         - doing basic debugging
973 . eachcall      - checks the entire memory heap at each `PetscMalloc()`/`PetscFree()`
974 - initializenan - initializes memory with `NaN`
975 
976   Level: intermediate
977 
978   Note:
979   By default, the debug configuration of PETSc always does some debugging unless you run with `-malloc_debug no`
980 
981 .seealso: `CHKMEMQ`, `PetscMallocValidate()`, `PetscMallocSetDebug()`, `PetscMalloc()`, `PetscFree()`
982 @*/
983 PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
984 {
985   PetscFunctionBegin;
986   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
987   if (eachcall) *eachcall = TRdebug;
988   if (initializenan) *initializenan = TRdebugIinitializenan;
989   PetscFunctionReturn(PETSC_SUCCESS);
990 }
991 
992 /*@
993   PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size
994 
995   Not Collective
996 
997   Input Parameter:
998 . flg - `PETSC_TRUE` to log the requested memory size
999 
1000   Options Database Key:
1001 . -malloc_requested_size <bool> - Sets this flag
1002 
1003   Level: developer
1004 
1005 .seealso: `PetscMallocLogRequestedSizeGet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1006 @*/
1007 PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg)
1008 {
1009   PetscFunctionBegin;
1010   TRrequestedSize = flg;
1011   PetscFunctionReturn(PETSC_SUCCESS);
1012 }
1013 
1014 /*@
1015   PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size
1016 
1017   Not Collective
1018 
1019   Output Parameter:
1020 . flg - `PETSC_TRUE` if we log the requested memory size
1021 
1022   Level: developer
1023 
1024 .seealso: `PetscMallocLogRequestedSizeSet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()`
1025 @*/
1026 PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg)
1027 {
1028   PetscFunctionBegin;
1029   *flg = TRrequestedSize;
1030   PetscFunctionReturn(PETSC_SUCCESS);
1031 }
1032