Actual source code: mtr.c

  1: /*$Id: mtr.c,v 1.157 2001/08/07 03:02:00 balay Exp $*/
  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) && !defined(__cplusplus)
 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 int   PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
 21: EXTERN int   PetscFreeAlign(void*,int,const char[],const char[],const char[]);
 22: EXTERN int   PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
 23: EXTERN int   PetscTrFreeDefault(void*,int,const char[],const char[],const char[]);

 25: /*
 26:   Code for checking if a pointer is out of the range 
 27:   of malloced memory. This will only work on flat memory models and 
 28:   even then is suspicious.
 29: */
 30: #if (PETSC_SIZEOF_VOID_P == 8)
 31: void *PetscLow = (void*)0x0 ,*PetscHigh = (void*)0xEEEEEEEEEEEEEEEE;
 32: #else
 33: void *PetscLow  = (void*)0x0,*PetscHigh = (void*)0xEEEEEEEE;
 34: #endif

 38: int PetscSetUseTrMalloc_Private(void)
 39: {

 43: #if (PETSC_SIZEOF_VOID_P == 8)
 44:   PetscLow     = (void*)0xEEEEEEEEEEEEEEEE;
 45: #else
 46:   PetscLow     = (void*)0xEEEEEEEE;
 47: #endif
 48:   PetscHigh    = (void*)0x0;
 49:   PetscSetMalloc(PetscTrMallocDefault,PetscTrFreeDefault);
 50:   return(0);
 51: }

 53: /*
 54:     PetscTrSpace - Routines for tracing space usage.

 56:     Description:
 57:     PetscTrMalloc replaces malloc and PetscTrFree replaces free.  These routines
 58:     have the same syntax and semantics as the routines that they replace,
 59:     In addition, there are routines to report statistics on the memory
 60:     usage, and to report the currently allocated space.  These routines
 61:     are built on top of malloc and free, and can be used together with
 62:     them as long as any space allocated with PetscTrMalloc is only freed with
 63:     PetscTrFree.
 64:  */


 67: #if (PETSC_SIZEOF_VOID_P == 8)
 68: #define TR_ALIGN_BYTES      8
 69: #define TR_ALIGN_MASK       0x7
 70: #else
 71: #define TR_ALIGN_BYTES      4
 72: #define TR_ALIGN_MASK       0x3
 73: #endif

 75: #define COOKIE_VALUE   0xf0e0d0c9
 76: #define ALREADY_FREED  0x0f0e0d9c
 77: #define MAX_TR_STACK   20
 78: #define TR_MALLOC      0x1
 79: #define TR_FREE        0x2

 81: typedef struct _trSPACE {
 82:     unsigned long   size;
 83:     int             id;
 84:     int             lineno;
 85:     const char      *filename;
 86:     const char      *functionname;
 87:     const char      *dirname;
 88:     unsigned long   cookie;
 89: #if defined(PETSC_USE_STACK)
 90:     PetscStack      stack;
 91: #endif
 92:     struct _trSPACE *next,*prev;
 93: } TRSPACE;

 95: /* HEADER_DOUBLES is the number of doubles in a PetscTrSpace header */
 96: /* We have to be careful about alignment rules here */

 98: #define HEADER_DOUBLES      sizeof(TRSPACE)/sizeof(double)+1


101: /* This union is used to insure that the block passed to the user is
102:    aligned on a double boundary */
103: typedef union {
104:     TRSPACE sp;
105:     double  v[HEADER_DOUBLES];
106: } TrSPACE;

108: static long    TRallocated    = 0,TRfrags = 0;
109: static TRSPACE *TRhead      = 0;
110: static int     TRid         = 0;
111: static int     TRdebugLevel = 0;
112: static long    TRMaxMem     = 0;
113: /*
114:       Arrays to log information on all Mallocs
115: */
116: static int  PetscLogMallocMax = 10000,PetscLogMalloc = -1,*PetscLogMallocLength;
117: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;

