1 2 #include <petscsys.h> /*I "petscsys.h" I*/ 3 4 PetscStack *petscstack = NULL; 5 6 #if defined(PETSC_HAVE_SAWS) 7 #include <petscviewersaws.h> 8 9 static PetscBool amsmemstack = PETSC_FALSE; 10 11 /*@C 12 PetscStackSAWsGrantAccess - Grants access of the PETSc stack frames to the SAWs publisher 13 14 Collective on PETSC_COMM_WORLD? 15 16 Level: developer 17 18 Developers Note: Cannot use PetscFunctionBegin/Return() or PetscStackCallSAWs() since it may be used within those routines 19 20 .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess() 21 22 @*/ 23 void PetscStackSAWsGrantAccess(void) 24 { 25 if (amsmemstack) { 26 /* ignore any errors from SAWs */ 27 SAWs_Unlock(); 28 } 29 } 30 31 /*@C 32 PetscStackSAWsTakeAccess - Takes access of the PETSc stack frames to the SAWs publisher 33 34 Collective on PETSC_COMM_WORLD? 35 36 Level: developer 37 38 Developers Note: Cannot use PetscFunctionBegin/Return() or PetscStackCallSAWs() since it may be used within those routines 39 40 .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess() 41 42 @*/ 43 void PetscStackSAWsTakeAccess(void) 44 { 45 if (amsmemstack) { 46 /* ignore any errors from SAWs */ 47 SAWs_Lock(); 48 } 49 } 50 51 PetscErrorCode PetscStackViewSAWs(void) 52 { 53 PetscMPIInt rank; 54 PetscErrorCode ierr; 55 56 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRMPI(ierr); 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 } 63 64 PetscErrorCode PetscStackSAWsViewOff(void) 65 { 66 PetscFunctionBegin; 67 if (!amsmemstack) PetscFunctionReturn(0); 68 PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack")); 69 amsmemstack = PETSC_FALSE; 70 PetscFunctionReturn(0); 71 } 72 73 # endif 74 75 PetscErrorCode PetscStackCreate(void) 76 { 77 PetscStack *petscstack_in; 78 PetscInt i; 79 80 if (PetscStackActive()) return 0; 81 82 petscstack_in = (PetscStack*)malloc(sizeof(PetscStack)); 83 petscstack_in->currentsize = 0; 84 petscstack_in->hotdepth = 0; 85 for (i=0; i<PETSCSTACKSIZE; i++) { 86 petscstack_in->function[i] = NULL; 87 petscstack_in->file[i] = NULL; 88 } 89 petscstack = petscstack_in; 90 91 #if defined(PETSC_HAVE_SAWS) 92 { 93 PetscBool flg = PETSC_FALSE; 94 PetscOptionsHasName(NULL,NULL,"-stack_view",&flg); 95 if (flg) PetscStackViewSAWs(); 96 } 97 #endif 98 return 0; 99 } 100 101 PetscErrorCode PetscStackView(FILE *file) 102 { 103 int i,j; 104 105 if (!file) file = PETSC_STDOUT; 106 107 if (petscstack->currentsize <= 1) { 108 if (file == PETSC_STDOUT) { 109 (*PetscErrorPrintf)("No error traceback is avaiable, the problem could be in the main program. \n"); 110 } else { 111 fprintf(file,"No error traceback is avaiable, the problem could be in the main program. \n"); 112 } 113 } else { 114 if (file == PETSC_STDOUT) { 115 (*PetscErrorPrintf)("The EXACT line numbers in the error traceback are not available.\n"); 116 (*PetscErrorPrintf)("instead the line number of the start of the function is given.\n"); 117 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]); 118 } else { 119 fprintf(file,"The EXACT line numbers in the error traceback are not available.\n"); 120 fprintf(file,"Instead the line number of the start of the function is given.\n"); 121 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]); 122 } 123 } 124 return 0; 125 } 126 127 PetscErrorCode PetscStackDestroy(void) 128 { 129 if (PetscStackActive()) { 130 free(petscstack); 131 petscstack = NULL; 132 } 133 return 0; 134 } 135 136 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 137 PetscErrorCode PetscStackCopy(PetscStack *sint,PetscStack *sout) 138 { 139 int i; 140 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 } 153 154 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 155 PetscErrorCode PetscStackPrint(PetscStack *sint,FILE *fp) 156 { 157 int i; 158 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 } 163 164