1 2 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/ 3 4 #if PetscDefined(USE_DEBUG) 5 PetscStack petscstack; 6 #endif 7 8 #if defined(PETSC_HAVE_SAWS) 9 #include <petscviewersaws.h> 10 11 static PetscBool amsmemstack = PETSC_FALSE; 12 13 /*@C 14 PetscStackSAWsGrantAccess - Grants access of the PETSc stack frames to the SAWs publisher 15 16 Collective on PETSC_COMM_WORLD? 17 18 Level: developer 19 20 Developers Note: Cannot use PetscFunctionBegin/Return() or PetscStackCallSAWs() since it may be used within those routines 21 22 .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess() 23 24 @*/ 25 void PetscStackSAWsGrantAccess(void) 26 { 27 if (amsmemstack) { 28 /* ignore any errors from SAWs */ 29 SAWs_Unlock(); 30 } 31 } 32 33 /*@C 34 PetscStackSAWsTakeAccess - Takes access of the PETSc stack frames to the SAWs publisher 35 36 Collective on PETSC_COMM_WORLD? 37 38 Level: developer 39 40 Developers Note: Cannot use PetscFunctionBegin/Return() or PetscStackCallSAWs() since it may be used within those routines 41 42 .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess() 43 44 @*/ 45 void PetscStackSAWsTakeAccess(void) 46 { 47 if (amsmemstack) { 48 /* ignore any errors from SAWs */ 49 SAWs_Lock(); 50 } 51 } 52 53 PetscErrorCode PetscStackViewSAWs(void) 54 { 55 PetscMPIInt rank; 56 PetscErrorCode ierr; 57 58 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRMPI(ierr); 59 if (rank) return 0; 60 #if PetscDefined(USE_DEBUG) 61 PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/functions",petscstack.function,20,SAWs_READ,SAWs_STRING)); 62 PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/__current_size",&petscstack.currentsize,1,SAWs_READ,SAWs_INT)); 63 #endif 64 amsmemstack = PETSC_TRUE; 65 return 0; 66 } 67 68 PetscErrorCode PetscStackSAWsViewOff(void) 69 { 70 PetscFunctionBegin; 71 if (!amsmemstack) PetscFunctionReturn(0); 72 PetscStackCallSAWs(SAWs_Delete,("/PETSc/Stack")); 73 amsmemstack = PETSC_FALSE; 74 PetscFunctionReturn(0); 75 } 76 #endif /* PETSC_HAVE_SAWS */ 77 78 #if PetscDefined(USE_DEBUG) 79 PetscErrorCode PetscStackSetCheck(PetscBool check) 80 { 81 petscstack.check = check; 82 return 0; 83 } 84 85 PetscErrorCode PetscStackReset(void) 86 { 87 memset(&petscstack,0,sizeof(petscstack)); 88 return 0; 89 } 90 91 PetscErrorCode PetscStackView(FILE *file) 92 { 93 if (!file) file = PETSC_STDOUT; 94 if (petscstack.currentsize < 0) { 95 /* < 0 is absolutely a corrupted stack, but this function is usually called in an error 96 * handler, which are not capable of recovering from errors so best we can do is print 97 * this warning */ 98 fprintf(file,"PetscStack is definitely corrupted with stack size %d\n",petscstack.currentsize); 99 } else if (petscstack.currentsize == 0) { 100 if (file == PETSC_STDOUT) { 101 (*PetscErrorPrintf)("No error traceback is available, the problem could be in the main program. \n"); 102 } else { 103 fprintf(file,"No error traceback is available, the problem could be in the main program. \n"); 104 } 105 } else { 106 if (file == PETSC_STDOUT) { 107 (*PetscErrorPrintf)("The EXACT line numbers in the error traceback are not available.\n"); 108 (*PetscErrorPrintf)("instead the line number of the start of the function is given.\n"); 109 for (int i = petscstack.currentsize-1, j = 1; i >= 0; --i, ++j) { 110 (*PetscErrorPrintf)("#%d %s() at %s:%d\n",j,petscstack.function[i],petscstack.file[i],petscstack.line[i]); 111 } 112 } else { 113 fprintf(file,"The EXACT line numbers in the error traceback are not available.\n"); 114 fprintf(file,"Instead the line number of the start of the function is given.\n"); 115 for (int i = petscstack.currentsize-1, j = 1; i >= 0; --i, ++j) { 116 fprintf(file,"[%d] #%d %s() at %s:%d\n",PetscGlobalRank,j,petscstack.function[i],petscstack.file[i],petscstack.line[i]); 117 } 118 } 119 } 120 return 0; 121 } 122 123 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 124 PetscErrorCode PetscStackCopy(PetscStack *sint,PetscStack *sout) 125 { 126 if (sint) { 127 for (int i = 0; i < sint->currentsize; ++i) { 128 sout->function[i] = sint->function[i]; 129 sout->file[i] = sint->file[i]; 130 sout->line[i] = sint->line[i]; 131 sout->petscroutine[i] = sint->petscroutine[i]; 132 } 133 sout->currentsize = sint->currentsize; 134 } else { 135 sout->currentsize = 0; 136 } 137 return 0; 138 } 139 140 /* PetscFunctionBegin; so that make rule checkbadPetscFunctionBegin works */ 141 PetscErrorCode PetscStackPrint(PetscStack *sint,FILE *fp) 142 { 143 if (sint) { 144 for (int i = sint->currentsize-2; i >= 0; --i) { 145 fprintf(fp," [%d] %s() at %s:%d\n",PetscGlobalRank,sint->function[i],sint->file[i],sint->line[i]); 146 } 147 } 148 return 0; 149 } 150 #endif /* PetscDefined(USE_DEBUG) */ 151