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