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 76 PetscErrorCode PetscStackCreate(void) 77 { 78 PetscStack *petscstack_in; 79 PetscInt i; 80 81 if (PetscStackActive()) return 0; 82 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; 91 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 } 101 102 103 PetscErrorCode PetscStackView(FILE *file) 104 { 105 int i,j; 106 107 if (!file) file = PETSC_STDOUT; 108 109 if (petscstack->currentsize <= 1) { 110 if (file == PETSC_STDOUT) { 111 (*PetscErrorPrintf)("No error traceback is avaiable, the problem could be in the main program. \n"); 112 } else { 113 fprintf(file,"No error traceback is avaiable, the problem could be in the main program. \n"); 114 } 115 } else { 116 if (file == PETSC_STDOUT) { 117 (*PetscErrorPrintf)("The EXACT line numbers in the error traceback are not available.\n"); 118 (*PetscErrorPrintf)("instead the line number of the start of the function is given.\n"); 119 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]); 120 } else { 121 fprintf(file,"The EXACT line numbers in the error traceback are not available.\n"); 122 fprintf(file,"Instead the line number of the start of the function is given.\n"); 123 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]); 124 } 125 } 126 return 0; 127 } 128 129 PetscErrorCode PetscStackDestroy(void) 130 { 131 if (PetscStackActive()) { 132 free(petscstack); 133 petscstack = NULL; 134 } 135 return 0; 136 } 137 138 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 139 PetscErrorCode PetscStackCopy(PetscStack *sint,PetscStack *sout) 140 { 141 int i; 142 143 if (!sint) sout->currentsize = 0; 144 else { 145 for (i=0; i<sint->currentsize; i++) { 146 sout->function[i] = sint->function[i]; 147 sout->file[i] = sint->file[i]; 148 sout->line[i] = sint->line[i]; 149 sout->petscroutine[i] = sint->petscroutine[i]; 150 } 151 sout->currentsize = sint->currentsize; 152 } 153 return 0; 154 } 155 156 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 157 PetscErrorCode PetscStackPrint(PetscStack *sint,FILE *fp) 158 { 159 int i; 160 161 if (!sint) return(0); 162 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]); 163 return 0; 164 } 165 166