121: /*@C
122:    PetscTrValid - Test the memory for corruption.  This can be used to
123:    check for memory overwrites.

125:    Input Parameter:
126: +  line - line number where call originated.
127: .  function - name of function calling
128: .  file - file where function is
129: -  dir - directory where function is

131:    Return value:
132:    The number of errors detected.
133:    
134:    Output Effect:
135:    Error messages are written to stdout.  

137:    Level: advanced

139:    Notes:
140:     You should generally use CHKMEMQ as a short cut for calling this 
141:     routine.

143:     The line, function, file and dir are given by the C preprocessor as 
144:     __LINE__, __FUNCT__, __FILE__, and __DIR__

146:     The Fortran calling sequence is simply PetscTrValid(ierr)

148:    No output is generated if there are no problems detected.

150: .seealso: CHKMEMQ

152: @*/
153: int PetscTrValid(int line,const char function[],const char file[],const char dir[])
154: {
155:   TRSPACE  *head;
156:   char     *a;
157:   unsigned long *nend;

160:   head = TRhead;
161:   while (head) {
162:     if (head->cookie != COOKIE_VALUE) {
163:       (*PetscErrorPrintf)("error detected at  %s() line %d in %s%s\n",function,line,dir,file);
164:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
165:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
166:       SETERRQ(PETSC_ERR_MEMC," ");
167:     }
168:     if (head->size <=0) {
169:       (*PetscErrorPrintf)("error detected at  %s() line %d in %s%s\n",function,line,dir,file);
170:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
171:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
172:       SETERRQ(PETSC_ERR_MEMC," ");
173:     }
174:     a    = (char *)(((TrSPACE*)head) + 1);
175:     nend = (unsigned long *)(a + head->size);
176:     if (nend[0] != COOKIE_VALUE) {
177:       (*PetscErrorPrintf)("error detected at %s() line %d in %s%s\n",function,line,dir,file);
178:       if (nend[0] == ALREADY_FREED) {
179:         (*PetscErrorPrintf)("Memory [id=%d(%lx)] at address %p already freed\n",head->id,head->size,a);
180:       } else {
181:         (*PetscErrorPrintf)("Memory [id=%d(%lx)] at address %p is corrupted (probably write past end)\n",
182:                 head->id,head->size,a);
183:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,
184:                 head->lineno,head->dirname,head->filename);
185:         SETERRQ(PETSC_ERR_MEMC," ");
186:       }
187:     }
188:     head = head->next;
189:   }

191:   return(0);
192: }

196: /*
197:     PetscTrMallocDefault - Malloc with tracing.

199:     Input Parameters:
200: +   a   - number of bytes to allocate
201: .   lineno - line number where used.  Use __LINE__ for this
202: .   function - function calling routine. Use __FUNCT__ for this
203: .   filename  - file name where used.  Use __FILE__ for this
204: -   dir - directory where file is. Use __SDIR__ for this

206:     Returns:
207:     double aligned pointer to requested storage, or null if not
208:     available.
209:  */
210: int PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
211: {
212:   TRSPACE          *head;
213:   char             *inew;
214:   unsigned long    *nend;
215:   size_t           nsize;
216:   int              ierr;

219:   if (TRdebugLevel > 0) {
220:     PetscTrValid(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
221:   }
222:   if (a == 0) SETERRQ(PETSC_ERR_MEM_MALLOC_0,"Cannot malloc size zero");

224:   nsize = a;
225:   if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
226:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscScalar),lineno,function,filename,dir,(void**)&inew);


229:   /*
230:    Keep track of range of memory locations we have malloced in 
231:   */
232:   if (PetscLow > (void*)inew) PetscLow = (void*)inew;
233:   if (PetscHigh < (void*)(inew+nsize+sizeof(TrSPACE)+sizeof(unsigned long))) {
234:     PetscHigh = (void*)(inew+nsize+sizeof(TrSPACE)+sizeof(unsigned long));
235:   }

237:   head   = (TRSPACE *)inew;
238:   inew  += sizeof(TrSPACE);

240:   if (TRhead) TRhead->prev = head;
241:   head->next     = TRhead;
242:   TRhead         = head;
243:   head->prev     = 0;
244:   head->size     = nsize;
245:   head->id       = TRid;
246:   head->lineno   = lineno;

248:   head->filename     = filename;
249:   head->functionname = function;
250:   head->dirname      = dir;
251:   head->cookie       = COOKIE_VALUE;
252:   nend               = (unsigned long *)(inew + nsize);
253:   nend[0]            = COOKIE_VALUE;

