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;

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; i>=0; i--) (*PetscErrorPrintf)("[%d] %s line %d %s\n",PetscGlobalRank,petscstack->function[i],petscstack->line[i],petscstack->file[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; i>=0; i--) fprintf(file,"[%d] %s line %d %s\n",PetscGlobalRank,petscstack->function[i],petscstack->line[i],petscstack->file[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: }