Actual source code: mtr.c
petsc-3.10.5 2019-03-28
2: /*
3: Interface to malloc() and free(). This code allows for
4: logging of memory usage and some error checking
5: */
6: #include <petscsys.h>
7: #include <petscviewer.h>
8: #if defined(PETSC_HAVE_MALLOC_H)
9: #include <malloc.h>
10: #endif
13: /*
14: These are defined in mal.c and ensure that malloced space is PetscScalar aligned
15: */
16: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**);
17: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
18: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t,int,const char[],const char[],void**);
19: PETSC_EXTERN PetscErrorCode PetscTrMallocDefault(size_t,int,const char[],const char[],void**);
20: PETSC_EXTERN PetscErrorCode PetscTrFreeDefault(void*,int,const char[],const char[]);
21: PETSC_EXTERN PetscErrorCode PetscTrReallocDefault(size_t,int,const char[],const char[],void**);
24: #define CLASSID_VALUE ((PetscClassId) 0xf0e0d0c9)
25: #define ALREADY_FREED ((PetscClassId) 0x0f0e0d9c)
27: typedef struct _trSPACE {
28: size_t size;
29: int id;
30: int lineno;
31: const char *filename;
32: const char *functionname;
33: PetscClassId classid;
34: #if defined(PETSC_USE_DEBUG)
35: PetscStack stack;
36: #endif
37: struct _trSPACE *next,*prev;
38: } TRSPACE;
40: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
41: It is sizeof(TRSPACE) padded to be a multiple of PETSC_MEMALIGN.
42: */
44: #define HEADER_BYTES ((sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1))
47: /* This union is used to insure that the block passed to the user retains
48: a minimum alignment of PETSC_MEMALIGN.
49: */
50: typedef union {
51: TRSPACE sp;
52: char v[HEADER_BYTES];
53: } TrSPACE;
56: static size_t TRallocated = 0;
57: static int TRfrags = 0;
58: static TRSPACE *TRhead = NULL;
59: static int TRid = 0;
60: static PetscBool TRdebugLevel = PETSC_FALSE;
61: static size_t TRMaxMem = 0;
62: /*
63: Arrays to log information on all Mallocs
64: */
65: static int PetscLogMallocMax = 10000;
66: static int PetscLogMalloc = -1;
67: static size_t PetscLogMallocThreshold = 0;
68: static size_t *PetscLogMallocLength;
69: static const char **PetscLogMallocFile,**PetscLogMallocFunction;
71: PETSC_INTERN PetscErrorCode PetscSetUseTrMalloc_Private(void)
72: {
76: PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
77: PetscTrRealloc = PetscTrReallocDefault;
79: TRallocated = 0;
80: TRfrags = 0;
81: TRhead = NULL;
82: TRid = 0;
83: TRdebugLevel = PETSC_FALSE;
84: TRMaxMem = 0;
85: PetscLogMallocMax = 10000;
86: PetscLogMalloc = -1;
87: return(0);
88: }
90: /*@C
91: PetscMallocValidate - Test the memory for corruption. This can be used to
92: check for memory overwrites.
94: Input Parameter:
95: + line - line number where call originated.
96: . function - name of function calling
97: - file - file where function is
99: Return value:
100: The number of errors detected.
102: Output Effect:
103: Error messages are written to stdout.
105: Level: advanced
107: Notes:
108: You should generally use CHKMEMQ as a short cut for calling this
109: routine.
111: The line, function, file are given by the C preprocessor as
113: The Fortran calling sequence is simply PetscMallocValidate(ierr)
115: No output is generated if there are no problems detected.
117: .seealso: CHKMEMQ
119: @*/
120: PetscErrorCode PetscMallocValidate(int line,const char function[],const char file[])
121: {
122: TRSPACE *head,*lasthead;
123: char *a;
124: PetscClassId *nend;
127: head = TRhead; lasthead = NULL;
128: while (head) {
129: if (head->classid != CLASSID_VALUE) {
130: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
131: (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
132: (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
133: if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
134: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
135: }
136: a = (char*)(((TrSPACE*)head) + 1);
137: nend = (PetscClassId*)(a + head->size);
138: if (*nend != CLASSID_VALUE) {
139: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
140: if (*nend == ALREADY_FREED) {
141: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
142: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
143: } else {
144: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
145: (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
146: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
147: }
148: }
149: lasthead = head;
150: head = head->next;
151: }
152: return(0);
153: }
155: /*
156: PetscTrMallocDefault - Malloc with tracing.
158: Input Parameters:
159: + a - number of bytes to allocate
160: . lineno - line number where used. Use __LINE__ for this
161: - filename - file name where used. Use __FILE__ for this
163: Returns:
164: double aligned pointer to requested storage, or null if not
165: available.
166: */
167: PetscErrorCode PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],void **result)
168: {
169: TRSPACE *head;
170: char *inew;
171: size_t nsize;
175: /* Do not try to handle empty blocks */
176: if (!a) { *result = NULL; return(0); }
178: if (TRdebugLevel) {
179: PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
180: }
182: nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
183: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);
185: head = (TRSPACE*)inew;
186: inew += sizeof(TrSPACE);
188: if (TRhead) TRhead->prev = head;
189: head->next = TRhead;
190: TRhead = head;
191: head->prev = NULL;
192: head->size = nsize;
193: head->id = TRid;
194: head->lineno = lineno;
196: head->filename = filename;
197: head->functionname = function;
198: head->classid = CLASSID_VALUE;
199: *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
201: TRallocated += nsize;
202: if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
203: TRfrags++;
205: #if defined(PETSC_USE_DEBUG)
206: if (PetscStackActive()) {
207: PetscStackCopy(petscstack,&head->stack);
209: head->stack.line[head->stack.currentsize-2] = lineno;
210: } else {
211: head->stack.currentsize = 0;
212: }
213: #endif
215: /*
216: Allow logging of all mallocs made
217: */
218: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
219: if (!PetscLogMalloc) {
220: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
221: if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
223: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
224: if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
226: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
227: if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
228: }
229: PetscLogMallocLength[PetscLogMalloc] = nsize;
230: PetscLogMallocFile[PetscLogMalloc] = filename;
231: PetscLogMallocFunction[PetscLogMalloc++] = function;
232: }
233: *result = (void*)inew;
234: return(0);
235: }
238: /*
239: PetscTrFreeDefault - Free with tracing.
241: Input Parameters:
242: . a - pointer to a block allocated with PetscTrMalloc
243: . lineno - line number where used. Use __LINE__ for this
244: . file - file name where used. Use __FILE__ for this
245: */
246: PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
247: {
248: char *a = (char*)aa;
249: TRSPACE *head;
250: char *ahead;
252: PetscClassId *nend;
255: /* Do not try to handle empty blocks */
256: if (!a) return(0);
258: if (TRdebugLevel) {
259: PetscMallocValidate(line,function,file);
260: }
262: ahead = a;
263: a = a - sizeof(TrSPACE);
264: head = (TRSPACE*)a;
266: if (head->classid != CLASSID_VALUE) {
267: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
268: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
269: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
270: }
271: nend = (PetscClassId*)(ahead + head->size);
272: if (*nend != CLASSID_VALUE) {
273: if (*nend == ALREADY_FREED) {
274: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
275: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
276: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
277: (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
278: } else {
279: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
280: }
281: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
282: } else {
283: /* Damaged tail */
284: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
285: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
286: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
287: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
288: }
289: }
290: /* Mark the location freed */
291: *nend = ALREADY_FREED;
292: /* Save location where freed. If we suspect the line number, mark as allocated location */
293: if (line > 0 && line < 50000) {
294: head->lineno = line;
295: head->filename = file;
296: head->functionname = function;
297: } else {
298: head->lineno = -head->lineno;
299: }
300: /* zero out memory - helps to find some reuse of already freed memory */
301: PetscMemzero(aa,head->size);
303: TRallocated -= head->size;
304: TRfrags--;
305: if (head->prev) head->prev->next = head->next;
306: else TRhead = head->next;
308: if (head->next) head->next->prev = head->prev;
309: PetscFreeAlign(a,line,function,file);
310: return(0);
311: }
315: /*
316: PetscTrReallocDefault - Realloc with tracing.
318: Input Parameters:
319: + len - number of bytes to allocate
320: . lineno - line number where used. Use __LINE__ for this
321: . filename - file name where used. Use __FILE__ for this
322: - result - double aligned pointer to initial storage.
324: Output Parameter:
325: . result - double aligned pointer to requested storage, or null if not available.
327: Level: developer
329: .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
330: */
331: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
332: {
333: char *a = (char *) *result;
334: TRSPACE *head;
335: char *ahead, *inew;
336: PetscClassId *nend;
337: size_t nsize;
341: /* Realloc to zero = free */
342: if (!len) {
343: PetscTrFreeDefault(*result,lineno,function,filename);
344: *result = NULL;
345: return(0);
346: }
348: if (TRdebugLevel) {PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);}
350: ahead = a;
351: a = a - sizeof(TrSPACE);
352: head = (TRSPACE *) a;
353: inew = a;
355: if (head->classid != CLASSID_VALUE) {
356: (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
357: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
358: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
359: }
360: nend = (PetscClassId *)(ahead + head->size);
361: if (*nend != CLASSID_VALUE) {
362: if (*nend == ALREADY_FREED) {
363: (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
364: (*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: (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
367: } else {
368: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
369: }
370: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
371: } else {
372: /* Damaged tail */
373: (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
374: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
375: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
376: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
377: }
378: }
380: TRallocated -= head->size;
381: TRfrags--;
382: if (head->prev) head->prev->next = head->next;
383: else TRhead = head->next;
384: if (head->next) head->next->prev = head->prev;
386: nsize = (len + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
387: PetscReallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);
389: head = (TRSPACE*)inew;
390: inew += sizeof(TrSPACE);
392: if (TRhead) TRhead->prev = head;
393: head->next = TRhead;
394: TRhead = head;
395: head->prev = NULL;
396: head->size = nsize;
397: head->id = TRid;
398: head->lineno = lineno;
400: head->filename = filename;
401: head->functionname = function;
402: head->classid = CLASSID_VALUE;
403: *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
405: TRallocated += nsize;
406: if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
407: TRfrags++;
409: #if defined(PETSC_USE_DEBUG)
410: if (PetscStackActive()) {
411: PetscStackCopy(petscstack,&head->stack);
413: head->stack.line[head->stack.currentsize-2] = lineno;
414: } else {
415: head->stack.currentsize = 0;
416: }
417: #endif
419: /*
420: Allow logging of all mallocs made
421: */
422: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
423: if (!PetscLogMalloc) {
424: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
425: if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
427: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
428: if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
430: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
431: if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
432: }
433: PetscLogMallocLength[PetscLogMalloc] = nsize;
434: PetscLogMallocFile[PetscLogMalloc] = filename;
435: PetscLogMallocFunction[PetscLogMalloc++] = function;
436: }
437: *result = (void*)inew;
438: return(0);
439: }
442: /*@C
443: PetscMemoryView - Shows the amount of memory currently being used
444: in a communicator.
446: Collective on PetscViewer
448: Input Parameter:
449: + viewer - the viewer that defines the communicator
450: - message - string printed before values
452: Options Database:
453: + -malloc - have PETSc track how much memory it has allocated
454: - -memory_view - during PetscFinalize() have this routine called
456: Level: intermediate
458: Concepts: memory usage
460: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
461: @*/
462: PetscErrorCode PetscMemoryView(PetscViewer viewer,const char message[])
463: {
464: PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
465: PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
467: MPI_Comm comm;
470: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
471: PetscMallocGetCurrentUsage(&allocated);
472: PetscMallocGetMaximumUsage(&allocatedmax);
473: PetscMemoryGetCurrentUsage(&resident);
474: PetscMemoryGetMaximumUsage(&residentmax);
475: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
476: PetscObjectGetComm((PetscObject)viewer,&comm);
477: PetscViewerASCIIPrintf(viewer,message);
478: if (resident && residentmax && allocated) {
479: MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
480: MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
481: MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
482: PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory: total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
483: MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
484: MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
485: MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
486: PetscViewerASCIIPrintf(viewer,"Current process memory: total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
487: MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
488: MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
489: MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
490: PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
491: MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
492: MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
493: MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
494: 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: MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
497: MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
498: MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
499: PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory: total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
500: MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
501: MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
502: MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
503: PetscViewerASCIIPrintf(viewer,"Current process memory: total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
504: } else if (resident && allocated) {
505: MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
506: MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
507: MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
508: PetscViewerASCIIPrintf(viewer,"Current process memory: total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
509: MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
510: MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
511: MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
512: PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
513: PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
514: } else if (allocated) {
515: MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
516: MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
517: MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
518: PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
519: PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
520: PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
521: } else {
522: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
523: }
524: PetscViewerFlush(viewer);
525: return(0);
526: }
528: /*@
529: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
531: Not Collective
533: Output Parameters:
534: . space - number of bytes currently allocated
536: Level: intermediate
538: Concepts: memory usage
540: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
541: PetscMemoryGetMaximumUsage()
542: @*/
543: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
544: {
546: *space = (PetscLogDouble) TRallocated;
547: return(0);
548: }
550: /*@
551: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
552: during this run.
554: Not Collective
556: Output Parameters:
557: . space - maximum number of bytes ever allocated at one time
559: Level: intermediate
561: Concepts: memory usage
563: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
564: PetscMemoryGetCurrentUsage()
565: @*/
566: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
567: {
569: *space = (PetscLogDouble) TRMaxMem;
570: return(0);
571: }
573: #if defined(PETSC_USE_DEBUG)
574: /*@C
575: PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory
577: Collective on PETSC_COMM_WORLD
579: Input Parameter:
580: . ptr - the memory location
582: Output Paramter:
583: . stack - the stack indicating where the program allocated this memory
585: Level: intermediate
587: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
588: @*/
589: PetscErrorCode PetscMallocGetStack(void *ptr,PetscStack **stack)
590: {
591: TRSPACE *head;
594: head = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
595: *stack = &head->stack;
596: return(0);
597: }
598: #else
599: PetscErrorCode PetscMallocGetStack(void *ptr,void **stack)
600: {
602: *stack = NULL;
603: return(0);
604: }
605: #endif
607: /*@C
608: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
609: printed is: size of space (in bytes), address of space, id of space,
610: file in which space was allocated, and line number at which it was
611: allocated.
613: Collective on PETSC_COMM_WORLD
615: Input Parameter:
616: . fp - file pointer. If fp is NULL, stdout is assumed.
618: Options Database Key:
619: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
621: Level: intermediate
623: Fortran Note:
624: The calling sequence in Fortran is PetscMallocDump(integer ierr)
625: The fp defaults to stdout.
627: Notes:
628: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
629: has been freed.
631: Concepts: memory usage
632: Concepts: memory bleeding
633: Concepts: bleeding memory
635: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
636: @*/
637: PetscErrorCode PetscMallocDump(FILE *fp)
638: {
639: TRSPACE *head;
640: PetscInt libAlloc = 0;
642: PetscMPIInt rank;
645: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
646: if (!fp) fp = PETSC_STDOUT;
647: head = TRhead;
648: while (head) {
649: PetscBool isLib;
651: PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
652: libAlloc += head->size;
653: head = head->next;
654: }
655: if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
656: head = TRhead;
657: while (head) {
658: PetscBool isLib;
660: PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
661: if (!isLib) {
662: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
663: #if defined(PETSC_USE_DEBUG)
664: PetscStackPrint(&head->stack,fp);
665: #endif
666: }
667: head = head->next;
668: }
669: return(0);
670: }
672: /* ---------------------------------------------------------------------------- */
674: /*@
675: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
677: Not Collective
679: Options Database Key:
680: + -malloc_log <filename> - Activates PetscMallocDumpLog()
681: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
683: Level: advanced
685: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
686: @*/
687: PetscErrorCode PetscMallocSetDumpLog(void)
688: {
692: PetscLogMalloc = 0;
694: PetscMemorySetGetMaximumUsage();
695: return(0);
696: }
698: /*@
699: PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().
701: Not Collective
703: Input Arguments:
704: . logmin - minimum allocation size to log, or PETSC_DEFAULT
706: Options Database Key:
707: + -malloc_log <filename> - Activates PetscMallocDumpLog()
708: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
710: Level: advanced
712: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
713: @*/
714: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
715: {
719: PetscMallocSetDumpLog();
720: if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
721: PetscLogMallocThreshold = (size_t)logmin;
722: return(0);
723: }
725: /*@
726: PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged
728: Not Collective
730: Output Arguments
731: . logging - PETSC_TRUE if logging is active
733: Options Database Key:
734: . -malloc_log - Activates PetscMallocDumpLog()
736: Level: advanced
738: .seealso: PetscMallocDump(), PetscMallocDumpLog()
739: @*/
740: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
741: {
744: *logging = (PetscBool)(PetscLogMalloc >= 0);
745: return(0);
746: }
748: /*@C
749: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
750: PetscMemoryGetMaximumUsage()
752: Collective on PETSC_COMM_WORLD
754: Input Parameter:
755: . fp - file pointer; or NULL
757: Options Database Key:
758: . -malloc_log - Activates PetscMallocDumpLog()
760: Level: advanced
762: Fortran Note:
763: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
764: The fp defaults to stdout.
766: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
767: @*/
768: PetscErrorCode PetscMallocDumpLog(FILE *fp)
769: {
770: PetscInt i,j,n,dummy,*perm;
771: size_t *shortlength;
772: int *shortcount,err;
773: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
774: PetscBool match;
775: const char **shortfunction;
776: PetscLogDouble rss;
777: MPI_Status status;
781: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
782: MPI_Comm_size(MPI_COMM_WORLD,&size);
783: /*
784: Try to get the data printed in order by processor. This will only sometimes work
785: */
786: err = fflush(fp);
787: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
789: MPI_Barrier(MPI_COMM_WORLD);
790: if (rank) {
791: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
792: }
794: if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"PetscMallocDumpLog() called without call to PetscMallocSetDumpLog() this is often due to\n setting the option -malloc_log AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");
796: if (!fp) fp = PETSC_STDOUT;
797: PetscMemoryGetMaximumUsage(&rss);
798: if (rss) {
799: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
800: } else {
801: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
802: }
803: shortcount = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
804: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
805: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
806: for (i=0,n=0; i<PetscLogMalloc; i++) {
807: for (j=0; j<n; j++) {
808: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
809: if (match) {
810: shortlength[j] += PetscLogMallocLength[i];
811: shortcount[j]++;
812: goto foundit;
813: }
814: }
815: shortfunction[n] = PetscLogMallocFunction[i];
816: shortlength[n] = PetscLogMallocLength[i];
817: shortcount[n] = 1;
818: n++;
819: foundit:;
820: }
822: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
823: for (i=0; i<n; i++) perm[i] = i;
824: PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);
826: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
827: for (i=0; i<n; i++) {
828: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
829: }
830: free(perm);
831: free(shortlength);
832: free(shortcount);
833: free((char**)shortfunction);
834: err = fflush(fp);
835: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
836: if (rank != size-1) {
837: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
838: }
839: return(0);
840: }
842: /* ---------------------------------------------------------------------------- */
844: /*@
845: PetscMallocDebug - Turns on/off debugging for the memory management routines.
847: Not Collective
849: Input Parameter:
850: . level - PETSC_TRUE or PETSC_FALSE
852: Level: intermediate
854: .seealso: CHKMEMQ(), PetscMallocValidate()
855: @*/
856: PetscErrorCode PetscMallocDebug(PetscBool level)
857: {
859: TRdebugLevel = level;
860: return(0);
861: }
863: /*@
864: PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.
866: Not Collective
868: Output Parameter:
869: . flg - PETSC_TRUE if any debugger
871: Level: intermediate
873: Note that by default, the debug version always does some debugging unless you run with -malloc no
876: .seealso: CHKMEMQ(), PetscMallocValidate()
877: @*/
878: PetscErrorCode PetscMallocGetDebug(PetscBool *flg)
879: {
881: if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
882: else *flg = PETSC_FALSE;
883: return(0);
884: }