2:  #include <petscsys.h>

  4: PetscStack *petscstack = 0;

  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

 18:    Concepts: publishing object


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

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

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

 36:    Collective on PETSC_COMM_WORLD?

 38:    Level: developer

 40:    Concepts: publishing object


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

 46: @*/
 47: void  PetscStackSAWsTakeAccess(void)
 48: {
 49:   if (amsmemstack) {
 50:     /* ignore any errors from SAWs */
 51:     SAWs_Lock();
 52:   }
 53: }

 55: PetscErrorCode PetscStackViewSAWs(void)
 56: {
 57:   PetscMPIInt    rank;

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

 68: PetscErrorCode PetscStackSAWsViewOff(void)
 69: {
 71:   if (!amsmemstack) return(0);
 72:   PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack"));
 73:   amsmemstack = PETSC_FALSE;
 74:   return(0);
 75: }

 77: #  endif


 80: PetscErrorCode PetscStackCreate(void)
 81: {
 82:   PetscStack *petscstack_in;
 83:   PetscInt   i;

 85:   if (PetscStackActive()) return 0;

 87:   petscstack_in              = (PetscStack*)malloc(sizeof(PetscStack));
 88:   petscstack_in->currentsize = 0;
 89:   petscstack_in->hotdepth    = 0;
 90:   for (i=0; i<PETSCSTACKSIZE; i++) {
 91:     petscstack_in->function[i] = 0;
 92:     petscstack_in->file[i]     = 0;
 93:   }
 94:   petscstack = petscstack_in;

 96: #if defined(PETSC_HAVE_SAWS)
 97:   {
 98:   PetscBool flg = PETSC_FALSE;
 99:   PetscOptionsHasName(NULL,NULL,"-stack_view",&flg);
100:   if (flg) PetscStackViewSAWs();
101:   }
102: #endif
103:   return 0;
104: }


107: PetscErrorCode  PetscStackView(FILE *file)
108: {
109:   int        i;

111:   if (!file) file = PETSC_STDOUT;

113:   if (file == PETSC_STDOUT) {
114:     (*PetscErrorPrintf)("Note: The EXACT line numbers in the stack are not available,\n");
115:     (*PetscErrorPrintf)("      INSTEAD the line number of the start of the function\n");
116:     (*PetscErrorPrintf)("      is given.\n");
117:     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]);
118:   } else {
119:     fprintf(file,"Note: The EXACT line numbers in the stack are not available,\n");
120:     fprintf(file,"      INSTEAD the line number of the start of the function\n");
121:     fprintf(file,"      is given.\n");
122:     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]);
123:   }
124:   return 0;
125: }

127: PetscErrorCode PetscStackDestroy(void)
128: {
129:   if (PetscStackActive()) {
130:     free(petscstack);
131:     petscstack = NULL;
132:   }
133:   return 0;
134: }

137: PetscErrorCode  PetscStackCopy(PetscStack *sint,PetscStack *sout)
138: {
139:   int i;

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

155: PetscErrorCode  PetscStackPrint(PetscStack *sint,FILE *fp)
156: {
157:   int i;

159:   if (!sint) return(0);
160:   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]);
161:   return 0;
162: }