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