From de67128de0707059b007cb9c001937b9a983ad70 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 26 May 2024 10:08:53 +0000 Subject: [PATCH 1/6] Print CRC & backtrace in field_RANKSUFF_access_module.fypp --- CMakeLists.txt | 2 +- field_RANKSUFF_access_module.fypp | 36 +++++++++++++++++++++++++++++++ field_RANKSUFF_module.fypp | 26 ++++++++++++++++++++++ field_RANKSUFF_util_module.fypp | 11 ++-------- field_basic_module.F90 | 5 +++++ field_defaults_module.F90 | 2 ++ tests/test_crc64.F90 | 5 ++--- tests/test_gang.F90 | 6 ++++++ 8 files changed, 80 insertions(+), 13 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b36d0c9..8d5c490 100644 --- 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_bt.c) ## check for CUDA include(CheckLanguage) diff --git a/field_RANKSUFF_access_module.fypp b/field_RANKSUFF_access_module.fypp index 1dfa873..0644586 100644 --- a/field_RANKSUFF_access_module.fypp +++ b/field_RANKSUFF_access_module.fypp @@ -55,12 +55,26 @@ 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*40 :: CLNAME + 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 @@ -68,6 +82,28 @@ CONTAINS PTR => DUMMY_${ft.name}$ ENDIF + + IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN + CLNAME = "GET_${what}$_DATA_${mode}$_${ft.name}$" + WRITE (0, '(A40)', ADVANCE='NO') CLNAME + ENDIF + + IF (GET_DEBUG_PRINT_CRC) THEN + WRITE (0, '(" ",Z16.16)', ADVANCE='NO') ICRC + ENDIF + + IF (GET_DEBUG_PRINT_LOCATION) THEN + ILEN = LEN (CLBT) + IP1 = 3 + IP2 = 6 + CALL FIELD_BT (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 index d2d9169..595c54d 100644 --- 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 index 02d8145..e4a9bfe 100644 --- 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_basic_module.F90 b/field_basic_module.F90 index 97de3cf..d8615a6 100644 --- 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 index 292044e..fb3495f 100644 --- a/field_defaults_module.F90 +++ b/field_defaults_module.F90 @@ -6,6 +6,8 @@ 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(KIND=JPLM) :: GET_DEBUG_PRINT_CRC = .FALSE. + LOGICAL(KIND=JPLM) :: GET_DEBUG_PRINT_LOCATION = .FALSE. LOGICAL :: INIT_PINNED_VALUE = .FALSE. LOGICAL :: INIT_SYNC_ON_FINAL = .TRUE. LOGICAL :: INIT_MAP_DEVPTR = .TRUE. diff --git a/tests/test_crc64.F90 b/tests/test_crc64.F90 index 9bbe13e..41c4641 100644 --- 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 index 6de37ed..8dacc20 100644 --- 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 From f4929a3e8953f6d53bfe2d5973fb797ff41a67dc Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 26 May 2024 10:23:08 +0000 Subject: [PATCH 2/6] Add missing field_bt.c --- field_bt.c | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 field_bt.c diff --git a/field_bt.c b/field_bt.c new file mode 100644 index 0000000..76084f3 --- /dev/null +++ b/field_bt.c @@ -0,0 +1,39 @@ +#include + + +#include +#include + +void field_bt_ (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; + +} + + +#ifdef UNDEF + +void field_bt_ (char * str, int * p1, int * p2, int * plen) +{ + memset (str, ' ', *plen); + *plen = 0; +} + +#endif + + From de462e49c186c53b302aee1d8e77a3601f90ddc4 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 26 May 2024 15:47:59 +0000 Subject: [PATCH 3/6] Change order of PRINTs (backtrace) --- CMakeLists.txt | 2 +- field_RANKSUFF_access_module.fypp | 24 ++++++++++++++---------- field_bt.c => field_backtrace.c | 4 ++-- 3 files changed, 17 insertions(+), 13 deletions(-) rename field_bt.c => field_backtrace.c (74%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8d5c490..b7f28fe 100644 --- 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 field_bt.c) +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) diff --git a/field_RANKSUFF_access_module.fypp b/field_RANKSUFF_access_module.fypp index 0644586..9c8064f 100644 --- a/field_RANKSUFF_access_module.fypp +++ b/field_RANKSUFF_access_module.fypp @@ -61,7 +61,7 @@ CONTAINS ${ft.type}$, POINTER :: PTR(${ft.shape}$) INTEGER*8 :: ICRC CHARACTER*1024 :: CLBT - CHARACTER*40 :: CLNAME + CHARACTER*10 :: CLF INTEGER :: ILEN, IP1, IP2 @@ -83,20 +83,24 @@ CONTAINS ENDIF - IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN - CLNAME = "GET_${what}$_DATA_${mode}$_${ft.name}$" - WRITE (0, '(A40)', ADVANCE='NO') CLNAME - ENDIF - IF (GET_DEBUG_PRINT_CRC) THEN - WRITE (0, '(" ",Z16.16)', ADVANCE='NO') ICRC + 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 = 3 - IP2 = 6 - CALL FIELD_BT (CLBT, IP1, IP2, ILEN) + IP1 = 2 + IP2 = 4 + CALL FIELD_BACKTRACE (CLBT, IP1, IP2, ILEN) WRITE (0, '(A)', ADVANCE='NO') CLBT (1:ILEN) ENDIF diff --git a/field_bt.c b/field_backtrace.c similarity index 74% rename from field_bt.c rename to field_backtrace.c index 76084f3..5b8037d 100644 --- a/field_bt.c +++ b/field_backtrace.c @@ -4,7 +4,7 @@ #include #include -void field_bt_ (char * str, int * p1, int * p2, int * plen) +void field_backtrace_ (char * str, int * p1, int * p2, int * plen) { void * addr[*p2]; int size; @@ -28,7 +28,7 @@ void field_bt_ (char * str, int * p1, int * p2, int * plen) #ifdef UNDEF -void field_bt_ (char * str, int * p1, int * p2, int * plen) +void field_backtrace_ (char * str, int * p1, int * p2, int * plen) { memset (str, ' ', *plen); *plen = 0; From a9637a6014de25e546ac9772a93082fea6baef06 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 26 May 2024 19:43:48 +0000 Subject: [PATCH 4/6] Depth setting for backtrace --- field_RANKSUFF_access_module.fypp | 2 +- field_defaults_module.F90 | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/field_RANKSUFF_access_module.fypp b/field_RANKSUFF_access_module.fypp index 9c8064f..e0d6acf 100644 --- a/field_RANKSUFF_access_module.fypp +++ b/field_RANKSUFF_access_module.fypp @@ -99,7 +99,7 @@ CONTAINS IF (GET_DEBUG_PRINT_LOCATION) THEN ILEN = LEN (CLBT) IP1 = 2 - IP2 = 4 + IP2 = 2 + GET_DEBUG_PRINT_LOCATION_DEPTH CALL FIELD_BACKTRACE (CLBT, IP1, IP2, ILEN) WRITE (0, '(A)', ADVANCE='NO') CLBT (1:ILEN) ENDIF diff --git a/field_defaults_module.F90 b/field_defaults_module.F90 index fb3495f..d140df2 100644 --- a/field_defaults_module.F90 +++ b/field_defaults_module.F90 @@ -6,9 +6,10 @@ 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(KIND=JPLM) :: GET_DEBUG_PRINT_CRC = .FALSE. - LOGICAL(KIND=JPLM) :: GET_DEBUG_PRINT_LOCATION = .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 END MODULE FIELD_DEFAULTS_MODULE From 6e6bb1fb95e9d6a4b26286591bce110aab0d4f6f Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Mon, 27 May 2024 07:11:28 +0000 Subject: [PATCH 5/6] Add NAMELIST for FIELD_DEFAULTS_MODULE --- field_defaults_module.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/field_defaults_module.F90 b/field_defaults_module.F90 index d140df2..a1a3480 100644 --- a/field_defaults_module.F90 +++ b/field_defaults_module.F90 @@ -12,4 +12,13 @@ MODULE FIELD_DEFAULTS_MODULE 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 From 72c46adccc9f50eb72d8abee6dcc22357f363f23 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Mon, 27 May 2024 18:07:46 +0000 Subject: [PATCH 6/6] Detect backtrace (execinfo.h) with check_symbol_exists --- CMakeLists.txt | 6 ++++++ field_backtrace.c | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b7f28fe..fabee45 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -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 $ ) + 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_backtrace.c b/field_backtrace.c index 5b8037d..cbd9356 100644 --- a/field_backtrace.c +++ b/field_backtrace.c @@ -1,5 +1,6 @@ #include +#ifdef HAVE_BACKTRACE #include #include @@ -26,7 +27,7 @@ void field_backtrace_ (char * str, int * p1, int * p2, int * plen) } -#ifdef UNDEF +#else void field_backtrace_ (char * str, int * p1, int * p2, int * plen) {