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_keccak 21 L: Natural := Natural(Len);
vdiff_keccak 22 S: String(1..L);
vdiff_keccak 23 B: Bitstream(1..S'Length*8);
vtools_fixes_bitr... 24 Ptr: Char_Star := Input;
vdiff_keccak 25 begin
vtools_fixes_bitr... 26 if Input = null then
vtools_vpatch 27 raise Strings.Dereference_Error;
vtools_fixes_bitr... 28 end if;
vtools_fixes_bitr... 29 for Chr of S loop
vtools_fixes_bitr... 30 Chr := Character(Ptr.all);
vtools_fixes_bitr... 31 Char_Ptrs.Increment(Ptr);
vtools_fixes_bitr... 32 end loop;
vdiff_keccak 33 ToBitstream(S, B);
vdiff_keccak 34 KeccakHash(Ctx.all, B);
vdiff_keccak 35 end C_Hash;
vdiff_keccak 36
vdiff_keccak 37 procedure C_End(Ctx: C_Context_Access;
vtools_fixes_bitr... 38 Output: Char_Star;
vdiff_keccak 39 Len: Interfaces.C.Size_T) is
vdiff_keccak 40 L: Natural := Natural(Len);
vdiff_keccak 41 S: String(1..L);
vdiff_keccak 42 B: Bitstream(1..S'Length*8);
vtools_fixes_bitr... 43 Ptr: Char_Star := Output;
vdiff_keccak 44 begin
vtools_fixes_bitr... 45 if Output = null then
vtools_vpatch 46 raise Strings.Dereference_Error;
vtools_fixes_bitr... 47 end if;
vdiff_keccak 48 KeccakEnd(Ctx.all, B);
vdiff_keccak 49 ToString(B, S);
vtools_fixes_bitr... 50 for Chr of S loop
vtools_fixes_bitr... 51 Ptr.all := Interfaces.C.char(Chr);
vtools_fixes_bitr... 52 Char_Ptrs.Increment(Ptr);
vtools_fixes_bitr... 53 end loop;
vdiff_keccak 54 -- Len = Count
vdiff_keccak 55 end C_End;
vdiff_keccak 56
vdiff_keccak 57 procedure C_Context_Deallocate is new Ada.Unchecked_Deallocation
vdiff_keccak 58 (C_Context, C_Context_Access);
vdiff_keccak 59
vdiff_keccak 60 procedure C_Deallocate(Ctx: in out C_Context_Access) is
vdiff_keccak 61 begin
vdiff_keccak 62 C_Context_Deallocate(Ctx);
vdiff_keccak 63 end C_Deallocate;
vdiff_keccak 64 end Keccak_C;