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