255:   TRallocated += nsize;
256:   if (TRallocated > TRMaxMem) {
257:     TRMaxMem   = TRallocated;
258:   }
259:   TRfrags++;

261: #if defined(PETSC_USE_STACK)
262:   PetscStackCopy(petscstack,&head->stack);
263: #endif

265:   /*
266:          Allow logging of all mallocs made
267:   */
268:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
269:     if (PetscLogMalloc == 0) {
270:       PetscLogMallocLength    = (int*)malloc(PetscLogMallocMax*sizeof(int));
271:       if (!PetscLogMallocLength) SETERRQ(PETSC_ERR_MEM," ");
272:       PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
273:       if (!PetscLogMallocDirectory) SETERRQ(PETSC_ERR_MEM," ");
274:       PetscLogMallocFile      = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
275:       if (!PetscLogMallocFile) SETERRQ(PETSC_ERR_MEM," ");
276:       PetscLogMallocFunction  = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
277:       if (!PetscLogMallocFunction) SETERRQ(PETSC_ERR_MEM," ");
278:     }
279:     PetscLogMallocLength[PetscLogMalloc]      = nsize;
280:     PetscLogMallocDirectory[PetscLogMalloc]   = dir;
281:     PetscLogMallocFile[PetscLogMalloc]        = filename;
282:     PetscLogMallocFunction[PetscLogMalloc++]  = function;
283:   }
284:   *result = (void*)inew;
285:   return(0);
286: }


291: /*
292:    PetscTrFreeDefault - Free with tracing.

294:    Input Parameters:
295: .   a    - pointer to a block allocated with PetscTrMalloc
296: .   lineno - line number where used.  Use __LINE__ for this
297: .   function - function calling routine. Use __FUNCT__ for this
298: .   file  - file name where used.  Use __FILE__ for this
299: .   dir - directory where file is. Use __SDIR__ for this
300:  */
301: int PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
302: {
303:   char     *a = (char*)aa;
304:   TRSPACE  *head;
305:   char     *ahead;
306:   int      ierr;
307:   unsigned long *nend;
308: 
310:   /* Do not try to handle empty blocks */
311:   if (!a) {
312:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
313:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block");
314:   }
315: 
316:   if (TRdebugLevel > 0) {
317:     PetscTrValid(line,function,file,dir);
318:   }
319: 
320:   if (PetscLow > aa || PetscHigh < aa){
321:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
322:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"PetscTrFreeDefault called with address not allocated by PetscTrMallocDefault");
323:   }
324: 
325:   ahead = a;
326:   a     = a - sizeof(TrSPACE);
327:   head  = (TRSPACE *)a;
328: 
329:   if (head->cookie != COOKIE_VALUE) {
330:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
331:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\n\
332: may be block not allocated with PetscTrMalloc or PetscMalloc\n",a);
333:     SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
334:   }
335:   nend = (unsigned long *)(ahead + head->size);
336:   if (*nend != COOKIE_VALUE) {
337:     if (*nend == ALREADY_FREED) {
338:       (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
339:       (*PetscErrorPrintf)("Block [id=%d(%lx)] at address %p was already freed\n",
340:                           head->id,head->size,a + sizeof(TrSPACE));
341:       if (head->lineno > 0 && head->lineno < 5000 /* sanity check */) {
342:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,
343:                             head->lineno,head->dirname,head->filename);
344:       } else {
345:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,
346:                             -head->lineno,head->dirname,head->filename);
347:       }
348:       SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
349:     } else {
350:       /* Damaged tail */
351:       (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
352:       (*PetscErrorPrintf)("Block [id=%d(%lx)] at address %p is corrupted (probably write past end)\n",
353:                           head->id,head->size,a);
354:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,
355:                           head->lineno,head->dirname,head->filename);
356:       SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
357:     }
358:   }
359:   /* Mark the location freed */
360:   *nend        = ALREADY_FREED;
361:   /* Save location where freed.  If we suspect the line number, mark as 
362:      allocated location */
363:   if (line > 0 && line < 50000) {
364:     head->lineno       = line;
365:     head->filename     = file;
366:     head->functionname = function;
367:     head->dirname      = dir;
368:   } else {
369:     head->lineno = - head->lineno;
370:   }
371:   /* zero out memory - helps to find some reuse of already freed memory */
372:   PetscMemzero(aa,(int)(head->size));
373: 
374:   TRallocated -= head->size;
375:   TRfrags     --;
376:   if (head->prev) head->prev->next = head->next;
377:   else TRhead = head->next;
378: 
379:   if (head->next) head->next->prev = head->prev;
380:   PetscFreeAlign(a,line,function,file,dir);
381:   return(0);
382: }


