1 #include <petsc/private/fortranimpl.h> 2 #include <petscsys.h> 3 #include <petscviewer.h> 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define petscmallocdump_ PETSCMALLOCDUMP 7 #define petscmallocview_ PETSCMALLOCVIEW 8 #define petscmallocvalidate_ PETSCMALLOCVALIDATE 9 #define petscmemoryview_ PETSCMEMORYVIEW 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define petscmallocdump_ petscmallocdump 12 #define petscmallocview_ petscmallocview 13 #define petscmallocvalidate_ petscmallocvalidate 14 #define petscmemoryview_ petscmemoryview 15 #endif 16 17 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 18 { 19 PetscInt i; 20 size_t len; 21 22 PetscFunctionBegin; 23 PetscCall(PetscStrallocpy(in, out)); 24 PetscCall(PetscStrlen(*out, &len)); 25 for (i = 0; i < (int)len - 1; i++) { 26 if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') { 27 (*out)[i] = ' '; 28 (*out)[i + 1] = '\n'; 29 } 30 } 31 PetscFunctionReturn(PETSC_SUCCESS); 32 } 33 34 PETSC_EXTERN void petscmallocdump_(PetscErrorCode *ierr) 35 { 36 *ierr = PetscMallocDump(stdout); 37 } 38 PETSC_EXTERN void petscmallocview_(PetscErrorCode *ierr) 39 { 40 *ierr = PetscMallocView(stdout); 41 } 42 43 PETSC_EXTERN void petscmallocvalidate_(PetscErrorCode *ierr) 44 { 45 *ierr = PetscMallocValidate(0, "Unknown Fortran", 0); 46 } 47 48 PETSC_EXTERN void petscmemoryview_(PetscViewer *vin, char *message, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 49 { 50 PetscViewer v; 51 char *msg, *tmp; 52 53 FIXCHAR(message, len, msg); 54 *ierr = PetscFixSlashN(msg, &tmp); 55 if (*ierr) return; 56 FREECHAR(message, msg); 57 PetscPatchDefaultViewers_Fortran(vin, v); 58 *ierr = PetscMemoryView(v, tmp); 59 if (*ierr) return; 60 *ierr = PetscFree(tmp); 61 } 62