raw
vtools_vpatch           1 with Bits; use Bits;
vdiff_keccak 2 package body Keccak_C is
vdiff_keccak 3 -- C interface
vdiff_keccak 4
vdiff_keccak 5 procedure C_Get_Size(Size: out Interfaces.C.size_t) is
vdiff_keccak 6 begin
vdiff_keccak 7 Size := C_Context'Size / 8;
vdiff_keccak 8 end C_Get_Size;
vdiff_keccak 9
vdiff_keccak 10 function C_Begin return C_Context_Access is
vdiff_keccak 11 Result : C_Context_Access;
vdiff_keccak 12 begin
vdiff_keccak 13 Result := new C_Context;
vdiff_keccak 14 KeccakBegin(Result.all);
vdiff_keccak 15 return Result;
vdiff_keccak 16 end C_Begin;
vdiff_keccak 17
vdiff_keccak 18 procedure C_Hash(Ctx: in C_Context_Access;
vtools_fixes_bitr... 19 Input: Char_Star;
vtools_fixes_bitr... 20 Len: Interfaces.C.size_t) is
vdiff_blockwise_r... 21 Buffer_Size: constant Natural := 2048;
vdiff_blockwise_r... 22 Byte_Size: constant Natural := 8;
vdiff_blockwise_r... 23 N: Natural := 0;
vdiff_blockwise_r... 24 I: Natural := 0;
vdiff_keccak 25 L: Natural := Natural(Len);
vdiff_blockwise_r... 26 Buf: String(1..Buffer_Size);
vdiff_blockwise_r... 27 B: Bitstream(1..Buf'Length*Byte_Size);
vtools_fixes_bitr... 28 Ptr: Char_Star := Input;
vdiff_keccak 29 begin
vtools_fixes_bitr... 30 if Input = null then
vtools_vpatch 31 raise Strings.Dereference_Error;
vtools_fixes_bitr... 32 end if;
vdiff_blockwise_r... 33 while L > I loop
vdiff_blockwise_r... 34 N := 0;
vdiff_blockwise_r... 35 for Chr of Buf loop
vdiff_blockwise_r... 36 exit when L <= I;
vdiff_blockwise_r... 37 Chr := Character(Ptr.all);
vdiff_blockwise_r... 38 Char_Ptrs.Increment(Ptr);
vdiff_blockwise_r... 39 N := N + 1;
vdiff_blockwise_r... 40 I := I + 1;
vdiff_blockwise_r... 41 end loop;
vdiff_blockwise_r... 42 ToBitstream(Buf(1..N), B(1..N*Byte_Size));
vdiff_blockwise_r... 43 KeccakHash(Ctx.all, B(1..N*Byte_Size));
vtools_fixes_bitr... 44 end loop;
vdiff_keccak 45 end C_Hash;
vdiff_keccak 46
vdiff_keccak 47 procedure C_End(Ctx: C_Context_Access;
vtools_fixes_bitr... 48 Output: Char_Star;
vdiff_keccak 49 Len: Interfaces.C.Size_T) is
vdiff_keccak 50 L: Natural := Natural(Len);
vdiff_keccak 51 S: String(1..L);
vdiff_keccak 52 B: Bitstream(1..S'Length*8);
vtools_fixes_bitr... 53 Ptr: Char_Star := Output;
vdiff_keccak 54 begin
vtools_fixes_bitr... 55 if Output = null then
vtools_vpatch 56 raise Strings.Dereference_Error;
vtools_fixes_bitr... 57 end if;
vdiff_keccak 58 KeccakEnd(Ctx.all, B);
vdiff_keccak 59 ToString(B, S);
vtools_fixes_bitr... 60 for Chr of S loop
vtools_fixes_bitr... 61 Ptr.all := Interfaces.C.char(Chr);
vtools_fixes_bitr... 62 Char_Ptrs.Increment(Ptr);
vtools_fixes_bitr... 63 end loop;
vdiff_keccak 64 -- Len = Count
vdiff_keccak 65 end C_End;
vdiff_keccak 66
vdiff_keccak 67 procedure C_Context_Deallocate is new Ada.Unchecked_Deallocation
vdiff_keccak 68 (C_Context, C_Context_Access);
vdiff_keccak 69
vdiff_keccak 70 procedure C_Deallocate(Ctx: in out C_Context_Access) is
vdiff_keccak 71 begin
vdiff_keccak 72 C_Context_Deallocate(Ctx);
vdiff_keccak 73 end C_Deallocate;
vdiff_keccak 74 end Keccak_C;