2: #include <petscsys.h>        /*I  "petscsys.h"   I*/


  5: #if defined(PETSC_HAVE_PTHREADCLASSES)
  6: #if defined(PETSC_PTHREAD_LOCAL)
  7: PETSC_PTHREAD_LOCAL PetscStack *petscstack = 0;
  8: #else
  9: PetscThreadKey petscstack;
 10: #endif
 11: #else
 12: PetscStack *petscstack = 0;
 13: #endif


 16: #if defined(PETSC_HAVE_SAWS)
 17: #include <petscviewersaws.h>

 19: static PetscBool amsmemstack = PETSC_FALSE;

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

 26:    Collective on PETSC_COMM_WORLD?

 28:    Level: developer

 30:    Concepts: publishing object


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

 36: @*/
 37: void  PetscStackSAWsGrantAccess(void)
 38: {
 39:   if (amsmemstack) {
 40:     /* ignore any errors from SAWs */
 41:     SAWs_Unlock();
 42:   }
 43: }

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

 50:    Collective on PETSC_COMM_WORLD?

 52:    Level: developer

 54:    Concepts: publishing object


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

 60: @*/
 61: void  PetscStackSAWsTakeAccess(void)
 62: {
 63:   if (amsmemstack) {
 64:     /* ignore any errors from SAWs */
 65:     SAWs_Lock();
 66:   }
 67: }

 69: PetscErrorCode PetscStackViewSAWs(void)
 70: {
 71:   PetscStack*    petscstackp;
 72:   PetscMPIInt    rank;

 75:   MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
 76:   if (rank) return 0;
 77:   petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);
 78:   PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/functions",petscstackp->function,20,SAWs_READ,SAWs_STRING));
 79:   PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/__current_size",&petscstackp->currentsize,1,SAWs_READ,SAWs_INT));
 80:   amsmemstack = PETSC_TRUE;
 81:   return 0;
 82: }

 86: PetscErrorCode PetscStackSAWsViewOff(void)
 87: {
 89:   if (!amsmemstack) return(0);
 90:   PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack"));
 91:   amsmemstack = PETSC_FALSE;
 92:   return(0);
 93: }

 95: #  endif


 98: PetscErrorCode PetscStackCreate(void)
 99: {
100:   PetscStack *petscstack_in;
101:   PetscInt   i;

103:   if (PetscStackActive()) return 0;

105:   petscstack_in              = (PetscStack*)malloc(sizeof(PetscStack));
106:   petscstack_in->currentsize = 0;
107:   petscstack_in->hotdepth    = 0;
108:   for (i=0; i<PETSCSTACKSIZE; i++) {
109:     petscstack_in->function[i] = 0;
110:     petscstack_in->file[i]     = 0;
111:   }
112:   PetscThreadLocalSetValue((PetscThreadKey*)&petscstack,petscstack_in);

114: #if defined(PETSC_HAVE_SAWS)
115:   {
116:   PetscBool flg = PETSC_FALSE;
117:   PetscOptionsHasName(NULL,"-stack_view",&flg);
118:   if (flg) PetscStackViewSAWs();
119:   }
120: #endif
121:   return 0;
122: }


127: PetscErrorCode  PetscStackView(FILE *file)
128: {
129:   int        i;
130:   PetscStack *petscstackp;

132:   petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);
133:   if (!file) file = PETSC_STDOUT;

135:   if (file == PETSC_STDOUT) {
136:     (*PetscErrorPrintf)("Note: The EXACT line numbers in the stack are not available,\n");
137:     (*PetscErrorPrintf)("      INSTEAD the line number of the start of the function\n");
138:     (*PetscErrorPrintf)("      is given.\n");
139:     for (i=petscstackp->currentsize-1; i>=0; i--) (*PetscErrorPrintf)("[%d] %s line %d %s\n",PetscGlobalRank,petscstackp->function[i],petscstackp->line[i],petscstackp->file[i]);
140:   } else {
141:     fprintf(file,"Note: The EXACT line numbers in the stack are not available,\n");
142:     fprintf(file,"      INSTEAD the line number of the start of the function\n");
143:     fprintf(file,"      is given.\n");
144:     for (i=petscstackp->currentsize-1; i>=0; i--) fprintf(file,"[%d] %s line %d %s\n",PetscGlobalRank,petscstackp->function[i],petscstackp->line[i],petscstackp->file[i]);
145:   }
146:   return 0;
147: }

149: PetscErrorCode PetscStackDestroy(void)
150: {
151:   if (PetscStackActive()) {
152:     PetscStack *petscstack_in;
153:     petscstack_in = (PetscStack*)PetscThreadLocalGetValue(petscstack);
154:     free(petscstack_in);
155:     PetscThreadLocalSetValue((PetscThreadKey*)&petscstack,NULL);
156:   }
157:   return 0;
158: }

163: PetscErrorCode  PetscStackCopy(PetscStack *sint,PetscStack *sout)
164: {
165:   int i;

167:   if (!sint) sout->currentsize = 0;
168:   else {
169:     for (i=0; i<sint->currentsize; i++) {
170:       sout->function[i]     = sint->function[i];
171:       sout->file[i]         = sint->file[i];
172:       sout->line[i]         = sint->line[i];
173:       sout->petscroutine[i] = sint->petscroutine[i];
174:     }
175:     sout->currentsize = sint->currentsize;
176:   }
177:   return 0;
178: }

183: PetscErrorCode  PetscStackPrint(PetscStack *sint,FILE *fp)
184: {
185:   int i;

187:   if (!sint) return(0);
188:   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]);
189:   return 0;
190: }