Merge pull request #42 from pmarguinaud/debug-crc64

Print CRC64 code each time a pointer is requested
ecmwf-ifs · May 30, 2024 · 0f60b5b · 0f60b5b
2 parents e6d9208 + 72c46ad
commit 0f60b5b
Show file tree

Hide file tree

Showing 9 changed files with 140 additions and 13 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -93,7 +93,7 @@ if( NOT fiat_FOUND )
   list(APPEND srcs ${ABOR1_PATH} ${OML_PATH} ${PARKIND1_PATH})
 endif()
 
-list(APPEND srcs field_async_module.F90 field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90 field_statistics_module.F90)
+list(APPEND srcs field_async_module.F90 field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90 field_statistics_module.F90 field_backtrace.c)
 
 ## check for CUDA
 include(CheckLanguage)
@@ -108,6 +108,8 @@ ecbuild_add_option( FEATURE BUDDY_MALLOC
     DEFAULT ON
 )
 
+check_symbol_exists(backtrace execinfo.h HAVE_BACKTRACE)
+
 ## fypp preprocessor flags
 if(HAVE_BUDDY_MALLOC)
   list( APPEND fypp_defines "-DUSE_BUDDY_MALLOC")
@@ -174,6 +176,10 @@ foreach(prec ${precisions})
                               INTERFACE $<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}/${LIBNAME}_${prec}> 
                             )
 
+  if( HAVE_BACKTRACE )
+      target_compile_definitions( ${LIBNAME}_${prec} PRIVATE HAVE_BACKTRACE )
+  endif()
+
   if( prec MATCHES sp )
       target_compile_definitions( ${LIBNAME}_${prec} PRIVATE PARKIND1_SINGLE )
   endif()

diff --git a/field_RANKSUFF_access_module.fypp b/field_RANKSUFF_access_module.fypp
@@ -55,19 +55,59 @@ CONTAINS
 
 #:for ft in fieldTypeList
   SUBROUTINE SGET_${what}$_DATA_${mode}$_${ft.name}$ (PTR, FIELD_PTR) 
+    USE FIELD_DEFAULTS_MODULE
+
     CLASS (${ft.name}$), POINTER, OPTIONAL :: FIELD_PTR
     ${ft.type}$, POINTER :: PTR(${ft.shape}$)
+    INTEGER*8 :: ICRC
+    CHARACTER*1024 :: CLBT
+    CHARACTER*10 :: CLF
+    INTEGER :: ILEN, IP1, IP2
+
+
+    ICRC = 0
 
     IF (PRESENT (FIELD_PTR)) THEN
       IF (ASSOCIATED (FIELD_PTR)) THEN
         CALL FIELD_PTR%GET_${what}$_DATA_${mode}$ (PTR)
+
+        IF (GET_DEBUG_PRINT_CRC) THEN
+          ICRC = FIELD_PTR%CRC64 ()
+        ENDIF
+
       ELSE
         PTR => DUMMY_${ft.name}$
       ENDIF
     ELSE
       PTR => DUMMY_${ft.name}$
     ENDIF
 
+
+    IF (GET_DEBUG_PRINT_CRC) THEN
+      WRITE (0, '(Z16.16," ")', ADVANCE='NO') ICRC
+    ENDIF
+
+    IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN
+      CLF = "${ft.name}$"
+      WRITE (0, '(A10)', ADVANCE='NO') CLF
+      CLF = "${mode}$"
+      WRITE (0, '(A10)', ADVANCE='NO') CLF
+      CLF = "${what}$"
+      WRITE (0, '(A10)', ADVANCE='NO') CLF
+    ENDIF
+
+    IF (GET_DEBUG_PRINT_LOCATION) THEN
+      ILEN = LEN (CLBT)
+      IP1 = 2
+      IP2 = 2 + GET_DEBUG_PRINT_LOCATION_DEPTH
+      CALL FIELD_BACKTRACE (CLBT, IP1, IP2, ILEN)
+      WRITE (0, '(A)', ADVANCE='NO') CLBT (1:ILEN)
+    ENDIF
+
+    IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN
+      WRITE (0, *)
+    ENDIF
+
   END SUBROUTINE SGET_${what}$_DATA_${mode}$_${ft.name}$
 
   FUNCTION GET_${what}$_DATA_${mode}$_${ft.name}$ (FIELD_PTR) RESULT (PTR)

diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp
@@ -69,6 +69,7 @@ CONTAINS
   PROCEDURE, PRIVATE :: ${ftn}$_GET_DEVICE_DATA
   PROCEDURE, PRIVATE :: COPY_DATA =>  ${ftn}$_COPY_DATA
   PROCEDURE :: CREATE_DEVICE_DATA => ${ftn}$_CREATE_DEVICE_DATA
