diff --git a/CMakeLists.txt b/CMakeLists.txt index 9632ba1..ddf8ada 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -98,3 +98,13 @@ if(ENABLE_LZMA) target_link_libraries(amun.x ${LZMA_LIBRARIES}) endif() endif() + +option(ENABLE_XXHASH "Enable system's XXHASH library" ON) +if(ENABLE_XXHASH) + include(FindPkgConfig) + pkg_search_module(XXHASH QUIET libxxhash) + if(XXHASH_FOUND) + target_compile_definitions(amun.x PRIVATE XXHASH) + target_link_libraries(amun.x ${XXHASH_LIBRARIES}) + endif() +endif() diff --git a/sources/hash.F90 b/sources/hash.F90 index 87a91f3..7bb3bb3 100644 --- a/sources/hash.F90 +++ b/sources/hash.F90 @@ -36,10 +36,33 @@ ! module hash -! module variables are not implicit by default -! implicit none +#ifdef XXHASH +! interfaces to functions XXH64() and XXH3_64bits() provided +! by the systems library libxxhash +! + interface + + integer(c_int64_t) function xxh64_system(input, length, seed) & + bind(C, name="XXH64") + use iso_c_binding, only: c_ptr, c_size_t, c_int64_t + implicit none + type(c_ptr) , value :: input + integer(kind=c_size_t), value :: length + integer(c_int64_t) , value :: seed + end function xxh64_system + + integer(c_int64_t) function xxh3_system(input, length) & + bind(C, name="XXH3_64bits") + use iso_c_binding, only: c_ptr, c_size_t, c_int64_t + implicit none + type(c_ptr) , value :: input + integer(kind=c_size_t), value :: length + end function xxh3_system + + end interface +#else /* XXHASH */ ! hash parameters ! integer(kind=8), parameter :: prime1 = -7046029288634856825_8, & @@ -48,26 +71,76 @@ module hash prime4 = -8796714831421723037_8, & prime5 = 2870177450012600261_8, & prime6 = 6983438078262162902_8 +#endif /* XXHASH */ + + character(len=8), save :: hash_type = 'xxh64' -! by default everything is private -! private - -! declare public subroutines -! - public :: xxh64 + public :: get_hash, hash_type !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! contains ! +! +!=============================================================================== +!! +!!*** PUBLIC SUBROUTINES ***************************************************** +!! +!=============================================================================== +! +!=============================================================================== +! +! function GET_HASH: +! ----------------- +! +! Function calculates the hash for a given sequence of bytes. +! +! Arguments: +! +! input - the input sequence of bytes; +! +!=============================================================================== +! + integer(kind=8) function get_hash(input) result(hash) + +#ifdef XXHASH + use iso_c_binding, only: c_loc +#endif /* XXHASH */ + + implicit none + + integer(kind=1), dimension(:), target, intent(in) :: input + + integer(kind=8) :: length + +!------------------------------------------------------------------------------- +! +#ifdef XXHASH + length = size(input, kind=8) + + select case(trim(hash_type)) + case('xxh3') + hash = xxh3_system(c_loc(input), length) + case default + hash = xxh64_system(c_loc(input), length, hash) + end select +#else /* XXHASH */ + hash = xxh64(input) +#endif /* XXHASH */ + + return + +!------------------------------------------------------------------------------- +! + end function get_hash +! !=============================================================================== !! !!*** PRIVATE SUBROUTINES **************************************************** !! !=============================================================================== ! -! !=============================================================================== ! ! function XXH64: @@ -83,24 +156,29 @@ module hash ! integer(kind=8) function xxh64(input) result(hash) +#ifdef XXHASH + use iso_c_binding, only: c_loc +#endif /* XXHASH */ + implicit none -! subroutine arguments -! - integer(kind=1), dimension(:), intent(in) :: input + integer(kind=1), dimension(:), target, intent(in) :: input -! local variables -! - integer(kind=8) :: length, remaining, offset + integer(kind=8) :: length +#ifndef XXHASH + integer(kind=8) :: remaining, offset -! local arrays -! integer(kind=8), dimension(4) :: lane, chunk +#endif /* ~XXHASH */ !------------------------------------------------------------------------------- ! length = size(input, kind=8) hash = 0_8 +#ifdef XXHASH + hash = xxh64_system(c_loc(input), length, hash) +! hash = xxh3_system(c_loc(input), length) +#else /* XXHASH */ offset = 1_8 remaining = length @@ -168,12 +246,48 @@ module hash end do hash = xxh64_aval(hash) +#endif /* XXHASH */ return !------------------------------------------------------------------------------- ! end function xxh64 +#ifdef XXHASH +! +!=============================================================================== +! +! function XXH3: +! ------------- +! +! Function calculates XXH3 hash for a given sequence of bytes. +! +! Arguments: +! +! input - the input sequence of bytes; +! +!=============================================================================== +! + integer(kind=8) function xxh3(input) result(hash) + + use iso_c_binding, only: c_loc + + implicit none + + integer(kind=1), dimension(:), target, intent(in) :: input + + integer(kind=8) :: length + +!------------------------------------------------------------------------------- +! + length = size(input, kind=8) + hash = xxh3_system(c_loc(input), length) + return + +!------------------------------------------------------------------------------- +! + end function xxh3 +#else /* XXHASH */ ! !=============================================================================== ! @@ -194,8 +308,6 @@ module hash implicit none -! subroutine arguments -! integer(kind=8), intent(in) :: lane, input !------------------------------------------------------------------------------- @@ -227,8 +339,6 @@ module hash implicit none -! subroutine arguments -! integer(kind=8), intent(in) :: hash, lane !------------------------------------------------------------------------------- @@ -258,8 +368,6 @@ module hash implicit none -! subroutine arguments -! integer(kind=8), intent(in) :: hash !------------------------------------------------------------------------------- @@ -292,8 +400,6 @@ module hash implicit none -! subroutine arguments -! integer(kind=8), intent(in) :: byte integer(kind=4), intent(in) :: amount @@ -305,6 +411,7 @@ module hash !------------------------------------------------------------------------------- ! end function xxh64_rotl +#endif /* ~XXHASH */ !=============================================================================== ! diff --git a/sources/io.F90 b/sources/io.F90 index 0c2e2c3..7b405a0 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -178,6 +178,10 @@ module io ! character(len=8) , save :: binary_file_suffix = ".bin" +! the type of digest to use +! + character(len=8) , save :: digest_type = 'xxh64' + #ifdef HDF5 ! compression type ! @@ -241,6 +245,7 @@ module io ! import external procedures ! use compression , only : set_compression, get_compression + use hash , only : hash_type #ifdef HDF5 use hdf5 , only : hsize_t use hdf5 , only : H5P_DATASET_CREATE_F, H5Z_FLAG_OPTIONAL_F @@ -370,6 +375,17 @@ module io binary_file_suffix = ".bin" // trim(adjustl(suffix)) end if +! get hash type +! + call get_parameter("digest_type", digest_type) + select case(digest_type) + case('xxh3', 'XXH3') + hash_type = 'xxh3' + case default + hash_type = 'xxh64' + end select + digest_type = hash_type + ! check the snapshot type ! select case(ftype) @@ -1212,7 +1228,7 @@ module io use evolution , only : step, time, dt, dth, dte use evolution , only : niterations, nrejections, errs use forcing , only : nmodes, fcoefs, einj - use hash , only : xxh64 + use hash , only : get_hash, hash_type use iso_fortran_env, only : error_unit #ifdef MPI use mesh , only : redistribute_blocks @@ -1487,7 +1503,7 @@ module io read(lun) fields close(lun) read(hfield, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(fields, 1_1, bytes))) then + if (digest /= get_hash(transfer(fields, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1498,7 +1514,7 @@ module io read(lun) children close(lun) read(hchild, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(children, 1_1, bytes))) then + if (digest /= get_hash(transfer(children, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1510,7 +1526,7 @@ module io read(lun) faces close(lun) read(hface, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(faces, 1_1, bytes))) then + if (digest /= get_hash(transfer(faces, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1522,7 +1538,7 @@ module io read(lun) edges close(lun) read(hedge, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(edges, 1_1, bytes))) then + if (digest /= get_hash(transfer(edges, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1533,7 +1549,7 @@ module io read(lun) corners close(lun) read(hcorner, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(corners, 1_1, bytes))) then + if (digest /= get_hash(transfer(corners, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1544,7 +1560,7 @@ module io read(lun) bounds close(lun) read(hbound, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(bounds, 1_1, bytes))) then + if (digest /= get_hash(transfer(bounds, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1647,7 +1663,7 @@ module io read(lun) fcoefs close(lun) read(hforce, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(fcoefs, 1_1, bytes))) then + if (digest /= get_hash(transfer(fcoefs, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1755,7 +1771,7 @@ module io read(lun) ids close(lun) read(hids, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(ids, 1_1, bytes))) then + if (digest /= get_hash(transfer(ids, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1772,7 +1788,7 @@ module io access = 'stream') read(lun) array close(lun) - if (hprim(l) /= xxh64(transfer(array, 1_1, bytes))) then + if (hprim(l) /= get_hash(transfer(array, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc), & "'" // trim(fname) // & "' seems to be corrupted!" @@ -1798,7 +1814,7 @@ module io access = 'stream') read(lun) array close(lun) - if (hcons(l) /= xxh64(transfer(array, 1_1, bytes))) then + if (hcons(l) /= get_hash(transfer(array, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc), & "'" // trim(fname) // & "' seems to be corrupted!" @@ -1843,7 +1859,7 @@ module io read(lun) ids close(lun) read(hids, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(ids, 1_1, bytes))) then + if (digest /= get_hash(transfer(ids, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1854,7 +1870,7 @@ module io read(lun) arrays close(lun) read(harray, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(arrays, 1_1, bytes))) then + if (digest /= get_hash(transfer(arrays, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1906,7 +1922,7 @@ module io read(lun) seeds close(lun) read(hseed, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(seeds, 1_1, bytes))) then + if (digest /= get_hash(transfer(seeds, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -1966,7 +1982,7 @@ module io read(lun) seeds close(lun) read(hseed, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(seeds, 1_1, bytes))) then + if (digest /= get_hash(transfer(seeds, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -2084,7 +2100,7 @@ module io read(lun) ids close(lun) read(hids, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(ids, 1_1, bytes))) then + if (digest /= get_hash(transfer(ids, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -2095,7 +2111,7 @@ module io read(lun) arrays close(lun) read(harray, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(arrays, 1_1, bytes))) then + if (digest /= get_hash(transfer(arrays, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -2147,7 +2163,7 @@ module io read(lun) seeds close(lun) read(hseed, fmt = "(1z16)") digest - if (digest /= xxh64(transfer(seeds, 1_1, bytes))) then + if (digest /= get_hash(transfer(seeds, 1_1, bytes))) then write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if @@ -3151,7 +3167,7 @@ module io string = '