CMAKE, HASH, IO: Detect and use the system libxxhash.

If it is available, allow to choose between XXH64 (default) and XXH3
hash algorithms provided by the library XXHASH.

If it is not available, the internal slower implementation is used.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-18 23:15:51 -03:00
parent 17d4567d13
commit a10d7d5499
3 changed files with 180 additions and 47 deletions

View File

@ -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()

View File

@ -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 */
!===============================================================================
!

View File

@ -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 = '<Attribute type="string" name="' // trim(adjustl(aname)) // '"'
write(bytes_string,"(1i32)") data_bytes
string = trim(string) // ' size="' // trim(adjustl(bytes_string)) // '"'
string = trim(string) // ' digest_type="xxh64"'
string = trim(string) // ' digest_type="' // trim(digest_type) // '"'
write(digest_string,"(1z0.16)") data_digest
string = trim(string) // ' digest="' // trim(adjustl(digest_string)) // '"'
if (present(compressed_bytes)) then
@ -3202,7 +3218,7 @@ module io
compressed_bytes, compressed_digest)
use compression, only : get_compression, compress
use hash , only : xxh64
use hash , only : get_hash
implicit none
@ -3229,7 +3245,7 @@ module io
status = 0
written = .false.
array_bytes = size(array, kind=8)
if (present(array_digest)) array_digest = xxh64(array)
if (present(array_digest)) array_digest = get_hash(array)
write(fname,"(a,'/',a)") trim(path), trim(name)
! try to compress array and write it
@ -3245,7 +3261,7 @@ module io
close(lun)
written = .true.
if (present(compressed_digest)) &
compressed_digest = xxh64(buffer(1:compressed_bytes))
compressed_digest = get_hash(buffer(1:compressed_bytes))
end if
deallocate(buffer)
end if