Actual source code: mtr.c
1: #define PETSC_DLL
2: /*
3: Interface to malloc() and free(). This code allows for
4: logging of memory usage and some error checking
5: */
6: #include petsc.h
7: #include petscsys.h
8: #if defined(PETSC_HAVE_STDLIB_H)
9: #include <stdlib.h>
10: #endif
11: #if defined(PETSC_HAVE_MALLOC_H)
12: #include <malloc.h>
13: #endif
14: #include "petscfix.h"
17: /*
18: These are defined in mal.c and ensure that malloced space is PetscScalar aligned
19: */
20: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
21: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscFreeAlign(void*,int,const char[],const char[],const char[]);
22: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
23: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void*,int,const char[],const char[],const char[]);
27: PetscErrorCode PetscSetUseTrMalloc_Private(void)
28: {
32: PetscSetMalloc(PetscTrMallocDefault,PetscTrFreeDefault);
33: return(0);
34: }
36: #if (PETSC_SIZEOF_VOID_P == 8)
37: #define TR_ALIGN_BYTES 8
38: #define TR_ALIGN_MASK 0x7
39: #else
40: #define TR_ALIGN_BYTES 4
41: #define TR_ALIGN_MASK 0x3
42: #endif
44: #define COOKIE_VALUE 0xf0e0d0c9
45: #define ALREADY_FREED 0x0f0e0d9c
46: #define MAX_TR_STACK 20
47: #define TR_MALLOC 0x1
48: #define TR_FREE 0x2
50: typedef struct _trSPACE {
51: size_t size;
52: int id;
53: int lineno;
54: const char *filename;
55: const char *functionname;
56: const char *dirname;
57: unsigned long cookie;
58: #if defined(PETSC_USE_DEBUG)
59: PetscStack stack;
60: #endif
61: struct _trSPACE *next,*prev;
62: } TRSPACE;
64: /* HEADER_DOUBLES is the number of doubles in a PetscMalloc() header */
65: /* We have to be careful about alignment rules here */
67: #define HEADER_DOUBLES sizeof(TRSPACE)/sizeof(double)+1
70: /* This union is used to insure that the block passed to the user is
71: aligned on a double boundary */
72: typedef union {
73: TRSPACE sp;
74: double v[HEADER_DOUBLES];
75: } TrSPACE;
77: static size_t TRallocated = 0;
78: static int TRfrags = 0;
79: static TRSPACE *TRhead = 0;
80: static int TRid = 0;
81: static PetscTruth TRdebugLevel = PETSC_FALSE;
82: static size_t TRMaxMem = 0;
83: /*
84: Arrays to log information on all Mallocs
85: */
86: static int PetscLogMallocMax = 10000,PetscLogMalloc = -1;
87: static size_t *PetscLogMallocLength;
88: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;
92: /*@C
93: PetscMallocValidate - Test the memory for corruption. This can be used to
94: check for memory overwrites.
96: Input Parameter:
97: + line - line number where call originated.
98: . function - name of function calling
99: . file - file where function is
100: - dir - directory where function is
102: Return value:
103: The number of errors detected.
104:
105: Output Effect:
106: Error messages are written to stdout.
108: Level: advanced
110: Notes:
111: You should generally use CHKMEMQ as a short cut for calling this
112: routine.
114: The line, function, file and dir are given by the C preprocessor as
115: __LINE__, __FUNCT__, __FILE__, and __DIR__
117: The Fortran calling sequence is simply PetscMallocValidate(ierr)
119: No output is generated if there are no problems detected.
121: .seealso: CHKMEMQ
123: @*/
124: PetscErrorCode PETSC_DLLEXPORT PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
125: {
126: TRSPACE *head;
127: char *a;
128: unsigned long *nend;
131: head = TRhead;
132: while (head) {
133: if (head->cookie != COOKIE_VALUE) {
134: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
135: (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
136: (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
137: SETERRQ(PETSC_ERR_MEMC," ");
138: }
139: a = (char *)(((TrSPACE*)head) + 1);
140: nend = (unsigned long *)(a + head->size);
141: if (*nend != COOKIE_VALUE) {
142: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
143: if (*nend == ALREADY_FREED) {
144: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
145: SETERRQ(PETSC_ERR_MEMC," ");
146: } else {
147: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
148: (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
149: SETERRQ(PETSC_ERR_MEMC," ");
150: }
151: }
152: head = head->next;
153: }
154: return(0);
155: }
159: /*
160: PetscTrMallocDefault - Malloc with tracing.
162: Input Parameters:
163: + a - number of bytes to allocate
164: . lineno - line number where used. Use __LINE__ for this
165: . function - function calling routine. Use __FUNCT__ for this
166: . filename - file name where used. Use __FILE__ for this
167: - dir - directory where file is. Use __SDIR__ for this
169: Returns:
170: double aligned pointer to requested storage, or null if not
171: available.
172: */
173: PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
174: {
175: TRSPACE *head;
176: char *inew;
177: size_t nsize;
181: if (TRdebugLevel) {
182: PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
183: }
184: if (!a) SETERRQ(PETSC_ERR_MEM_MALLOC_0,"Cannot malloc size zero");
186: nsize = a;
187: if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
188: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscScalar),lineno,function,filename,dir,(void**)&inew);
190: head = (TRSPACE *)inew;
191: inew += sizeof(TrSPACE);
193: if (TRhead) TRhead->prev = head;
194: head->next = TRhead;
195: TRhead = head;
196: head->prev = 0;
197: head->size = nsize;
198: head->id = TRid;
199: head->lineno = lineno;
201: head->filename = filename;
202: head->functionname = function;
203: head->dirname = dir;
204: head->cookie = COOKIE_VALUE;
205: *(unsigned long *)(inew + nsize) = COOKIE_VALUE;
207: TRallocated += nsize;
208: if (TRallocated > TRMaxMem) {
209: TRMaxMem = TRallocated;
210: }
211: TRfrags++;
213: #if defined(PETSC_USE_DEBUG)
214: PetscStackCopy(petscstack,&head->stack);
215: #endif
217: /*
218: Allow logging of all mallocs made
219: */
220: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
221: if (!PetscLogMalloc) {
222: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
223: if (!PetscLogMallocLength) SETERRQ(PETSC_ERR_MEM," ");
224: PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
225: if (!PetscLogMallocDirectory) SETERRQ(PETSC_ERR_MEM," ");
226: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
227: if (!PetscLogMallocFile) SETERRQ(PETSC_ERR_MEM," ");
228: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
229: if (!PetscLogMallocFunction) SETERRQ(PETSC_ERR_MEM," ");
230: }
231: PetscLogMallocLength[PetscLogMalloc] = nsize;
232: PetscLogMallocDirectory[PetscLogMalloc] = dir;
233: PetscLogMallocFile[PetscLogMalloc] = filename;
234: PetscLogMallocFunction[PetscLogMalloc++] = function;
235: }
236: *result = (void*)inew;
237: return(0);
238: }
243: /*
244: PetscTrFreeDefault - Free with tracing.
246: Input Parameters:
247: . a - pointer to a block allocated with PetscTrMalloc
248: . lineno - line number where used. Use __LINE__ for this
249: . function - function calling routine. Use __FUNCT__ for this
250: . file - file name where used. Use __FILE__ for this
251: . dir - directory where file is. Use __SDIR__ for this
252: */
253: PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
254: {
255: char *a = (char*)aa;
256: TRSPACE *head;
257: char *ahead;
259: unsigned long *nend;
260:
262: /* Do not try to handle empty blocks */
263: if (!a) {
264: (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
265: SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block");
266: }
267:
268: if (TRdebugLevel) {
269: PetscMallocValidate(line,function,file,dir);
270: }
271:
272: ahead = a;
273: a = a - sizeof(TrSPACE);
274: head = (TRSPACE *)a;
275:
276: if (head->cookie != COOKIE_VALUE) {
277: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
278: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
279: SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
280: }
281: nend = (unsigned long *)(ahead + head->size);
282: if (*nend != COOKIE_VALUE) {
283: if (*nend == ALREADY_FREED) {
284: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
285: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
286: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
287: (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
288: } else {
289: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
290: }
291: SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
292: } else {
293: /* Damaged tail */
294: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
295: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
296: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
297: SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
298: }
299: }
300: /* Mark the location freed */
301: *nend = ALREADY_FREED;
302: /* Save location where freed. If we suspect the line number, mark as allocated location */
303: if (line > 0 && line < 50000) {
304: head->lineno = line;
305: head->filename = file;
306: head->functionname = function;
307: head->dirname = dir;
308: } else {
309: head->lineno = - head->lineno;
310: }
311: /* zero out memory - helps to find some reuse of already freed memory */
312: PetscMemzero(aa,head->size);
313:
314: TRallocated -= head->size;
315: TRfrags --;
316: if (head->prev) head->prev->next = head->next;
317: else TRhead = head->next;
318:
319: if (head->next) head->next->prev = head->prev;
320: PetscFreeAlign(a,line,function,file,dir);
321: return(0);
322: }
327: /*@
328: PetscMemoryShowUsage - Shows the amount of memory currently being used
329: in a communicator.
330:
331: Collective on PetscViewer
333: Input Parameter:
334: + viewer - the viewer that defines the communicator
335: - message - string printed before values
337: Level: intermediate
339: Concepts: memory usage
341: .seealso: PetscMemoryDump(), PetscMemoryGetCurrentUsage()
342: @*/
343: PetscErrorCode PETSC_DLLEXPORT PetscMemoryShowUsage(PetscViewer viewer,const char message[])
344: {
345: PetscLogDouble allocated,maximum,resident,residentmax;
347: PetscMPIInt rank;
348: MPI_Comm comm;
351: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
352: PetscMallocGetCurrentUsage(&allocated);
353: PetscMallocGetMaximumUsage(&maximum);
354: PetscMemoryGetCurrentUsage(&resident);
355: PetscMemoryGetMaximumUsage(&residentmax);
356: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
357: PetscObjectGetComm((PetscObject)viewer,&comm);
358: MPI_Comm_rank(comm,&rank);
359: PetscViewerASCIIPrintf(viewer,message);
360: if (resident && residentmax && allocated) {
361: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g max process memory %g\n",rank,allocated,maximum,rank,resident,residentmax);
362: } else if (resident && residentmax) {
363: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Run with -malloc to get statistics on PetscMalloc() calls\n[%d]Current process memory %g max process memory %g\n",rank,rank,resident,residentmax);
364: } else if (resident && allocated) {
365: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g, run with -memory_info to get max memory usage\n",rank,allocated,maximum,rank,resident);
366: } else if (allocated) {
367: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
368: } else {
369: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
370: }
371: PetscViewerFlush(viewer);
372: return(0);
373: }
377: /*@C
378: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
379:
380: Not Collective
382: Output Parameters:
383: . space - number of bytes currently allocated
385: Level: intermediate
387: Concepts: memory usage
389: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
390: PetscMemoryGetMaximumUsage()
391: @*/
392: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetCurrentUsage(PetscLogDouble *space)
393: {
395: *space = (PetscLogDouble) TRallocated;
396: return(0);
397: }
401: /*@C
402: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
403: during this run.
404:
405: Not Collective
407: Output Parameters:
408: . space - maximum number of bytes ever allocated at one time
410: Level: intermediate
412: Concepts: memory usage
414: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
415: PetscMemoryGetCurrentUsage()
416: @*/
417: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetMaximumUsage(PetscLogDouble *space)
418: {
420: *space = (PetscLogDouble) TRMaxMem;
421: return(0);
422: }
426: /*@C
427: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
428: printed is: size of space (in bytes), address of space, id of space,
429: file in which space was allocated, and line number at which it was
430: allocated.
432: Collective on PETSC_COMM_WORLD
434: Input Parameter:
435: . fp - file pointer. If fp is NULL, stdout is assumed.
437: Options Database Key:
438: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
440: Level: intermediate
442: Fortran Note:
443: The calling sequence in Fortran is PetscMallocDump(integer ierr)
444: The fp defaults to stdout.
446: Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
447: has been freed.
449: Concepts: memory usage
450: Concepts: memory bleeding
451: Concepts: bleeding memory
453: .seealso: PetscMallocGetCurrentSize(), PetscMallocDumpLog()
454: @*/
455: PetscErrorCode PETSC_DLLEXPORT PetscMallocDump(FILE *fp)
456: {
457: TRSPACE *head;
459: PetscMPIInt rank;
462: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
463: if (!fp) fp = stdout;
464: if (TRallocated > 0) {
465: fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
466: }
467: head = TRhead;
468: while (head) {
469: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
470: #if defined(PETSC_USE_DEBUG)
471: PetscStackPrint(&head->stack,fp);
472: #endif
473: head = head->next;
474: }
475: return(0);
476: }
478: /* ---------------------------------------------------------------------------- */
482: /*@C
483: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
485: Not Collective
487: Options Database Key:
488: . -malloc_log - Activates PetscMallocDumpLog()
490: Level: advanced
492: .seealso: PetscMallocDump(), PetscMallocDumpLog()
493: @*/
494: PetscErrorCode PETSC_DLLEXPORT PetscMallocSetDumpLog(void)
495: {
497: PetscLogMalloc = 0;
498: return(0);
499: }
503: /*@C
504: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
505: PetscMemoryGetCurrentUsage() and PetscMemoryGetMaximumUsage()
507: Collective on PETSC_COMM_WORLD
509: Input Parameter:
510: . fp - file pointer; or PETSC_NULL
512: Options Database Key:
513: . -malloc_log - Activates PetscMallocDumpLog()
515: Level: advanced
517: Fortran Note:
518: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
519: The fp defaults to stdout.
521: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
522: @*/
523: PetscErrorCode PETSC_DLLEXPORT PetscMallocDumpLog(FILE *fp)
524: {
525: PetscInt i,j,n,dummy,*perm;
526: size_t *shortlength;
527: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
528: PetscTruth match;
529: const char **shortfunction;
530: PetscLogDouble rss;
531: MPI_Status status;
535: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
536: MPI_Comm_size(MPI_COMM_WORLD,&size);
537: /*
538: Try to get the data printed in order by processor. This will only sometimes work
539: */
540: fflush(fp);
541: MPI_Barrier(MPI_COMM_WORLD);
542: if (rank) {
543: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
544: }
546: if (!fp) fp = stdout;
547: PetscMemoryGetCurrentUsage(&rss);
548: if (rss) {
549: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %D\n",rank,(PetscLogDouble)TRMaxMem,rss);
550: } else {
551: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
552: }
553: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_ERR_MEM,"Out of memory");
554: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_ERR_MEM,"Out of memory");
555: shortfunction[0] = PetscLogMallocFunction[0];
556: shortlength[0] = PetscLogMallocLength[0];
557: n = 1;
558: for (i=1; i<PetscLogMalloc; i++) {
559: for (j=0; j<n; j++) {
560: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
561: if (match) {
562: shortlength[j] += PetscLogMallocLength[i];
563: goto foundit;
564: }
565: }
566: shortfunction[n] = PetscLogMallocFunction[i];
567: shortlength[n] = PetscLogMallocLength[i];
568: n++;
569: foundit:;
570: }
572: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_ERR_MEM,"Out of memory");
573: for (i=0; i<n; i++) perm[i] = i;
574: PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);
576: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
577: for (i=0; i<n; i++) {
578: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %.0f %s()\n",rank,(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
579: }
580: free(perm);
581: free(shortlength);
582: free((char **)shortfunction);
583: fflush(fp);
584: if (rank != size-1) {
585: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
586: }
587: return(0);
588: }
590: /* ---------------------------------------------------------------------------- */
594: /*@C
595: PetscMallocDebug - Turns on/off debugging for the memory management routines.
597: Not Collective
599: Input Parameter:
600: . level - PETSC_TRUE or PETSC_FALSE
602: Level: intermediate
604: .seealso: CHKMEMQ(), PetscMallocValidate()
605: @*/
606: PetscErrorCode PETSC_DLLEXPORT PetscMallocDebug(PetscTruth level)
607: {
609: TRdebugLevel = level;
610: return(0);
611: }