Actual source code: pstack.c

      2: #include <petscsys.h>

      4: PetscStack *petscstack = NULL;

      6: #if defined(PETSC_HAVE_SAWS)
      7: #include <petscviewersaws.h>

      9: static PetscBool amsmemstack = PETSC_FALSE;

     11: /*@C
     12:    PetscStackSAWsGrantAccess - Grants access of the PETSc stack frames to the SAWs publisher

     14:    Collective on PETSC_COMM_WORLD?

     16:    Level: developer

     20: .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess()

     22: @*/
     23: void  PetscStackSAWsGrantAccess(void)
     24: {
     25:   if (amsmemstack) {
     26:     /* ignore any errors from SAWs */
     27:     SAWs_Unlock();
     28:   }
     29: }

     31: /*@C
     32:    PetscStackSAWsTakeAccess - Takes access of the PETSc stack frames to the SAWs publisher

     34:    Collective on PETSC_COMM_WORLD?

     36:    Level: developer

     40: .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess()

     42: @*/
     43: void  PetscStackSAWsTakeAccess(void)
     44: {
     45:   if (amsmemstack) {
     46:     /* ignore any errors from SAWs */
     47:     SAWs_Lock();
     48:   }
     49: }

     51: PetscErrorCode PetscStackViewSAWs(void)
     52: {
     53:   PetscMPIInt    rank;

     56:   MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
     57:   if (rank) return 0;
     58:   PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/functions",petscstack->function,20,SAWs_READ,SAWs_STRING));
     59:   PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/__current_size",&petscstack->currentsize,1,SAWs_READ,SAWs_INT));
     60:   amsmemstack = PETSC_TRUE;
     61:   return 0;
     62: }

     64: PetscErrorCode PetscStackSAWsViewOff(void)
     65: {
     67:   if (!amsmemstack) return(0);
     68:   PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack"));
     69:   amsmemstack = PETSC_FALSE;
     70:   return(0);
     71: }

     73: #  endif

     76: PetscErrorCode PetscStackCreate(void)
     77: {
     78:   PetscStack *petscstack_in;
     79:   PetscInt   i;

     81:   if (PetscStackActive()) return 0;

     83:   petscstack_in              = (PetscStack*)malloc(sizeof(PetscStack));
     84:   petscstack_in->currentsize = 0;
     85:   petscstack_in->hotdepth    = 0;
     86:   for (i=0; i<PETSCSTACKSIZE; i++) {
     87:     petscstack_in->function[i] = NULL;
     88:     petscstack_in->file[i]     = NULL;
     89:   }
     90:   petscstack = petscstack_in;

     92: #if defined(PETSC_HAVE_SAWS)
     93:   {
     94:   PetscBool flg = PETSC_FALSE;
     95:   PetscOptionsHasName(NULL,NULL,"-stack_view",&flg);
     96:   if (flg) PetscStackViewSAWs();
     97:   }
     98: #endif
     99:   return 0;
    100: }

    103: PetscErrorCode  PetscStackView(FILE *file)
    104: {
    105:   int        i,j;

    107:   if (!file) file = PETSC_STDOUT;

    109:   if (file == PETSC_STDOUT) {
    110:     (*PetscErrorPrintf)("Note: The EXACT line numbers in the stack are not available,\n");
    111:     (*PetscErrorPrintf)("      INSTEAD the line number of the start of the function\n");
    112:     (*PetscErrorPrintf)("      is given.\n");
    113:     for (i=petscstack->currentsize-1,j=1; i>=0; i--,j++) (*PetscErrorPrintf)("#%d %s() at %s:%d\n",j,petscstack->function[i],petscstack->file[i],petscstack->line[i]);
    114:   } else {
    115:     fprintf(file,"Note: The EXACT line numbers in the stack are not available,\n");
    116:     fprintf(file,"      INSTEAD the line number of the start of the function\n");
    117:     fprintf(file,"      is given.\n");
    118:     for (i=petscstack->currentsize-1,j=1; i>=0; i--,j++) fprintf(file,"[%d] #%d %s() at %s:%d\n",PetscGlobalRank,j,petscstack->function[i],petscstack->file[i],petscstack->line[i]);
    119:   }
    120:   return 0;
    121: }

    123: PetscErrorCode PetscStackDestroy(void)
    124: {
    125:   if (PetscStackActive()) {
    126:     free(petscstack);
    127:     petscstack = NULL;
    128:   }
    129:   return 0;
    130: }

    133: PetscErrorCode  PetscStackCopy(PetscStack *sint,PetscStack *sout)
    134: {
    135:   int i;

    137:   if (!sint) sout->currentsize = 0;
    138:   else {
    139:     for (i=0; i<sint->currentsize; i++) {
    140:       sout->function[i]     = sint->function[i];
    141:       sout->file[i]         = sint->file[i];
    142:       sout->line[i]         = sint->line[i];
    143:       sout->petscroutine[i] = sint->petscroutine[i];
    144:     }
    145:     sout->currentsize = sint->currentsize;
    146:   }
    147:   return 0;
    148: }

    151: PetscErrorCode  PetscStackPrint(PetscStack *sint,FILE *fp)
    152: {
    153:   int i;

    155:   if (!sint) return(0);
    156:   for (i=sint->currentsize-2; i>=0; i--) fprintf(fp,"      [%d]  %s() line %d in %s\n",PetscGlobalRank,sint->function[i],sint->line[i],sint->file[i]);
    157:   return 0;
    158: }