-- package spec
-- CRC32 Algorithm (spec)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome
with Interfaces;
package crc32 is
-- mod 2**16
subtype crc is Interfaces.Unsigned_32;
-- This function return the CRC32 of a given file.
-- It may throw all the exceptions declared at the end of the package.
function Get_File_Crc32 ( file : String ) return crc;
FILE_OPEN_ERROR,
FILE_READ_ERROR,
FILE_CLOSE_ERROR : exception;
end crc32;
-- package body
-- CRC32 Algorithm (body)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome
with Interfaces; use Interfaces;
with Interfaces.C; use Interfaces.C;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.Address_To_Access_Conversions;
use System;
package body crc32 is
-- Take a buffer of 32k for reading operations
Buffer_Size : constant := 32 * 1024;
-- Internal type to specify what we read read from the file/URL.
type byte is mod 255;
for byte'size use 8;
-- Internal CRC Table.
-- We use crc type for indexes and values to make Logical operations
easier.
CRC32Table : array(crc range 0 .. 255) of crc :=
(0,16#77073096#,16#EE0E612C#,16#990951BA#,
16#76DC419#,16#706AF48F#,16#E963A535#,16#9E6495A3#,
16#EDB8832#,16#79DCB8A4#,16#E0D5E91E#,16#97D2D988#,
16#9B64C2B#,16#7EB17CBD#,16#E7B82D07#,16#90BF1D91#,
16#1DB71064#,16#6AB020F2#,16#F3B97148#,16#84BE41DE#,
16#1ADAD47D#,16#6DDDE4EB#,16#F4D4B551#,16#83D385C7#,
16#136C9856#,16#646BA8C0#,16#FD62F97A#,16#8A65C9EC#,
16#14015C4F#,16#63066CD9#,16#FA0F3D63#,16#8D080DF5#,
16#3B6E20C8#,16#4C69105E#,16#D56041E4#,16#A2677172#,
16#3C03E4D1#,16#4B04D447#,16#D20D85FD#,16#A50AB56B#,
16#35B5A8FA#,16#42B2986C#,16#DBBBC9D6#,16#ACBCF940#,
16#32D86CE3#,16#45DF5C75#,16#DCD60DCF#,16#ABD13D59#,
16#26D930AC#,16#51DE003A#,16#C8D75180#,16#BFD06116#,
16#21B4F4B5#,16#56B3C423#,16#CFBA9599#,16#B8BDA50F#,
16#2802B89E#,16#5F058808#,16#C60CD9B2#,16#B10BE924#,
16#2F6F7C87#,16#58684C11#,16#C1611DAB#,16#B6662D3D#,
16#76DC4190#,16#1DB7106#,16#98D220BC#,16#EFD5102A#,
16#71B18589#,16#6B6B51F#,16#9FBFE4A5#,16#E8B8D433#,
16#7807C9A2#,16#F00F934#,16#9609A88E#,16#E10E9818#,
16#7F6A0DBB#,16#86D3D2D#,16#91646C97#,16#E6635C01#,
16#6B6B51F4#,16#1C6C6162#,16#856530D8#,16#F262004E#,
16#6C0695ED#,16#1B01A57B#,16#8208F4C1#,16#F50FC457#,
16#65B0D9C6#,16#12B7E950#,16#8BBEB8EA#,16#FCB9887C#,
16#62DD1DDF#,16#15DA2D49#,16#8CD37CF3#,16#FBD44C65#,
16#4DB26158#,16#3AB551CE#,16#A3BC0074#,16#D4BB30E2#,
16#4ADFA541#,16#3DD895D7#,16#A4D1C46D#,16#D3D6F4FB#,
16#4369E96A#,16#346ED9FC#,16#AD678846#,16#DA60B8D0#,
16#44042D73#,16#33031DE5#,16#AA0A4C5F#,16#DD0D7CC9#,
16#5005713C#,16#270241AA#,16#BE0B1010#,16#C90C2086#,
16#5768B525#,16#206F85B3#,16#B966D409#,16#CE61E49F#,
16#5EDEF90E#,16#29D9C998#,16#B0D09822#,16#C7D7A8B4#,
16#59B33D17#,16#2EB40D81#,16#B7BD5C3B#,16#C0BA6CAD#,
16#EDB88320#,16#9ABFB3B6#,16#3B6E20C#,16#74B1D29A#,
16#EAD54739#,16#9DD277AF#,16#4DB2615#,16#73DC1683#,
16#E3630B12#,16#94643B84#,16#D6D6A3E#,16#7A6A5AA8#,
16#E40ECF0B#,16#9309FF9D#,16#A00AE27#,16#7D079EB1#,
16#F00F9344#,16#8708A3D2#,16#1E01F268#,16#6906C2FE#,
16#F762575D#,16#806567CB#,16#196C3671#,16#6E6B06E7#,
16#FED41B76#,16#89D32BE0#,16#10DA7A5A#,16#67DD4ACC#,
16#F9B9DF6F#,16#8EBEEFF9#,16#17B7BE43#,16#60B08ED5#,
16#D6D6A3E8#,16#A1D1937E#,16#38D8C2C4#,16#4FDFF252#,
16#D1BB67F1#,16#A6BC5767#,16#3FB506DD#,16#48B2364B#,
16#D80D2BDA#,16#AF0A1B4C#,16#36034AF6#,16#41047A60#,
16#DF60EFC3#,16#A867DF55#,16#316E8EEF#,16#4669BE79#,
16#CB61B38C#,16#BC66831A#,16#256FD2A0#,16#5268E236#,
16#CC0C7795#,16#BB0B4703#,16#220216B9#,16#5505262F#,
16#C5BA3BBE#,16#B2BD0B28#,16#2BB45A92#,16#5CB36A04#,
16#C2D7FFA7#,16#B5D0CF31#,16#2CD99E8B#,16#5BDEAE1D#,
16#9B64C2B0#,16#EC63F226#,16#756AA39C#,16#26D930A#,
16#9C0906A9#,16#EB0E363F#,16#72076785#,16#5005713#,
16#95BF4A82#,16#E2B87A14#,16#7BB12BAE#,16#CB61B38#,
16#92D28E9B#,16#E5D5BE0D#,16#7CDCEFB7#,16#BDBDF21#,
16#86D3D2D4#,16#F1D4E242#,16#68DDB3F8#,16#1FDA836E#,
16#81BE16CD#,16#F6B9265B#,16#6FB077E1#,16#18B74777#,
16#88085AE6#,16#FF0F6A70#,16#66063BCA#,16#11010B5C#,
16#8F659EFF#,16#F862AE69#,16#616BFFD3#,16#166CCF45#,
16#A00AE278#,16#D70DD2EE#,16#4E048354#,16#3903B3C2#,
16#A7672661#,16#D06016F7#,16#4969474D#,16#3E6E77DB#,
16#AED16A4A#,16#D9D65ADC#,16#40DF0B66#,16#37D83BF0#,
16#A9BCAE53#,16#DEBB9EC5#,16#47B2CF7F#,16#30B5FFE9#,
16#BDBDF21C#,16#CABAC28A#,16#53B39330#,16#24B4A3A6#,
16#BAD03605#,16#CDD70693#,16#54DE5729#,16#23D967BF#,
16#B3667A2E#,16#C4614AB8#,16#5D681B02#,16#2A6F2B94#,
16#B40BBE37#,16#C30C8EA1#,16#5A05DF1B#,16#2D02EF8D#);
function Update_Crc ( value : crc ; item : Byte ) return crc is
begin
return Shift_Right(value, 8) xor Crc32Table((value xor
Byte'pos(item)) and 16#FF#);
end Update_Crc;
function Get_File_Crc32 ( file : String ) return crc is
-- Parameters passed to the fopen function
file_c : aliased char_array := To_C(file);
mode : aliased char_array := To_C("rb");
-- Final result to be returned
Result : crc := Not 0;
-- Useful for passing filename and opening mode to the fopen function
package C_To_A is new
System.Address_To_Access_Conversions(char_array);
use C_To_A;
fd_file : C_Streams.Files;
type T_Buffer is array(Interfaces.C_Streams.size_t range 0 ..
Buffer_Size - 1) of aliased Byte;
for T_Buffer'Component_Size use 8;
buffer : aliased T_Buffer;-- := (others => 0); -- slow down the
code, enable it only for debugging purpose
-- Useful for passing our buffer to the fread function
package C_To_A2 is new
System.Address_To_Access_Conversions(t_buffer);
use C_To_A2;
-- Bytes read from the file
To_Process : Interfaces.C_Streams.size_t := 0;
begin
fd_file := fopen(To_Address(file_c'access), To_Address(mode'access));
if fd_file = System.Null_Address
then
raise FILE_OPEN_ERROR;
end if;
while feof(fd_file) /= EOF
loop
To_Process := fread(To_Address(buffer'access), 1, Buffer_Size,
fd_file);
if To_Process < 0
then
raise FILE_READ_ERROR;
end if;
exit when To_Process = 0;
for i in 0 .. To_Process - 1
loop
result := Update_CRC(result, buffer(i));
end loop;
end loop;
if fclose(fd_file) /= 0
then
raise FILE_CLOSE_ERROR;
end if;
return Not result;
end Get_File_Crc32;
end crc32;
-- example program
-- CRC32 Algorithm (example test)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome
with Ada.Command_Line; use Ada.Command_Line;
with crc32; use crc32;
with text_IO; use text_IO;
procedure example is
package crc_io is new modular_io(crc);
use crc_io;
begin
if Argument_Count = 0
then
put("Syntax : " & Command_Name & " file_to_check.");
new_line;
else
put(Get_File_CRC32(Argument(1)), Base => 16);
new_line;
end if;
end;
|