387: /*@
388:     PetscShowMemoryUsage - Shows the amount of memory currently being used 
389:         in a communicator.
390:    
391:     Collective on PetscViewer

393:     Input Parameter:
394: +    viewer - the viewer that defines the communicator
395: -    message - string printed before values

397:     Level: intermediate

399:     Concepts: memory usage

401: .seealso: PetscTrDump(),PetscTrSpace(), PetscGetResidentSetSize()
402:  @*/
403: int PetscShowMemoryUsage(PetscViewer viewer,const char message[])
404: {
405:   PetscLogDouble allocated,maximum,resident;
406:   int            ierr,rank;
407:   MPI_Comm       comm;

410:   PetscTrSpace(&allocated,PETSC_NULL,&maximum);
411:   PetscGetResidentSetSize(&resident);
412:   PetscObjectGetComm((PetscObject)viewer,&comm);
413:   MPI_Comm_rank(comm,&rank);
414:   PetscViewerASCIIPrintf(viewer,message);
415:   if (resident) {
416:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Space allocated %g, max space allocated %g, process memory %g\n",rank,allocated,maximum,resident);
417:   } else {
418:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Space allocated %g, max space allocated %g, OS cannot compute process memory\n",rank,allocated,maximum);
419:   }
420:   PetscViewerFlush(viewer);
421:   return(0);
422: }

426: /*@C
427:     PetscTrSpace - Returns space statistics.
428:    
429:     Not Collective

431:     Output Parameters:
432: +   space - number of bytes currently allocated
433: .   frags - number of blocks currently allocated
434: -   maxs - maximum number of bytes ever allocated

436:     Level: intermediate

438:     Concepts: memory usage

440: .seealso: PetscTrDump()
441:  @*/
442: int PetscTrSpace(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs)
443: {

446:   if (space) *space = (PetscLogDouble) TRallocated;
447:   if (fr)    *fr    = (PetscLogDouble) TRfrags;
448:   if (maxs)  *maxs  = (PetscLogDouble) TRMaxMem;
449:   return(0);
450: }

454: /*@C
455:    PetscTrDump - Dumps the allocated memory blocks to a file. The information 
456:    printed is: size of space (in bytes), address of space, id of space, 
457:    file in which space was allocated, and line number at which it was 
458:    allocated.

460:    Collective on PETSC_COMM_WORLD

462:    Input Parameter:
463: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

465:    Options Database Key:
466: .  -trdump - Dumps unfreed memory during call to PetscFinalize()

468:    Level: intermediate

470:    Fortran Note:
471:    The calling sequence in Fortran is PetscTrDump(integer ierr)
472:    The fp defaults to stdout.

474:    Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
475:           has been freed.

477:    Concepts: memory usage
478:    Concepts: memory bleeding
479:    Concepts: bleeding memory

481: .seealso:  PetscTrSpace(), PetscTrLogDump() 
482: @*/
483: int PetscTrDump(FILE *fp)
484: {
485:   TRSPACE *head;
486:   int     rank,ierr;

489:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
490:   if (!fp) fp = stdout;
491:   if (TRallocated > 0) {
492:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d]Total space allocated %d bytes\n",rank,(int)TRallocated);
493:   }
494:   head = TRhead;
495:   while (head) {
496:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%2d]%8d bytes %s() line %d in %s%s\n",rank,(int)head->size,
497:             head->functionname,head->lineno,head->dirname,head->filename);
498: #if defined(PETSC_USE_STACK)
499:     PetscStackPrint(&head->stack,fp);
500: #endif
501:     head = head->next;
502:   }
503:   return(0);
504: }