+  PROCEDURE :: CRC64 => ${ftn}$_CRC64
 #ifdef __PGI
   PROCEDURE :: SET_STATUS => ${ftn}$_SET_STATUS
 #endif
@@ -521,6 +522,31 @@ CONTAINS
 
   END SUBROUTINE ${ftn}$_GET_DEVICE_DATA
 
+  INTEGER*8 FUNCTION ${ftn}$_CRC64 (SELF) RESULT (ICRC)
+    CLASS(${ftn}$) :: SELF
+    ${ft.type}$, POINTER :: PTR(${ft.shape}$)
+    ${ft.type}$, ALLOCATABLE :: ZZ(${ft.shape}$)
+    INTEGER*8 :: ILEN
+    EXTERNAL :: CRC64
+
+    ICRC = 0   
+
+    IF (IAND (SELF%GET_STATUS (), NHSTFRESH) /= 0) THEN
+      CALL SELF%GET_HOST_DATA_RDONLY (PTR)
+      ILEN = SIZE (PTR) * KIND (PTR)
+      CALL CRC64 (PTR, ILEN, ICRC)
+    ELSEIF (IAND (SELF%GET_STATUS (), NDEVFRESH) /= 0) THEN
+      CALL SELF%GET_DEVICE_DATA_RDONLY (PTR)
+      ALLOCATE (ZZ, MOLD=PTR)
+!$acc kernels present (PTR) copyout (ZZ)
+      ZZ = PTR
+!$acc end kernels
+      ILEN = SIZE (ZZ) * KIND (ZZ)
+      CALL CRC64 (ZZ, ILEN, ICRC)
+    ENDIF
+
+  END FUNCTION
+
   SUBROUTINE ${ftn}$_OWNER_GET_DEVICE_DATA (SELF, MODE, PTR, QUEUE)
     CLASS(${ftn}$_OWNER) :: SELF
     INTEGER (KIND=JPIM),           INTENT(IN)    :: MODE

diff --git a/field_RANKSUFF_util_module.fypp b/field_RANKSUFF_util_module.fypp
@@ -38,19 +38,12 @@ CONTAINS
 #:for ft in fieldTypeList
 INTEGER*8 FUNCTION CRC64_${ft.name}$ (YD)
 CLASS (${ft.name}$), POINTER :: YD
-
-INTEGER*8 :: ICRC, ILEN
-${ft.type}$, POINTER :: PTR(${ft.shape}$)
-EXTERNAL :: CRC64
+INTEGER*8 :: ICRC
 
 ICRC = 0
 
 IF (ASSOCIATED (YD)) THEN
-
-  PTR => GET_HOST_DATA_RDONLY (YD)
-  ILEN = SIZE (PTR)
-  CALL CRC64 (PTR, ILEN, ICRC)
-
+  ICRC = YD%CRC64 ()
 ENDIF
 
 CRC64_${ft.name}$ = ICRC

diff --git a/field_backtrace.c b/field_backtrace.c
@@ -0,0 +1,40 @@
+#include <string.h>
+
+#ifdef HAVE_BACKTRACE
+
+#include <execinfo.h>
+#include <stdio.h>
+
+void field_backtrace_ (char * str, int * p1, int * p2, int * plen)
+{
+  void * addr[*p2];
+  int size;
+  int i;
+  char * pstr = str;
+
+  memset (str, ' ', *plen);
+
+  size = backtrace (addr, *p2);
+
+  for (i = *p1; i < size; i++)
+    {
+      sprintf (pstr, " 0x%16.16llx", addr[i]);
+      pstr += 3 + 16;
+    }
+
+  *plen = pstr - str;
+
+}
+
+
+#else
+
+void field_backtrace_ (char * str, int * p1, int * p2, int * plen)
+{
+  memset (str, ' ', *plen);
+  *plen = 0;
+}
+
+#endif
+
+
diff --git a/field_basic_module.F90 b/field_basic_module.F90
@@ -44,6 +44,7 @@ MODULE FIELD_BASIC_MODULE
   PROCEDURE (FIELD_BASIC_SYNC),   DEFERRED :: SYNC_DEVICE_RDONLY
   PROCEDURE (FIELD_BASIC_DELETE_DEVICE_DATA), DEFERRED :: DELETE_DEVICE_DATA
   PROCEDURE (FIELD_BASIC_CREATE_DEVICE_DATA), DEFERRED :: CREATE_DEVICE_DATA
+  PROCEDURE (FIELD_BASIC_CRC64),  DEFERRED :: CRC64
   PROCEDURE :: SET_CHILDREN_DEVPTR => FIELD_BASIC_SET_CHILDREN_DEVPTR
   PROCEDURE :: SET_DEVICE_DIRTY => FIELD_BASIC_SET_DEVICE_DIRTY
   PROCEDURE :: SET_STATUS => FIELD_BASIC_SET_STATUS
