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 PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
21: EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[],const char[]);
22: EXTERN PetscErrorCode PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
23: EXTERN PetscErrorCode 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 PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
125: {
126: TRSPACE *head,*lasthead;
127: char *a;
128: unsigned long *nend;
131: head = TRhead; lasthead = NULL;
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: if (lasthead)
138: (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s%s\n",lasthead->functionname,lasthead->lineno,lasthead->dirname,lasthead->filename);
139: SETERRQ(PETSC_ERR_MEMC," ");
140: }
141: a = (char *)(((TrSPACE*)head) + 1);
142: nend = (unsigned long *)(a + head->size);
143: if (*nend != COOKIE_VALUE) {
144: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
145: if (*nend == ALREADY_FREED) {
146: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
147: SETERRQ(PETSC_ERR_MEMC," ");
148: } else {
149: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
150: (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
151: SETERRQ(PETSC_ERR_MEMC," ");
152: }
153: }
154: lasthead = head;
155: head = head->next;
156: }
157: return(0);
158: }
162: /*
163: PetscTrMallocDefault - Malloc with tracing.
165: Input Parameters:
166: + a - number of bytes to allocate
167: . lineno - line number where used. Use __LINE__ for this
168: . function - function calling routine. Use __FUNCT__ for this
169: . filename - file name where used. Use __FILE__ for this
170: - dir - directory where file is. Use __SDIR__ for this
172: Returns:
173: double aligned pointer to requested storage, or null if not
174: available.
175: */
176: PetscErrorCode PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
177: {
178: TRSPACE *head;
179: char *inew;
180: size_t nsize;
184: if (!a) {
185: SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to malloc zero size array");
186: }
188: if (TRdebugLevel) {
189: PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
190: }
192: nsize = a;
193: if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
194: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscScalar),lineno,function,filename,dir,(void**)&inew);
196: head = (TRSPACE *)inew;
197: inew += sizeof(TrSPACE);
199: if (TRhead) TRhead->prev = head;
200: head->next = TRhead;
201: TRhead = head;
202: head->prev = 0;
203: head->size = nsize;
204: head->id = TRid;
205: head->lineno = lineno;
207: head->filename = filename;
208: head->functionname = function;
209: head->dirname = dir;
210: head->cookie = COOKIE_VALUE;
211: *(unsigned long *)(inew + nsize) = COOKIE_VALUE;
213: TRallocated += nsize;
214: if (TRallocated > TRMaxMem) {
215: TRMaxMem = TRallocated;
216: }
217: TRfrags++;
219: #if defined(PETSC_USE_DEBUG)
220: PetscStackCopy(petscstack,&head->stack);
221: #endif
223: /*
224: Allow logging of all mallocs made
225: */
226: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
227: if (!PetscLogMalloc) {
228: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
229: if (!PetscLogMallocLength) SETERRQ(PETSC_ERR_MEM," ");
230: PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
231: if (!PetscLogMallocDirectory) SETERRQ(PETSC_ERR_MEM," ");
232: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
233: if (!PetscLogMallocFile) SETERRQ(PETSC_ERR_MEM," ");
234: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
235: if (!PetscLogMallocFunction) SETERRQ(PETSC_ERR_MEM," ");
236: }
237: PetscLogMallocLength[PetscLogMalloc] = nsize;
238: PetscLogMallocDirectory[PetscLogMalloc] = dir;
239: PetscLogMallocFile[PetscLogMalloc] = filename;
240: PetscLogMallocFunction[PetscLogMalloc++] = function;
241: }
242: *result = (void*)inew;
243: return(0);
244: }
249: /*
250: PetscTrFreeDefault - Free with tracing.
252: Input Parameters:
253: . a - pointer to a block allocated with PetscTrMalloc
254: . lineno - line number where used. Use __LINE__ for this
255: . function - function calling routine. Use __FUNCT__ for this
256: . file - file name where used. Use __FILE__ for this
257: . dir - directory where file is. Use __SDIR__ for this
258: */
259: PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
260: {
261: char *a = (char*)aa;
262: TRSPACE *head;
263: char *ahead;
265: unsigned long *nend;
266:
268: /* Do not try to handle empty blocks */
269: if (!a) {
270: (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
271: SETERRQ4(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s%s\n",function,line,dir,file);
272: }
273:
274: if (TRdebugLevel) {
275: PetscMallocValidate(line,function,file,dir);
276: }
277:
278: ahead = a;
279: a = a - sizeof(TrSPACE);
280: head = (TRSPACE *)a;
281:
282: if (head->cookie != COOKIE_VALUE) {
283: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
284: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
285: SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
286: }
287: nend = (unsigned long *)(ahead + head->size);
288: if (*nend != COOKIE_VALUE) {
289: if (*nend == ALREADY_FREED) {
290: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
291: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
292: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
293: (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
294: } else {
295: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
296: }
297: SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
298: } else {
299: /* Damaged tail */
300: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
301: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
302: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
303: SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
304: }
305: }
306: /* Mark the location freed */
307: *nend = ALREADY_FREED;
308: /* Save location where freed. If we suspect the line number, mark as allocated location */
309: if (line > 0 && line < 50000) {
310: head->lineno = line;
311: head->filename = file;
312: head->functionname = function;
313: head->dirname = dir;
314: } else {
315: head->lineno = - head->lineno;
316: }
317: /* zero out memory - helps to find some reuse of already freed memory */
318: PetscMemzero(aa,head->size);
319:
320: TRallocated -= head->size;
321: TRfrags --;
322: if (head->prev) head->prev->next = head->next;
323: else TRhead = head->next;
324:
325: if (head->next) head->next->prev = head->prev;
326: PetscFreeAlign(a,line,function,file,dir);
327: return(0);
328: }
333: /*@
334: PetscMemoryShowUsage - Shows the amount of memory currently being used
335: in a communicator.
336:
337: Collective on PetscViewer
339: Input Parameter:
340: + viewer - the viewer that defines the communicator
341: - message - string printed before values
343: Level: intermediate
345: Concepts: memory usage
347: .seealso: PetscMemoryDump(), PetscMemoryGetCurrentUsage()
348: @*/
349: PetscErrorCode PetscMemoryShowUsage(PetscViewer viewer,const char message[])
350: {
351: PetscLogDouble allocated,maximum,resident,residentmax;
353: PetscMPIInt rank;
354: MPI_Comm comm;
357: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
358: PetscMallocGetCurrentUsage(&allocated);
359: PetscMallocGetMaximumUsage(&maximum);
360: PetscMemoryGetCurrentUsage(&resident);
361: PetscMemoryGetMaximumUsage(&residentmax);
362: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
363: PetscObjectGetComm((PetscObject)viewer,&comm);
364: MPI_Comm_rank(comm,&rank);
365: PetscViewerASCIIPrintf(viewer,message);
366: if (resident && residentmax && allocated) {
367: 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);
368: } else if (resident && residentmax) {
369: 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);
370: } else if (resident && allocated) {
371: 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);
372: } else if (allocated) {
373: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
374: } else {
375: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
376: }
377: PetscViewerFlush(viewer);
378: return(0);
379: }
383: /*@C
384: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
385:
386: Not Collective
388: Output Parameters:
389: . space - number of bytes currently allocated
391: Level: intermediate
393: Concepts: memory usage
395: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
396: PetscMemoryGetMaximumUsage()
397: @*/
398: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
399: {
401: *space = (PetscLogDouble) TRallocated;
402: return(0);
403: }
407: /*@C
408: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
409: during this run.
410:
411: Not Collective
413: Output Parameters:
414: . space - maximum number of bytes ever allocated at one time
416: Level: intermediate
418: Concepts: memory usage
420: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
421: PetscMemoryGetCurrentUsage()
422: @*/
423: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
424: {
426: *space = (PetscLogDouble) TRMaxMem;
427: return(0);
428: }
432: /*@C
433: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
434: printed is: size of space (in bytes), address of space, id of space,
435: file in which space was allocated, and line number at which it was
436: allocated.
438: Collective on PETSC_COMM_WORLD
440: Input Parameter:
441: . fp - file pointer. If fp is NULL, stdout is assumed.
443: Options Database Key:
444: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
446: Level: intermediate
448: Fortran Note:
449: The calling sequence in Fortran is PetscMallocDump(integer ierr)
450: The fp defaults to stdout.
452: Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
453: has been freed.
455: Concepts: memory usage
456: Concepts: memory bleeding
457: Concepts: bleeding memory
459: .seealso: PetscMallocGetCurrentSize(), PetscMallocDumpLog()
460: @*/
461: PetscErrorCode PetscMallocDump(FILE *fp)
462: {
463: TRSPACE *head;
465: PetscMPIInt rank;
468: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
469: if (!fp) fp = stdout;
470: if (TRallocated > 0) {
471: fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
472: }
473: head = TRhead;
474: while (head) {
475: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
476: #if defined(PETSC_USE_DEBUG)
477: PetscStackPrint(&head->stack,fp);
478: #endif
479: head = head->next;
480: }
481: return(0);
482: }
484: /* ---------------------------------------------------------------------------- */
488: /*@C
489: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
491: Not Collective
493: Options Database Key:
494: . -malloc_log - Activates PetscMallocDumpLog()
496: Level: advanced
498: .seealso: PetscMallocDump(), PetscMallocDumpLog()
499: @*/
500: PetscErrorCode PetscMallocSetDumpLog(void)
501: {
503: PetscLogMalloc = 0;
504: return(0);
505: }
509: /*@C
510: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
511: PetscMemoryGetCurrentUsage() and PetscMemoryGetMaximumUsage()
513: Collective on PETSC_COMM_WORLD
515: Input Parameter:
516: . fp - file pointer; or PETSC_NULL
518: Options Database Key:
519: . -malloc_log - Activates PetscMallocDumpLog()
521: Level: advanced
523: Fortran Note:
524: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
525: The fp defaults to stdout.
527: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
528: @*/
529: PetscErrorCode PetscMallocDumpLog(FILE *fp)
530: {
531: PetscInt i,j,n,dummy,*perm;
532: size_t *shortlength;
533: int *shortcount;
534: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
535: PetscTruth match;
536: const char **shortfunction;
537: PetscLogDouble rss;
538: MPI_Status status;
542: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
543: MPI_Comm_size(MPI_COMM_WORLD,&size);
544: /*
545: Try to get the data printed in order by processor. This will only sometimes work
546: */
547: fflush(fp);
548: MPI_Barrier(MPI_COMM_WORLD);
549: if (rank) {
550: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
551: }
553: if (!fp) fp = stdout;
554: PetscMemoryGetCurrentUsage(&rss);
555: if (rss) {
556: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %D\n",rank,(PetscLogDouble)TRMaxMem,rss);
557: } else {
558: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
559: }
560: shortcount = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_ERR_MEM,"Out of memory");
561: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_ERR_MEM,"Out of memory");
562: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_ERR_MEM,"Out of memory");
563: shortfunction[0] = PetscLogMallocFunction[0];
564: shortlength[0] = PetscLogMallocLength[0];
565: shortcount[0] = 0;
566: n = 1;
567: for (i=1; i<PetscLogMalloc; i++) {
568: for (j=0; j<n; j++) {
569: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
570: if (match) {
571: shortlength[j] += PetscLogMallocLength[i];
572: shortcount[j]++;
573: goto foundit;
574: }
575: }
576: shortfunction[n] = PetscLogMallocFunction[i];
577: shortlength[n] = PetscLogMallocLength[i];
578: shortcount[n] = 1;
579: n++;
580: foundit:;
581: }
583: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_ERR_MEM,"Out of memory");
584: for (i=0; i<n; i++) perm[i] = i;
585: PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);
587: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
588: for (i=0; i<n; i++) {
589: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
590: }
591: free(perm);
592: free(shortlength);
593: free(shortcount);
594: free((char **)shortfunction);
595: fflush(fp);
596: if (rank != size-1) {
597: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
598: }
599: return(0);
600: }
602: /* ---------------------------------------------------------------------------- */
606: /*@C
607: PetscMallocDebug - Turns on/off debugging for the memory management routines.
609: Not Collective
611: Input Parameter:
612: . level - PETSC_TRUE or PETSC_FALSE
614: Level: intermediate
616: .seealso: CHKMEMQ(), PetscMallocValidate()
617: @*/
618: PetscErrorCode PetscMallocDebug(PetscTruth level)
619: {
621: TRdebugLevel = level;
622: return(0);
623: }