Actual source code: mtr.c
petsc-3.13.6 2020-09-29
Report Typos and Errors

      2: /*
      3:      Interface to malloc() and free(). This code allows for logging of memory usage and some error checking
      4: */
      5:  #include <petscsys.h>
      6:  #include <petscviewer.h>
      7: #if defined(PETSC_HAVE_MALLOC_H)
      8: #include <malloc.h>
      9: #endif

     11: /*
     12:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
     13: */
     14: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,PetscBool,int,const char[],const char[],void**);
     15: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
     16: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t,int,const char[],const char[],void**);

     18: #define CLASSID_VALUE  ((PetscClassId) 0xf0e0d0c9)
     19: #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)

     21: /*  this is the header put at the beginning of each malloc() using for tracking allocated space and checking of allocated space heap */
     22: typedef struct _trSPACE {
     23:   size_t          size;
     24:   int             id;
     25:   int             lineno;
     26:   const char      *filename;
     27:   const char      *functionname;
     28:   PetscClassId    classid;
     29: #if defined(PETSC_USE_DEBUG)
     30:   PetscStack      stack;
     31: #endif
     32:   struct _trSPACE *next,*prev;
     33: } TRSPACE;

     35: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
     36:    It is sizeof(trSPACE) padded to be a multiple of PETSC_MEMALIGN.
     37: */
     38: #define HEADER_BYTES  ((sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1))

     40: /* This union is used to insure that the block passed to the user retains
     41:    a minimum alignment of PETSC_MEMALIGN.
     42: */
     43: typedef union {
     44:   TRSPACE sp;
     45:   char    v[HEADER_BYTES];
     46: } TrSPACE;

     48: #define MAXTRMAXMEMS 50
     49: static size_t    TRallocated          = 0;
     50: static int       TRfrags              = 0;
     51: static TRSPACE   *TRhead              = NULL;
     52: static int       TRid                 = 0;
     53: static PetscBool TRdebugLevel         = PETSC_FALSE;
     54: static PetscBool TRdebugIinitializenan= PETSC_FALSE;
     55: static size_t    TRMaxMem             = 0;
     56: static int       NumTRMaxMems         = 0;
     57: static size_t    TRMaxMems[MAXTRMAXMEMS];
     58: static int       TRMaxMemsEvents[MAXTRMAXMEMS];
     59: /*
     60:       Arrays to log information on mallocs for PetscMallocView()
     61: */
     62: static int        PetscLogMallocMax       = 10000;
     63: static int        PetscLogMalloc          = -1;
     64: static size_t     PetscLogMallocThreshold = 0;
     65: static size_t     *PetscLogMallocLength;
     66: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

     68: /*@C
     69:    PetscMallocValidate - Test the memory for corruption.  This can be called at any time between PetscInitialize() and PetscFinalize()

     71:    Input Parameters:
     72: +  line - line number where call originated.
     73: .  function - name of function calling
     74: -  file - file where function is

     76:    Return value:
     77:    The number of errors detected.

     79:    Options Database:.
     80: +  -malloc_test - turns this feature on when PETSc was not configured with --with-debugging=0
     81: -  -malloc_debug - turns this feature on anytime

     83:    Output Effect:
     84:    Error messages are written to stdout.

     86:    Level: advanced

     88:    Notes:
     89:     This is only run if PetscMallocSetDebug() has been called which is set by -malloc_test (if debugging is turned on) or -malloc_debug (any time)

     91:     You should generally use CHKMEMQ as a short cut for calling this  routine.

     93:     The Fortran calling sequence is simply PetscMallocValidate(ierr)

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

     97:    Developers Note:
     98:      Uses the flg TRdebugLevel (set as the first argument to PetscMallocSetDebug()) to determine if it should run

    100: .seealso: CHKMEMQ

    102: @*/
    103: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[])
    104: {
    105:   TRSPACE      *head,*lasthead;
    106:   char         *a;
    107:   PetscClassId *nend;

    109:   if (!TRdebugLevel) return 0;
    111:   head = TRhead; lasthead = NULL;
    112:   while (head) {
    113:     if (head->classid != CLASSID_VALUE) {
    114:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s\n",function,line,file);
    115:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
    116:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
    117:       if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
    118:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    119:     }
    120:     a    = (char*)(((TrSPACE*)head) + 1);
    121:     nend = (PetscClassId*)(a + head->size);
    122:     if (*nend != CLASSID_VALUE) {
    123:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
    124:       if (*nend == ALREADY_FREED) {
    125:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
    126:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    127:       } else {
    128:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    129:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    130:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    131:       }
    132:     }
    133:     lasthead = head;
    134:     head     = head->next;
    135:   }
    136:   return(0);
    137: }

    139: /*
    140:     PetscTrMallocDefault - Malloc with tracing.

    142:     Input Parameters:
    143: +   a   - number of bytes to allocate
    144: .   lineno - line number where used.  Use __LINE__ for this
    145: -   filename  - file name where used.  Use __FILE__ for this

    147:     Returns:
    148:     double aligned pointer to requested storage, or null if not  available.
    149:  */
    150: PetscErrorCode  PetscTrMallocDefault(size_t a,PetscBool clear,int lineno,const char function[],const char filename[],void **result)
    151: {
    152:   TRSPACE        *head;
    153:   char           *inew;
    154:   size_t         nsize;

    158:   /* Do not try to handle empty blocks */
    159:   if (!a) { *result = NULL; return(0); }

    161:   PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);

    163:   nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
    164:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),clear,lineno,function,filename,(void**)&inew);

    166:   head  = (TRSPACE*)inew;
    167:   inew += sizeof(TrSPACE);

    169:   if (TRhead) TRhead->prev = head;
    170:   head->next   = TRhead;
    171:   TRhead       = head;
    172:   head->prev   = NULL;
    173:   head->size   = nsize;
    174:   head->id     = TRid;
    175:   head->lineno = lineno;

    177:   head->filename                 = filename;
    178:   head->functionname             = function;
    179:   head->classid                  = CLASSID_VALUE;
    180:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

    182:   TRallocated += nsize;
    183:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
    184:   if (PetscLogMemory) {
    185:     PetscInt i;
    186:     for (i=0; i<NumTRMaxMems; i++) {
    187:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
    188:     }
    189:   }
    190:   TRfrags++;

    192: #if defined(PETSC_USE_DEBUG)
    193:   if (PetscStackActive()) {
    194:     PetscStackCopy(petscstack,&head->stack);
    196:     head->stack.line[head->stack.currentsize-2] = lineno;
    197:   } else {
    198:     head->stack.currentsize = 0;
    199:   }
    200: #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE)
    201:   if (!clear && TRdebugIinitializenan) {
    202:     size_t     i, n = a/sizeof(PetscReal);
    203:     PetscReal *s = (PetscReal*) inew;
    204:     /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */
    205: #if defined(PETSC_USE_REAL_SINGLE)
    206:     int        nas = 0x7F800002;
    207: #else
    208:     PetscInt64 nas = 0x7FF0000000000002;
    209: #endif
    210:     for (i=0; i<n; i++) {
    211:       memcpy(s+i,&nas,sizeof(PetscReal));
    212:     }
    213:   }
    214: #endif
    215: #endif

    217:   /*
    218:          Allow logging of all mallocs made.
    219:          TODO: Currently this memory is never freed, it should be freed during PetscFinalize()
    220:   */
    221:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
    222:     if (!PetscLogMalloc) {
    223:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    224:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    226:       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    227:       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    229:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    230:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
    231:     }
    232:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
    233:     PetscLogMallocFile[PetscLogMalloc]       = filename;
    234:     PetscLogMallocFunction[PetscLogMalloc++] = function;
    235:   }
    236:   *result = (void*)inew;
    237:   return(0);
    238: }

    240: /*
    241:    PetscTrFreeDefault - Free with tracing.

    243:    Input Parameters:
    244: .   a    - pointer to a block allocated with PetscTrMalloc
    245: .   lineno - line number where used.  Use __LINE__ for this
    246: .   file  - file name where used.  Use __FILE__ for this
    247:  */
    248: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
    249: {
    250:   char           *a = (char*)aa;
    251:   TRSPACE        *head;
    252:   char           *ahead;
    254:   PetscClassId   *nend;

    257:   /* Do not try to handle empty blocks */
    258:   if (!a) return(0);

    260:   PetscMallocValidate(line,function,file);

    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:   if (TRallocated < head->size) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"TRallocate is smaller than memory just freed");
    301:   TRallocated -= head->size;
    302:   TRfrags--;
    303:   if (head->prev) head->prev->next = head->next;
    304:   else TRhead = head->next;

    306:   if (head->next) head->next->prev = head->prev;
    307:   PetscFreeAlign(a,line,function,file);
    308:   return(0);
    309: }

    311: /*
    312:   PetscTrReallocDefault - Realloc with tracing.

    314:   Input Parameters:
    315: + len      - number of bytes to allocate
    316: . lineno   - line number where used.  Use __LINE__ for this
    317: . filename - file name where used.  Use __FILE__ for this
    318: - result - original memory

    320:   Output Parameter:
    321: . result - double aligned pointer to requested storage, or null if not available.

    323:   Level: developer

    325: .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
    326: */
    327: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
    328: {
    329:   char           *a = (char *) *result;
    330:   TRSPACE        *head;
    331:   char           *ahead, *inew;
    332:   PetscClassId   *nend;
    333:   size_t         nsize;

    337:   /* Realloc requests zero space so just free the current space */
    338:   if (!len) {
    339:     PetscTrFreeDefault(*result,lineno,function,filename);
    340:     *result = NULL;
    341:     return(0);
    342:   }
    343:   /* If the orginal space was NULL just use the regular malloc() */
    344:   if (!*result) {
    345:     PetscTrMallocDefault(len,PETSC_FALSE,lineno,function,filename,result);
    346:     return(0);
    347:   }

    349:   PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);

    351:   ahead = a;
    352:   a     = a - sizeof(TrSPACE);
    353:   head  = (TRSPACE *) a;
    354:   inew  = a;

    356:   if (head->classid != CLASSID_VALUE) {
    357:     (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
    358:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
    359:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
    360:   }
    361:   nend = (PetscClassId *)(ahead + head->size);
    362:   if (*nend != CLASSID_VALUE) {
    363:     if (*nend == ALREADY_FREED) {
    364:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
    365:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
    366:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
    367:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    368:       } else {
    369:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
    370:       }
    371:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
    372:     } else {
    373:       /* Damaged tail */
    374:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
    375:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    376:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    377:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
    378:     }
    379:   }

    381:   /* remove original reference to the memory allocated from the PETSc debugging heap */
    382:   TRallocated -= head->size;
    383:   TRfrags--;
    384:   if (head->prev) head->prev->next = head->next;
    385:   else TRhead = head->next;
    386:   if (head->next) head->next->prev = head->prev;

    388:   nsize = (len + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
    389:   PetscReallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);

    391:   head  = (TRSPACE*)inew;
    392:   inew += sizeof(TrSPACE);

    394:   if (TRhead) TRhead->prev = head;
    395:   head->next   = TRhead;
    396:   TRhead       = head;
    397:   head->prev   = NULL;
    398:   head->size   = nsize;
    399:   head->id     = TRid;
    400:   head->lineno = lineno;

    402:   head->filename                 = filename;
    403:   head->functionname             = function;
    404:   head->classid                  = CLASSID_VALUE;
    405:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

    407:   TRallocated += nsize;
    408:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
    409:   if (PetscLogMemory) {
    410:     PetscInt i;
    411:     for (i=0; i<NumTRMaxMems; i++) {
    412:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
    413:     }
    414:   }
    415:   TRfrags++;

    417: #if defined(PETSC_USE_DEBUG)
    418:   if (PetscStackActive()) {
    419:     PetscStackCopy(petscstack,&head->stack);
    421:     head->stack.line[head->stack.currentsize-2] = lineno;
    422:   } else {
    423:     head->stack.currentsize = 0;
    424:   }
    425: #endif

    427:   /*
    428:          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
    429:          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
    430:   */
    431:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
    432:     if (!PetscLogMalloc) {
    433:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    434:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    436:       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    437:       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    439:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    440:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
    441:     }
    442:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
    443:     PetscLogMallocFile[PetscLogMalloc]       = filename;
    444:     PetscLogMallocFunction[PetscLogMalloc++] = function;
    445:   }
    446:   *result = (void*)inew;
    447:   return(0);
    448: }

    450: /*@C
    451:     PetscMemoryView - Shows the amount of memory currently being used in a communicator.

    453:     Collective on PetscViewer

    455:     Input Parameter:
    456: +    viewer - the viewer that defines the communicator
    457: -    message - string printed before values

    459:     Options Database:
    460: +    -malloc_debug - have PETSc track how much memory it has allocated
    461: -    -memory_view - during PetscFinalize() have this routine called

    463:     Level: intermediate

    465: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage(), PetscMallocView()
    466:  @*/
    467: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
    468: {
    469:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
    470:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
    472:   MPI_Comm       comm;

    475:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
    476:   PetscMallocGetCurrentUsage(&allocated);
    477:   PetscMallocGetMaximumUsage(&allocatedmax);
    478:   PetscMemoryGetCurrentUsage(&resident);
    479:   PetscMemoryGetMaximumUsage(&residentmax);
    480:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
    481:   PetscObjectGetComm((PetscObject)viewer,&comm);
    482:   PetscViewerASCIIPrintf(viewer,message);
    483:   if (resident && residentmax && allocated) {
    484:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    485:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    486:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    487:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
    488:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    489:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    490:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    491:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
    492:     MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    493:     MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    494:     MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    495:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
    496:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    497:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    498:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    499:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    500:   } else if (resident && residentmax) {
    501:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    502:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    503:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    504:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
    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:   } else if (resident && allocated) {
    510:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    511:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    512:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    513:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
    514:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    515:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    516:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    517:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    518:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
    519:   } else if (allocated) {
    520:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    521:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    522:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    523:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    524:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
    525:     PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
    526:   } else {
    527:     PetscViewerASCIIPrintf(viewer,"Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
    528:   }
    529:   PetscViewerFlush(viewer);
    530:   return(0);
    531: }

    533: /*@
    534:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed

    536:     Not Collective

    538:     Output Parameters:
    539: .   space - number of bytes currently allocated

    541:     Level: intermediate

    543: .seealso: PetscMallocDump(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    544:           PetscMemoryGetMaximumUsage()
    545:  @*/
    546: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
    547: {
    549:   *space = (PetscLogDouble) TRallocated;
    550:   return(0);
    551: }

    553: /*@
    554:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
    555:         during this run.

    557:     Not Collective

    559:     Output Parameters:
    560: .   space - maximum number of bytes ever allocated at one time

    562:     Level: intermediate

    564: .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    565:           PetscMallocPushMaximumUsage()
    566:  @*/
    567: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
    568: {
    570:   *space = (PetscLogDouble) TRMaxMem;
    571:   return(0);
    572: }

    574: /*@
    575:     PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event

    577:     Not Collective

    579:     Input Parameter:
    580: .   event - an event id; this is just for error checking

    582:     Level: developer

    584: .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    585:           PetscMallocPopMaximumUsage()
    586:  @*/
    587: PetscErrorCode  PetscMallocPushMaximumUsage(int event)
    588: {
    590:   if (++NumTRMaxMems > MAXTRMAXMEMS) return(0);
    591:   TRMaxMems[NumTRMaxMems-1]       = TRallocated;
    592:   TRMaxMemsEvents[NumTRMaxMems-1] = event;
    593:   return(0);
    594: }

    596: /*@
    597:     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

    599:     Not Collective

    601:     Input Parameter:
    602: .   event - an event id; this is just for error checking

    604:     Output Parameter:
    605: .   mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event

    607:     Level: developer

    609: .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    610:           PetscMallocPushMaximumUsage()
    611:  @*/
    612: PetscErrorCode  PetscMallocPopMaximumUsage(int event,PetscLogDouble *mu)
    613: {
    615:   *mu = 0;
    616:   if (NumTRMaxMems-- > MAXTRMAXMEMS) return(0);
    617:   if (TRMaxMemsEvents[NumTRMaxMems] != event) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"PetscMallocPush/PopMaximumUsage() are not nested");
    618:   *mu = TRMaxMems[NumTRMaxMems];
    619:   return(0);
    620: }

    622: #if defined(PETSC_USE_DEBUG)
    623: /*@C
    624:    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory

    626:    Collective on PETSC_COMM_WORLD

    628:    Input Parameter:
    629: .    ptr - the memory location

    631:    Output Parameter:
    632: .    stack - the stack indicating where the program allocated this memory

    634:    Level: intermediate

    636: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocView()
    637: @*/
    638: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
    639: {
    640:   TRSPACE *head;

    643:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
    644:   *stack = &head->stack;
    645:   return(0);
    646: }
    647: #else
    648: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
    649: {
    651:   *stack = NULL;
    652:   return(0);
    653: }
    654: #endif

    656: /*@C
    657:    PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
    658:    printed is: size of space (in bytes), address of space, id of space,
    659:    file in which space was allocated, and line number at which it was
    660:    allocated.

    662:    Not Collective

    664:    Input Parameter:
    665: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

    667:    Options Database Key:
    668: .  -malloc_dump <optional filename> - Dumps unfreed memory during call to PetscFinalize()

    670:    Level: intermediate

    672:    Fortran Note:
    673:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
    674:    The fp defaults to stdout.

    676:    Notes:
    677:      Uses MPI_COMM_WORLD to display rank, because this may be called in PetscFinalize() after PETSC_COMM_WORLD has been freed.

    679:      When called in PetscFinalize() dumps only the allocations that have not been properly freed

    681:      PetscMallocView() prints a list of all memory ever allocated

    683: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocView(), PetscMallocViewSet()
    684: @*/
    685: PetscErrorCode  PetscMallocDump(FILE *fp)
    686: {
    687:   TRSPACE        *head;
    688:   size_t         libAlloc = 0;
    690:   PetscMPIInt    rank;

    693:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    694:   if (!fp) fp = PETSC_STDOUT;
    695:   head = TRhead;
    696:   while (head) {
    697:     libAlloc += head->size;
    698:     head = head->next;
    699:   }
    700:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
    701:   head = TRhead;
    702:   while (head) {
    703:     PetscBool isLib;

    705:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
    706:     if (!isLib) {
    707:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
    708: #if defined(PETSC_USE_DEBUG)
    709:       PetscStackPrint(&head->stack,fp);
    710: #endif
    711:     }
    712:     head = head->next;
    713:   }
    714:   return(0);
    715: }

    717: /*@
    718:     PetscMallocViewSet - Activates logging of all calls to PetscMalloc() with a minimum size to view

    720:     Not Collective

    722:     Input Arguments:
    723: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

    725:     Options Database Key:
    726: +  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()
    727: .  -malloc_view_threshold <min> - Sets a minimum size if -malloc_view is used
    728: -  -log_view_memory - view the memory usage also with the -log_view option

    730:     Level: advanced

    732:     Notes: Must be called after PetscMallocSetDebug()

    734:     Uses MPI_COMM_WORLD to determine rank because PETSc communicators may not be available

    736: .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocViewSet()
    737: @*/
    738: PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
    739: {

    743:   PetscLogMalloc = 0;
    744:   PetscMemorySetGetMaximumUsage();
    745:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
    746:   PetscLogMallocThreshold = (size_t)logmin;
    747:   return(0);
    748: }

    750: /*@
    751:     PetscMallocViewGet - Determine whether all calls to PetscMalloc() are being logged

    753:     Not Collective

    755:     Output Arguments
    756: .   logging - PETSC_TRUE if logging is active

    758:     Options Database Key:
    759: .  -malloc_view <optional filename> - Activates PetscMallocView()

    761:     Level: advanced

    763: .seealso: PetscMallocDump(), PetscMallocView()
    764: @*/
    765: PetscErrorCode PetscMallocViewGet(PetscBool *logging)
    766: {

    769:   *logging = (PetscBool)(PetscLogMalloc >= 0);
    770:   return(0);
    771: }

    773: /*@C
    774:     PetscMallocView - Saves the log of all calls to PetscMalloc(); also calls
    775:        PetscMemoryGetMaximumUsage()

    777:     Not Collective

    779:     Input Parameter:
    780: .   fp - file pointer; or NULL

    782:     Options Database Key:
    783: .  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()

    785:     Level: advanced

    787:    Fortran Note:
    788:    The calling sequence in Fortran is PetscMallocView(integer ierr)
    789:    The fp defaults to stdout.

    791:    Notes:
    792:      PetscMallocDump() dumps only the currently unfreed memory, this dumps all memory ever allocated

    794:      PetscMemoryView() gives a brief summary of current memory usage

    796: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocViewSet(), PetscMemoryView()
    797: @*/
    798: PetscErrorCode  PetscMallocView(FILE *fp)
    799: {
    800:   PetscInt       i,j,n,*perm;
    801:   size_t         *shortlength;
    802:   int            *shortcount,err;
    803:   PetscMPIInt    rank;
    804:   PetscBool      match;
    805:   const char     **shortfunction;
    806:   PetscLogDouble rss;

    810:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    811:   err = fflush(fp);
    812:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

    814:   if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"PetscMallocView() called without call to PetscMallocViewSet() this is often due to\n                      setting the option -malloc_view AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");

    816:   if (!fp) fp = PETSC_STDOUT;
    817:   PetscMemoryGetMaximumUsage(&rss);
    818:   if (rss) {
    819:     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
    820:   } else {
    821:     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
    822:   }
    823:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    824:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    825:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    826:   for (i=0,n=0; i<PetscLogMalloc; i++) {
    827:     for (j=0; j<n; j++) {
    828:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
    829:       if (match) {
    830:         shortlength[j] += PetscLogMallocLength[i];
    831:         shortcount[j]++;
    832:         goto foundit;
    833:       }
    834:     }
    835:     shortfunction[n] = PetscLogMallocFunction[i];
    836:     shortlength[n]   = PetscLogMallocLength[i];
    837:     shortcount[n]    = 1;
    838:     n++;
    839: foundit:;
    840:   }

    842:   perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    843:   for (i=0; i<n; i++) perm[i] = i;
    844:   PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);

    846:   (void) fprintf(fp,"[%d] Memory usage sorted by function\n",rank);
    847:   for (i=0; i<n; i++) {
    848:     (void) fprintf(fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
    849:   }
    850:   free(perm);
    851:   free(shortlength);
    852:   free(shortcount);
    853:   free((char**)shortfunction);
    854:   err = fflush(fp);
    855:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
    856:   return(0);
    857: }

    859: /* ---------------------------------------------------------------------------- */

    861: /*@
    862:     PetscMallocSetDebug - Set's PETSc memory debugging

    864:     Not Collective

    866:     Input Parameter:
    867: +   eachcall - checks the entire heap of allocated memory for issues on each call to PetscMalloc() and PetscFree()
    868: -   initializenan - initializes all memory with NaN to catch use of uninitialized floating point arrays

    870:     Options Database:
    871: +   -malloc_debug <true or false> - turns on or off debugging
    872: .   -malloc_test - turns on all debugging if PETSc was configured with debugging including -malloc_dump, otherwise ignored
    873: .   -malloc_view_threshold t - log only allocations larger than t
    874: .   -malloc_dump <filename> - print a list of all memory that has not been freed
    875: .   -malloc no - (deprecated) same as -malloc_debug no
    876: -   -malloc_log - (deprecated) same as -malloc_view

    878:    Level: developer

    880:     Notes: This is called in PetscInitialize() and should not be called elsewhere

    882: .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocGetDebug()
    883: @*/
    884: PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
    885: {

    889:   if (PetscTrMalloc == PetscTrMallocDefault) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Cannot call this routine more than once, it can only be called in PetscInitialize()");
    890:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault,PetscTrReallocDefault);

    892:   TRallocated         = 0;
    893:   TRfrags             = 0;
    894:   TRhead              = NULL;
    895:   TRid                = 0;
    896:   TRdebugLevel        = eachcall;
    897:   TRMaxMem            = 0;
    898:   PetscLogMallocMax   = 10000;
    899:   PetscLogMalloc      = -1;
    900:   TRdebugIinitializenan = initializenan;
    901:   return(0);
    902: }

    904: /*@
    905:     PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.

    907:     Not Collective

    909:     Output Parameters:
    910: +    basic - doing basic debugging
    911: .    eachcall - checks the entire memory heap at each PetscMalloc()/PetscFree()
    912: -    initializenan - initializes memory with NaN

    914:    Level: intermediate

    916:    Notes:
    917:      By default, the debug version always does some debugging unless you run with -malloc_debug no

    919: .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocSetDebug()
    920: @*/
    921: PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
    922: {
    924:   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
    925:   if (eachcall) *eachcall           = TRdebugLevel;
    926:   if (initializenan) *initializenan = TRdebugIinitializenan;
    927:   return(0);
    928: }