506: /* ---------------------------------------------------------------------------- */

510: /*@C
511:     PetscTrLog - Activates logging of all calls to malloc.

513:     Not Collective

515:     Options Database Key:
516: .  -trmalloc_log - Activates PetscTrLog() and PetscTrLogDump()

518:     Level: advanced

520: .seealso: PetscTrLogDump()
521: @*/
522: int PetscTrLog(void)
523: {

526:   PetscLogMalloc = 0;
527:   return(0);
528: }

532: /*@C
533:     PetscTrLogDump - Dumps the log of all calls to malloc; also calls 
534:     PetscGetResidentSetSize().

536:     Collective on PETSC_COMM_WORLD

538:     Input Parameter:
539: .   fp - file pointer; or PETSC_NULL

541:     Options Database Key:
542: .  -trmalloc_log - Activates PetscTrLog() and PetscTrLogDump()

544:     Level: advanced

546:    Fortran Note:
547:    The calling sequence in Fortran is PetscTrLogDump(integer ierr)
548:    The fp defaults to stdout.

550: .seealso: PetscTrLog(), PetscTrDump()
551: @*/
552: int PetscTrLogDump(FILE *fp)
553: {
554:   int            i,rank,j,n,*shortlength,ierr,dummy,size,tag = 1212 /* very bad programming */,*perm;
555:   PetscTruth     match;
556:   const char     **shortfunction;
557:   PetscLogDouble rss;
558:   MPI_Status     status;

561:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
562:   MPI_Comm_size(MPI_COMM_WORLD,&size);
563:   /*
564:        Try to get the data printed in order by processor. This will only sometimes work 
565:   */
566:   fflush(fp);
567:   MPI_Barrier(MPI_COMM_WORLD);
568:   if (rank) {
569:     MPI_Recv(&dummy,1,MPI_INT,rank-1,tag,MPI_COMM_WORLD,&status);
570:   }

572:   if (!fp) fp = stdout;
573:   PetscGetResidentSetSize(&rss);
574:   if (rss) {
575:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory used %d Size of entire process %d\n",rank,(int)TRMaxMem,(int)rss);
576:   } else {
577:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory used %d OS cannot compute size of entire process\n",rank,(int)TRMaxMem);
578:   }
579:   shortlength      = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortlength) SETERRQ(1,"Out of memory");
580:   shortfunction    = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(1,"Out of memory");
581:   shortfunction[0] = PetscLogMallocFunction[0];
582:   shortlength[0]   = PetscLogMallocLength[0];
583:   n = 1;
584:   for (i=1; i<PetscLogMalloc; i++) {
585:     for (j=0; j<n; j++) {
586:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
587:       if (match) {
588:         shortlength[j] += PetscLogMallocLength[i];
589:         goto foundit;
590:       }
591:     }
592:     shortfunction[n] = PetscLogMallocFunction[i];
593:     shortlength[n]   = PetscLogMallocLength[i];
594:     n++;
595:     foundit:;
596:   }

598:   perm = (int*)malloc(n*sizeof(int));if (!perm) SETERRQ(1,"Out of memory");
599:   for (i=0; i<n; i++) perm[i] = i;
600:   PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);

602:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
603:   for (i=0; i<n; i++) {
604:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] % 10d %s()\n",rank,shortlength[perm[i]],shortfunction[perm[i]]);
605:   }
606:   free(perm);
607:   free(shortlength);
608:   free((char **)shortfunction);
609:   fflush(fp);
610:   if (rank != size-1) {
611:     MPI_Send(&dummy,1,MPI_INT,rank+1,tag,MPI_COMM_WORLD);
612:   }

614:   return(0);
615: }

617: /* ---------------------------------------------------------------------------- */

621: /*
622:     PetscTrDebugLevel - Set the level of debugging for the space management 
623:                    routines.

625:     Input Parameter:
626: .   level - level of debugging.  Currently, either 0 (no checking) or 1
627:     (use PetscTrValid at each PetscTrMalloc or PetscTrFree).
628: */
629: int  PetscTrDebugLevel(int level)
630: {

633:   TRdebugLevel = level;
634:   return(0);
635: }