Actual source code: mtr.c
petsc-3.10.5 2019-03-28
Report Typos and Errors

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

     13: /*
     14:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
     15: */
     16: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**);
     17: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
     18: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t,int,const char[],const char[],void**);
     19: PETSC_EXTERN PetscErrorCode PetscTrMallocDefault(size_t,int,const char[],const char[],void**);
     20: PETSC_EXTERN PetscErrorCode PetscTrFreeDefault(void*,int,const char[],const char[]);
     21: PETSC_EXTERN PetscErrorCode PetscTrReallocDefault(size_t,int,const char[],const char[],void**);

     24: #define CLASSID_VALUE  ((PetscClassId) 0xf0e0d0c9)
     25: #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)

     27: typedef struct _trSPACE {
     28:   size_t       size;
     29:   int          id;
     30:   int          lineno;
     31:   const char   *filename;
     32:   const char   *functionname;
     33:   PetscClassId classid;
     34: #if defined(PETSC_USE_DEBUG)
     35:   PetscStack   stack;
     36: #endif
     37:   struct _trSPACE *next,*prev;
     38: } TRSPACE;

     40: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
     41:    It is sizeof(TRSPACE) padded to be a multiple of PETSC_MEMALIGN.
     42: */

     44: #define HEADER_BYTES  ((sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1))

     47: /* This union is used to insure that the block passed to the user retains
     48:    a minimum alignment of PETSC_MEMALIGN.
     49: */
     50: typedef union {
     51:   TRSPACE sp;
     52:   char    v[HEADER_BYTES];
     53: } TrSPACE;

     56: static size_t    TRallocated  = 0;
     57: static int       TRfrags      = 0;
     58: static TRSPACE   *TRhead      = NULL;
     59: static int       TRid         = 0;
     60: static PetscBool TRdebugLevel = PETSC_FALSE;
     61: static size_t    TRMaxMem     = 0;
     62: /*
     63:       Arrays to log information on all Mallocs
     64: */
     65: static int        PetscLogMallocMax       = 10000;
     66: static int        PetscLogMalloc          = -1;
     67: static size_t     PetscLogMallocThreshold = 0;
     68: static size_t     *PetscLogMallocLength;
     69: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

     71: PETSC_INTERN PetscErrorCode PetscSetUseTrMalloc_Private(void)
     72: {

     76:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
     77:   PetscTrRealloc = PetscTrReallocDefault;

     79:   TRallocated       = 0;
     80:   TRfrags           = 0;
     81:   TRhead            = NULL;
     82:   TRid              = 0;
     83:   TRdebugLevel      = PETSC_FALSE;
     84:   TRMaxMem          = 0;
     85:   PetscLogMallocMax = 10000;
     86:   PetscLogMalloc    = -1;
     87:   return(0);
     88: }

     90: /*@C
     91:    PetscMallocValidate - Test the memory for corruption.  This can be used to
     92:    check for memory overwrites.

     94:    Input Parameter:
     95: +  line - line number where call originated.
     96: .  function - name of function calling
     97: -  file - file where function is

     99:    Return value:
    100:    The number of errors detected.

    102:    Output Effect:
    103:    Error messages are written to stdout.

    105:    Level: advanced

    107:    Notes:
    108:     You should generally use CHKMEMQ as a short cut for calling this
    109:     routine.

    111:     The line, function, file are given by the C preprocessor as

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

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

    117: .seealso: CHKMEMQ

    119: @*/
    120: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[])
    121: {
    122:   TRSPACE      *head,*lasthead;
    123:   char         *a;
    124:   PetscClassId *nend;

    127:   head = TRhead; lasthead = NULL;
    128:   while (head) {
    129:     if (head->classid != CLASSID_VALUE) {
    130:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s\n",function,line,file);
    131:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
    132:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
    133:       if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
    134:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    135:     }
    136:     a    = (char*)(((TrSPACE*)head) + 1);
    137:     nend = (PetscClassId*)(a + head->size);
    138:     if (*nend != CLASSID_VALUE) {
    139:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
    140:       if (*nend == ALREADY_FREED) {
    141:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
    142:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    143:       } else {
    144:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    145:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    146:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    147:       }
    148:     }
    149:     lasthead = head;
    150:     head     = head->next;
    151:   }
    152:   return(0);
    153: }

    155: /*
    156:     PetscTrMallocDefault - Malloc with tracing.

    158:     Input Parameters:
    159: +   a   - number of bytes to allocate
    160: .   lineno - line number where used.  Use __LINE__ for this
    161: -   filename  - file name where used.  Use __FILE__ for this

    163:     Returns:
    164:     double aligned pointer to requested storage, or null if not
    165:     available.
    166:  */
    167: PetscErrorCode  PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],void **result)
    168: {
    169:   TRSPACE        *head;
    170:   char           *inew;
    171:   size_t         nsize;

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

    178:   if (TRdebugLevel) {
    179:     PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
    180:   }

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

    185:   head  = (TRSPACE*)inew;
    186:   inew += sizeof(TrSPACE);

    188:   if (TRhead) TRhead->prev = head;
    189:   head->next   = TRhead;
    190:   TRhead       = head;
    191:   head->prev   = NULL;
    192:   head->size   = nsize;
    193:   head->id     = TRid;
    194:   head->lineno = lineno;

    196:   head->filename                 = filename;
    197:   head->functionname             = function;
    198:   head->classid                  = CLASSID_VALUE;
    199:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

    201:   TRallocated += nsize;
    202:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
    203:   TRfrags++;

    205: #if defined(PETSC_USE_DEBUG)
    206:   if (PetscStackActive()) {
    207:     PetscStackCopy(petscstack,&head->stack);
    209:     head->stack.line[head->stack.currentsize-2] = lineno;
    210:   } else {
    211:     head->stack.currentsize = 0;
    212:   }
    213: #endif

    215:   /*
    216:          Allow logging of all mallocs made
    217:   */
    218:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
    219:     if (!PetscLogMalloc) {
    220:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    221:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

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

    238: /*
    239:    PetscTrFreeDefault - Free with tracing.

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

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

    258:   if (TRdebugLevel) {
    259:     PetscMallocValidate(line,function,file);
    260:   }

    262:   ahead = a;
    263:   a     = a - sizeof(TrSPACE);
    264:   head  = (TRSPACE*)a;

    266:   if (head->classid != CLASSID_VALUE) {
    267:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    268:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
    269:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
    270:   }
    271:   nend = (PetscClassId*)(ahead + head->size);
    272:   if (*nend != CLASSID_VALUE) {
    273:     if (*nend == ALREADY_FREED) {
    274:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    275:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
    276:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
    277:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    278:       } else {
    279:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
    280:       }
    281:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
    282:     } else {
    283:       /* Damaged tail */
    284:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    285:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    286:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    287:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
    288:     }
    289:   }
    290:   /* Mark the location freed */
    291:   *nend = ALREADY_FREED;
    292:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
    293:   if (line > 0 && line < 50000) {
    294:     head->lineno       = line;
    295:     head->filename     = file;
    296:     head->functionname = function;
    297:   } else {
    298:     head->lineno = -head->lineno;
    299:   }
    300:   /* zero out memory - helps to find some reuse of already freed memory */
    301:   PetscMemzero(aa,head->size);

    303:   TRallocated -= head->size;
    304:   TRfrags--;
    305:   if (head->prev) head->prev->next = head->next;
    306:   else TRhead = head->next;

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

    315: /*
    316:   PetscTrReallocDefault - Realloc with tracing.

    318:   Input Parameters:
    319: + len      - number of bytes to allocate
    320: . lineno   - line number where used.  Use __LINE__ for this
    321: . filename - file name where used.  Use __FILE__ for this
    322: - result   - double aligned pointer to initial storage.

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

    327:   Level: developer

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

    341:   /* Realloc to zero = free */
    342:   if (!len) {
    343:     PetscTrFreeDefault(*result,lineno,function,filename);
    344:     *result = NULL;
    345:     return(0);
    346:   }

    348:   if (TRdebugLevel) {PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);}

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

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

    380:   TRallocated -= head->size;
    381:   TRfrags--;
    382:   if (head->prev) head->prev->next = head->next;
    383:   else TRhead = head->next;
    384:   if (head->next) head->next->prev = head->prev;

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

    389:   head  = (TRSPACE*)inew;
    390:   inew += sizeof(TrSPACE);

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

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

    405:   TRallocated += nsize;
    406:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
    407:   TRfrags++;

    409: #if defined(PETSC_USE_DEBUG)
    410:   if (PetscStackActive()) {
    411:     PetscStackCopy(petscstack,&head->stack);
    413:     head->stack.line[head->stack.currentsize-2] = lineno;
    414:   } else {
    415:     head->stack.currentsize = 0;
    416:   }
    417: #endif

    419:   /*
    420:          Allow logging of all mallocs made
    421:   */
    422:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
    423:     if (!PetscLogMalloc) {
    424:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    425:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

    430:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    431:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
    432:     }
    433:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
    434:     PetscLogMallocFile[PetscLogMalloc]       = filename;
    435:     PetscLogMallocFunction[PetscLogMalloc++] = function;
    436:   }
    437:   *result = (void*)inew;
    438:   return(0);
    439: }

    442: /*@C
    443:     PetscMemoryView - Shows the amount of memory currently being used
    444:         in a communicator.

    446:     Collective on PetscViewer

    448:     Input Parameter:
    449: +    viewer - the viewer that defines the communicator
    450: -    message - string printed before values

    452:     Options Database:
    453: +    -malloc - have PETSc track how much memory it has allocated
    454: -    -memory_view - during PetscFinalize() have this routine called

    456:     Level: intermediate

    458:     Concepts: memory usage

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

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

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

    531:     Not Collective

    533:     Output Parameters:
    534: .   space - number of bytes currently allocated

    536:     Level: intermediate

    538:     Concepts: memory usage

    540: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    541:           PetscMemoryGetMaximumUsage()
    542:  @*/
    543: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
    544: {
    546:   *space = (PetscLogDouble) TRallocated;
    547:   return(0);
    548: }

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

    554:     Not Collective

    556:     Output Parameters:
    557: .   space - maximum number of bytes ever allocated at one time

    559:     Level: intermediate

    561:     Concepts: memory usage

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

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

    577:    Collective on PETSC_COMM_WORLD

    579:    Input Parameter:
    580: .    ptr - the memory location

    582:    Output Paramter:
    583: .    stack - the stack indicating where the program allocated this memory

    585:    Level: intermediate

    587: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
    588: @*/
    589: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
    590: {
    591:   TRSPACE *head;

    594:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
    595:   *stack = &head->stack;
    596:   return(0);
    597: }
    598: #else
    599: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
    600: {
    602:   *stack = NULL;
    603:   return(0);
    604: }
    605: #endif

    607: /*@C
    608:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
    609:    printed is: size of space (in bytes), address of space, id of space,
    610:    file in which space was allocated, and line number at which it was
    611:    allocated.

    613:    Collective on PETSC_COMM_WORLD

    615:    Input Parameter:
    616: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

    618:    Options Database Key:
    619: .  -malloc_dump - Dumps unfreed memory during call to PetscFinalize()

    621:    Level: intermediate

    623:    Fortran Note:
    624:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
    625:    The fp defaults to stdout.

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

    631:    Concepts: memory usage
    632:    Concepts: memory bleeding
    633:    Concepts: bleeding memory

    635: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
    636: @*/
    637: PetscErrorCode  PetscMallocDump(FILE *fp)
    638: {
    639:   TRSPACE        *head;
    640:   PetscInt       libAlloc = 0;
    642:   PetscMPIInt    rank;

    645:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    646:   if (!fp) fp = PETSC_STDOUT;
    647:   head = TRhead;
    648:   while (head) {
    649:     PetscBool isLib;

    651:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
    652:     libAlloc += head->size;
    653:     head = head->next;
    654:   }
    655:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
    656:   head = TRhead;
    657:   while (head) {
    658:     PetscBool isLib;

    660:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
    661:     if (!isLib) {
    662:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
    663: #if defined(PETSC_USE_DEBUG)
    664:       PetscStackPrint(&head->stack,fp);
    665: #endif
    666:     }
    667:     head = head->next;
    668:   }
    669:   return(0);
    670: }

    672: /* ---------------------------------------------------------------------------- */

    674: /*@
    675:     PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().

    677:     Not Collective

    679:     Options Database Key:
    680: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
    681: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

    683:     Level: advanced

    685: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
    686: @*/
    687: PetscErrorCode PetscMallocSetDumpLog(void)
    688: {

    692:   PetscLogMalloc = 0;

    694:   PetscMemorySetGetMaximumUsage();
    695:   return(0);
    696: }

    698: /*@
    699:     PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().

    701:     Not Collective

    703:     Input Arguments:
    704: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

    706:     Options Database Key:
    707: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
    708: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

    710:     Level: advanced

    712: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
    713: @*/
    714: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
    715: {

    719:   PetscMallocSetDumpLog();
    720:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
    721:   PetscLogMallocThreshold = (size_t)logmin;
    722:   return(0);
    723: }

    725: /*@
    726:     PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged

    728:     Not Collective

    730:     Output Arguments
    731: .   logging - PETSC_TRUE if logging is active

    733:     Options Database Key:
    734: .  -malloc_log - Activates PetscMallocDumpLog()

    736:     Level: advanced

    738: .seealso: PetscMallocDump(), PetscMallocDumpLog()
    739: @*/
    740: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
    741: {

    744:   *logging = (PetscBool)(PetscLogMalloc >= 0);
    745:   return(0);
    746: }

    748: /*@C
    749:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
    750:        PetscMemoryGetMaximumUsage()

    752:     Collective on PETSC_COMM_WORLD

    754:     Input Parameter:
    755: .   fp - file pointer; or NULL

    757:     Options Database Key:
    758: .  -malloc_log - Activates PetscMallocDumpLog()

    760:     Level: advanced

    762:    Fortran Note:
    763:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
    764:    The fp defaults to stdout.

    766: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
    767: @*/
    768: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
    769: {
    770:   PetscInt       i,j,n,dummy,*perm;
    771:   size_t         *shortlength;
    772:   int            *shortcount,err;
    773:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
    774:   PetscBool      match;
    775:   const char     **shortfunction;
    776:   PetscLogDouble rss;
    777:   MPI_Status     status;

    781:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    782:   MPI_Comm_size(MPI_COMM_WORLD,&size);
    783:   /*
    784:        Try to get the data printed in order by processor. This will only sometimes work
    785:   */
    786:   err = fflush(fp);
    787:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

    789:   MPI_Barrier(MPI_COMM_WORLD);
    790:   if (rank) {
    791:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
    792:   }

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

    796:   if (!fp) fp = PETSC_STDOUT;
    797:   PetscMemoryGetMaximumUsage(&rss);
    798:   if (rss) {
    799:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
    800:   } else {
    801:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
    802:   }
    803:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    804:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    805:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    806:   for (i=0,n=0; i<PetscLogMalloc; i++) {
    807:     for (j=0; j<n; j++) {
    808:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
    809:       if (match) {
    810:         shortlength[j] += PetscLogMallocLength[i];
    811:         shortcount[j]++;
    812:         goto foundit;
    813:       }
    814:     }
    815:     shortfunction[n] = PetscLogMallocFunction[i];
    816:     shortlength[n]   = PetscLogMallocLength[i];
    817:     shortcount[n]    = 1;
    818:     n++;
    819: foundit:;
    820:   }

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

    826:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
    827:   for (i=0; i<n; i++) {
    828:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
    829:   }
    830:   free(perm);
    831:   free(shortlength);
    832:   free(shortcount);
    833:   free((char**)shortfunction);
    834:   err = fflush(fp);
    835:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
    836:   if (rank != size-1) {
    837:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
    838:   }
    839:   return(0);
    840: }

    842: /* ---------------------------------------------------------------------------- */

    844: /*@
    845:     PetscMallocDebug - Turns on/off debugging for the memory management routines.

    847:     Not Collective

    849:     Input Parameter:
    850: .   level - PETSC_TRUE or PETSC_FALSE

    852:    Level: intermediate

    854: .seealso: CHKMEMQ(), PetscMallocValidate()
    855: @*/
    856: PetscErrorCode  PetscMallocDebug(PetscBool level)
    857: {
    859:   TRdebugLevel = level;
    860:   return(0);
    861: }

    863: /*@
    864:     PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.

    866:     Not Collective

    868:     Output Parameter:
    869: .    flg - PETSC_TRUE if any debugger

    871:    Level: intermediate

    873:     Note that by default, the debug version always does some debugging unless you run with -malloc no

    876: .seealso: CHKMEMQ(), PetscMallocValidate()
    877: @*/
    878: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
    879: {
    881:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
    882:   else *flg = PETSC_FALSE;
    883:   return(0);
    884: }