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