Clicky
Showing changes from revision #0 to #1:
(追記) Added (追記ここまで) | (削除) Removed (削除ここまで) | (削除) Chan (削除ここまで)(追記) ged (追記ここまで)
This is an example program that calculates a 32-bit version of the Cyclic Redundancy Check(CRC) for files listed on the command line.
This variant of CRC-32 uses LSB-first order, sets the initial CRC to FFFFFFFF_int32, and complements the final CRC.
The calculated CRC sum is calculated as a 32-bit value but returned as a 64-bit value, as Fortran does not currently support unsigned integers.
The input files are read as a stream of bytes in buffered blocks till the end for speed, especially on platforms that do not provide for read-ahead buffers.
The program was tested using GNU Fortran (GCC) 7.3.0.
hasher *.f90
1530940757 2011 dynamic_dummy_arrays.f90
3570697645 5444 fspiro.f90
3067489097 27108 pprint.f90
0408522764 7273 hacker.f90The CRC-32 algorithm was originally based on an unattributed example on http://rosettacode.org, but has been modified. The result should be in accordance with ISO 3309, ITU-T V.42, Gzip and PNG per this reference.
Algorithms for many CRC algorithms can be found at "Computation of CRC" in Wikipedia.
A description of a CRC is at https://en.wikipedia.org/wiki/Cyclic_redundancy_check
program hasher
!! calculate a CRC for files listed on the command line
use,intrinsic :: iso_fortran_env, only : ERROR_UNIT,iostat_end ! access computing environment
use,intrinsic :: ISO_FORTRAN_ENV, only : int32,int64
implicit none
integer :: i
integer :: ios
integer :: icount
integer(kind=int64) :: hash
integer,parameter :: IUNIT=15 ! input file unit
character(len=4096) :: msg
logical :: cont
integer,parameter :: bufsize=1048576
character(len=1) :: buff(bufsize)
integer :: sz
integer :: filepoint
integer :: count, longest, argument_length
character(len=:),allocatable :: filenames(:)
!! get command arguments
count = command_argument_count() ! get number of filenames
longest=0 ! find longest argument
do i=0,count
call get_command_argument(number=i,length=argument_length)
longest=max(longest,argument_length)
enddo
! allocate string array big enough to hold command line
allocate(character(len=longest) :: filenames(0:count))
do i=0,count ! read the filenames into the array
call get_command_argument(i, filenames(i))
enddo
!! step through files and calculate CRC
do i=1,count
!! open file assuming it is a regular file
open(unit=IUNIT,file=filenames(i),status='old',access='stream',iostat=ios,iomsg=msg,action='read')
if(ios.ne.0)then
write(ERROR_UNIT,'(*(a))')'*hasher* error: file ',trim(filenames(i)),' message=',trim(msg)
close(unit=IUNIT,iostat=ios)
stop
endif
cont=.false. ! set flag this is initial call to calculate hash
icount=0 ! count number of characters processed
sz=bufsize ! set read buffer size to initial size for new file
filepoint=1 ! position to start next read in file
hash=0_int64 ! initial hash value
!! read blocks of the file, calculate continued CRC till end of file or error
INFINITE: do ! read and sum file string by string
read(iunit,iostat=ios,pos=filepoint,iomsg=msg) buff(1:sz) ! read data in large chunks till the last chunk
if(is_iostat_end(ios))then ! this is the last buffer
if(sz.ne.1)then ! try again with a smaller buffer
sz=max(1,sz/2)
cycle INFINITE
endif
elseif(ios == 0)then ! no error occurred so successfully read a buffer
filepoint=filepoint+sz
endif
if(ios /= 0)then ! quit reading on error
exit INFINITE
endif
hash=crc32_hash(buff(:sz),continue=cont) ! build up hash
icount=icount+sz
if(cont.eqv..false.)cont=.true. ! change flag to continue hash build after first call to accumulate
enddo INFINITE
!! output values for current file
if(icount.eq.0) then
write(ERROR_UNIT,'(*(a))')'*hasher* error: file ',trim(filenames(i)),' is empty or not a readable regular file:',trim(msg)
else
write(*,'(i0.10,1x,i15,1x,a)')hash,icount,trim(filenames(i))
endif
close(unit=IUNIT,iostat=ios)
enddo
contains
function crc32_hash(a,continue) result (crc_64)
use,intrinsic :: ISO_FORTRAN_ENV, only : int32,int64
implicit none
logical,intent(in),optional :: continue
character(len=1),intent(in) :: a(:)
integer(int64) :: crc_64
integer(int32),save :: crc
integer :: i
integer(int32),save :: crc_table(0:255)
integer,save :: icalled=0
if(present(continue))then
if(continue .eqv. .false.)then
crc=0_int32
endif
else
crc=0_int32
endif
if(icalled.eq.0)then ! on first call generate table and use table for speed
INIT_TABLE: block
integer :: i, j
integer(int32) :: k
do i = 0, 255
k = i
do j = 1, 8
if (btest(k, 0)) then
k = ieor(shiftr(k, 1), -306674912_int32)
else
k = shiftr(k, 1)
endif
enddo
crc_table(i) = k
enddo
endblock INIT_TABLE
icalled=1
endif
crc = not(crc)
do i = 1, size(a)
crc = ieor(shiftr(crc, 8), crc_table(iand(ieor(crc, iachar(a(i))), 255)))
enddo
crc = not(crc)
crc_64=transfer([crc,0_int32],crc_64)
end function crc32_hash
end program hasher