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

  4: PetscStack *petscstack = 0;

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

  9: static PetscBool amsmemstack = PETSC_FALSE;

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

 16:    Collective on PETSC_COMM_WORLD?

 18:    Level: developer

 20:    Concepts: publishing object


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

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

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

 40:    Collective on PETSC_COMM_WORLD?

 42:    Level: developer

 44:    Concepts: publishing object


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

 50: @*/
 51: void  PetscStackSAWsTakeAccess(void)
 52: {
 53:   if (amsmemstack) {
 54:     /* ignore any errors from SAWs */
 55:     SAWs_Lock();
 56:   }
 57: }

 59: PetscErrorCode PetscStackViewSAWs(void)
 60: {
 61:   PetscMPIInt    rank;

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

 74: PetscErrorCode PetscStackSAWsViewOff(void)
 75: {
 77:   if (!amsmemstack) return(0);
 78:   PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack"));
 79:   amsmemstack = PETSC_FALSE;
 80:   return(0);
 81: }

 83: #  endif


 86: PetscErrorCode PetscStackCreate(void)
 87: {
 88:   PetscStack *petscstack_in;
 89:   PetscInt   i;

 91:   if (PetscStackActive()) return 0;

 93:   petscstack_in              = (PetscStack*)malloc(sizeof(PetscStack));
 94:   petscstack_in->currentsize = 0;
 95:   petscstack_in->hotdepth    = 0;
 96:   for (i=0; i<PETSCSTACKSIZE; i++) {
 97:     petscstack_in->function[i] = 0;
 98:     petscstack_in->file[i]     = 0;
 99:   }
100:   petscstack = petscstack_in;

102: #if defined(PETSC_HAVE_SAWS)
103:   {
104:   PetscBool flg = PETSC_FALSE;
105:   PetscOptionsHasName(NULL,"-stack_view",&flg);
106:   if (flg) PetscStackViewSAWs();
107:   }
108: #endif
109:   return 0;
110: }


115: PetscErrorCode  PetscStackView(FILE *file)
116: {
117:   int        i;

119:   if (!file) file = PETSC_STDOUT;

121:   if (file == PETSC_STDOUT) {
122:     (*PetscErrorPrintf)("Note: The EXACT line numbers in the stack are not available,\n");
123:     (*PetscErrorPrintf)("      INSTEAD the line number of the start of the function\n");
124:     (*PetscErrorPrintf)("      is given.\n");
125:     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]);
126:   } else {
127:     fprintf(file,"Note: The EXACT line numbers in the stack are not available,\n");
128:     fprintf(file,"      INSTEAD the line number of the start of the function\n");
129:     fprintf(file,"      is given.\n");
130:     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]);
131:   }
132:   return 0;
133: }

135: PetscErrorCode PetscStackDestroy(void)
136: {
137:   if (PetscStackActive()) {
138:     free(petscstack);
139:     petscstack = NULL;
140:   }
141:   return 0;
142: }

147: PetscErrorCode  PetscStackCopy(PetscStack *sint,PetscStack *sout)
148: {
149:   int i;

151:   if (!sint) sout->currentsize = 0;
152:   else {
153:     for (i=0; i<sint->currentsize; i++) {
154:       sout->function[i]     = sint->function[i];
155:       sout->file[i]         = sint->file[i];
156:       sout->line[i]         = sint->line[i];
157:       sout->petscroutine[i] = sint->petscroutine[i];
158:     }
159:     sout->currentsize = sint->currentsize;
160:   }
161:   return 0;
162: }

167: PetscErrorCode  PetscStackPrint(PetscStack *sint,FILE *fp)
168: {
169:   int i;

171:   if (!sint) return(0);
172:   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]);
173:   return 0;
174: }