@@ -66,6 +67,10 @@ SUBROUTINE FIELD_BASIC_CREATE_DEVICE_DATA (SELF)
     IMPORT FIELD_BASIC
     CLASS(FIELD_BASIC) :: SELF
   END SUBROUTINE
+  INTEGER*8 FUNCTION FIELD_BASIC_CRC64 (SELF)
+    IMPORT FIELD_BASIC
+    CLASS(FIELD_BASIC) :: SELF
+  END FUNCTION
 END INTERFACE
 
 PUBLIC :: FIELD_BASIC_SYNC

diff --git a/field_defaults_module.F90 b/field_defaults_module.F90
@@ -6,7 +6,19 @@ MODULE FIELD_DEFAULTS_MODULE
   REAL(KIND=JPRD) :: INIT_DEBUG_VALUE_JPRD = 0.0_JPRD
   INTEGER(KIND=JPIM) :: INIT_DEBUG_VALUE_JPIM = 0_JPIM
   LOGICAL(KIND=JPLM) :: INIT_DEBUG_VALUE_JPLM = .FALSE.
+  LOGICAL :: GET_DEBUG_PRINT_CRC = .FALSE.
+  LOGICAL :: GET_DEBUG_PRINT_LOCATION = .FALSE.
   LOGICAL :: INIT_PINNED_VALUE = .FALSE.
   LOGICAL :: INIT_SYNC_ON_FINAL = .TRUE.
   LOGICAL :: INIT_MAP_DEVPTR = .TRUE.
+  INTEGER :: GET_DEBUG_PRINT_LOCATION_DEPTH = 3
+
+  NAMELIST / NAMFIELD_API / &
+   & USE_INIT_DEBUG_VALUE,  INIT_DEBUG_VALUE_JPRM,        &
+   & INIT_DEBUG_VALUE_JPRB, INIT_DEBUG_VALUE_JPRD,        &
+   & INIT_DEBUG_VALUE_JPIM, INIT_DEBUG_VALUE_JPLM,        &
+   & GET_DEBUG_PRINT_CRC,   GET_DEBUG_PRINT_LOCATION,     &
+   & INIT_PINNED_VALUE,     INIT_SYNC_ON_FINAL,           &
+   & INIT_MAP_DEVPTR,       GET_DEBUG_PRINT_LOCATION_DEPTH
+
 END MODULE FIELD_DEFAULTS_MODULE
diff --git a/tests/test_crc64.F90 b/tests/test_crc64.F90
@@ -24,9 +24,8 @@ PROGRAM TEST_CRC64
         REAL(KIND=JPRB), POINTER :: VIEW(:) => NULL()
 
         INTEGER*8 :: ICRC64_PI, ICRC64_E, ICRC
-        DATA ICRC64_PI / Z'33E2D12C420E6E86' /
-        DATA ICRC64_E  / Z'817AF6E200A0FC70' /
-
+        DATA ICRC64_PI / Z'158D5E22445EA9D8' /
+        DATA ICRC64_E  / Z'3A21FCC09C73ADA1' /
 
         ALLOCATE(D(NPROMA, NBLOCKS))
 

diff --git a/tests/test_gang.F90 b/tests/test_gang.F90
@@ -10,6 +10,7 @@
 PROGRAM TEST_GANG
 
 USE FIELD_MODULE
+USE FIELD_DEFAULTS_MODULE
 USE FIELD_FACTORY_MODULE
 USE FIELD_ACCESS_MODULE
 USE FIELD_ABORT_MODULE
@@ -29,12 +30,17 @@ PROGRAM TEST_GANG
 INTEGER (KIND=JPIM) :: JDIM
 INTEGER (KIND=JPIM) :: ISTEP
 LOGICAL, PARAMETER :: LLVERBOSE = .TRUE.
+CHARACTER*8 :: CLENV
 
 INTEGER :: IERROR = 0
 
 REAL (KIND=JPRD) :: ZCOEF (NDIM)
 !$acc declare create (ZCOEF)
 
+
+CALL GETENV ('GET_DEBUG_PRINT_CRC',      CLENV); GET_DEBUG_PRINT_CRC      = CLENV /= '0' .AND. CLENV /= ''
+CALL GETENV ('GET_DEBUG_PRINT_LOCATION', CLENV); GET_DEBUG_PRINT_LOCATION = CLENV /= '0' .AND. CLENV /= ''
+
 ALLOCATE (ZDATA4 (ILB (1):IUB (1), ILB (2):IUB (2), ILB (3):IUB (3), ILB (4):IUB (4)))
 
 DO JDIM = 1, NDIM