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