a CRC32 algorithm in Ada

-- 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;