1 2 #include <petscsys.h> /*I "petscsys.h" I*/ 3 4 PetscStack *petscstack = 0; 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 Concepts: publishing object 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 Concepts: publishing object 41 42 Developers Note: Cannot use PetscFunctionBegin/Return() or PetscStackCallSAWs() since it may be used within those routines 43 44 .seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsTakeAccess() 45 46 @*/ 47 void PetscStackSAWsTakeAccess(void) 48 { 49 if (amsmemstack) { 50 /* ignore any errors from SAWs */ 51 SAWs_Lock(); 52 } 53 } 54 55 PetscErrorCode PetscStackViewSAWs(void) 56 { 57 PetscMPIInt rank; 58 PetscErrorCode ierr; 59 60 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 61 if (rank) return 0; 62 PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/functions",petscstack->function,20,SAWs_READ,SAWs_STRING)); 63 PetscStackCallSAWs(SAWs_Register,("/PETSc/Stack/__current_size",&petscstack->currentsize,1,SAWs_READ,SAWs_INT)); 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 77 # endif 78 79 80 PetscErrorCode PetscStackCreate(void) 81 { 82 PetscStack *petscstack_in; 83 PetscInt i; 84 85 if (PetscStackActive()) return 0; 86 87 petscstack_in = (PetscStack*)malloc(sizeof(PetscStack)); 88 petscstack_in->currentsize = 0; 89 petscstack_in->hotdepth = 0; 90 for (i=0; i<PETSCSTACKSIZE; i++) { 91 petscstack_in->function[i] = 0; 92 petscstack_in->file[i] = 0; 93 } 94 petscstack = petscstack_in; 95 96 #if defined(PETSC_HAVE_SAWS) 97 { 98 PetscBool flg = PETSC_FALSE; 99 PetscOptionsHasName(NULL,NULL,"-stack_view",&flg); 100 if (flg) PetscStackViewSAWs(); 101 } 102 #endif 103 return 0; 104 } 105 106 107 PetscErrorCode PetscStackView(FILE *file) 108 { 109 int i; 110 111 if (!file) file = PETSC_STDOUT; 112 113 if (file == PETSC_STDOUT) { 114 (*PetscErrorPrintf)("Note: The EXACT line numbers in the stack are not available,\n"); 115 (*PetscErrorPrintf)(" INSTEAD the line number of the start of the function\n"); 116 (*PetscErrorPrintf)(" is given.\n"); 117 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]); 118 } else { 119 fprintf(file,"Note: The EXACT line numbers in the stack are not available,\n"); 120 fprintf(file," INSTEAD the line number of the start of the function\n"); 121 fprintf(file," is given.\n"); 122 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]); 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