File size: 7,639 Bytes
52edc5a | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | with Core_Types; use Core_Types;
with Memory_Structures;
with Errors;
with Integrity;
package body Serialization is
function Put_Word16 (Buf : in out Memory_Structures.Buffer; V : Word16) return Status_Code is
St : Status_Code;
begin
St := Memory_Structures.Append_Byte (Buf, Byte (V mod 256));
if St /= Success then return St; end if;
return Memory_Structures.Append_Byte (Buf, Byte ((V / 256) mod 256));
end Put_Word16;
function Put_Word32 (Buf : in out Memory_Structures.Buffer; V : Word32) return Status_Code is
St : Status_Code; T : Word32 := V;
begin
for I in 1 .. 4 loop
St := Memory_Structures.Append_Byte (Buf, Byte (T mod 256));
if St /= Success then return St; end if;
T := T / 256;
end loop;
return Success;
end Put_Word32;
function Get_Word16 (Buf : Memory_Structures.Buffer; Offset : Index_Type; V : out Word16) return Status_Code is
B0, B1 : Byte; St : Status_Code;
begin
St := Memory_Structures.Get_Byte (Buf, Offset, B0);
if St /= Success then return St; end if;
St := Memory_Structures.Get_Byte (Buf, Offset + 1, B1);
if St /= Success then return St; end if;
V := Word16 (B0) + Word16 (B1) * 256;
return Success;
end Get_Word16;
function Get_Word32 (Buf : Memory_Structures.Buffer; Offset : Index_Type; V : out Word32) return Status_Code is
B : Byte; St : Status_Code; Acc : Word32 := 0; Mult : Word32 := 1;
begin
for I in 0 .. 3 loop
St := Memory_Structures.Get_Byte (Buf, Offset + Index_Type (I), B);
if St /= Success then return St; end if;
Acc := Acc + Word32 (B) * Mult;
Mult := Mult * 256;
end loop;
V := Acc;
return Success;
end Get_Word32;
function Serialize_Header (Hdr : Serial_Header; Buf : in out Memory_Structures.Buffer) return Status_Code is
St : Status_Code; Local : Serial_Header := Hdr;
begin
Memory_Structures.Clear_Buffer (Buf);
Local.Checksum := Integrity.Compute_Header_Checksum (Local);
St := Put_Word16 (Buf, Local.Magic);
if St /= Success then return St; end if;
St := Memory_Structures.Append_Byte (Buf, Local.Version);
if St /= Success then return St; end if;
St := Memory_Structures.Append_Byte (Buf, Byte (Local.Length));
if St /= Success then return St; end if;
St := Put_Word16 (Buf, Local.Checksum);
if St /= Success then return St; end if;
return Memory_Structures.Append_Byte (Buf, Byte (App_State'Pos (Local.State)));
end Serialize_Header;
function Deserialize_Header (Buf : Memory_Structures.Buffer; Hdr : out Serial_Header) return Status_Code is
St : Status_Code; B : Byte; Pos : Index_Type := 0;
begin
Hdr := (Magic => 0, Version => 0, Length => 0, Checksum => 0, State => Idle);
if Memory_Structures.Buffer_Length (Buf) < 7 then return Parse_Error; end if;
St := Get_Word16 (Buf, Pos, Hdr.Magic); if St /= Success then return St; end if;
Pos := Pos + 2;
St := Memory_Structures.Get_Byte (Buf, Pos, B); if St /= Success then return St; end if;
Hdr.Version := B; Pos := Pos + 1;
St := Memory_Structures.Get_Byte (Buf, Pos, B); if St /= Success then return St; end if;
Hdr.Length := Length_Type (B); Pos := Pos + 1;
St := Get_Word16 (Buf, Pos, Hdr.Checksum); if St /= Success then return St; end if;
Pos := Pos + 2;
St := Memory_Structures.Get_Byte (Buf, Pos, B); if St /= Success then return St; end if;
if Integer (B) > App_State'Pos (App_State'Last) then return Parse_Error; end if;
Hdr.State := App_State'Val (Integer (B));
return Integrity.Verify_Header (Hdr);
end Deserialize_Header;
function Serialize_Item (Item : Data_Item; Buf : in out Memory_Structures.Buffer) return Status_Code is
St : Status_Code;
begin
St := Put_Word16 (Buf, Item.Id); if St /= Success then return St; end if;
St := Put_Word32 (Buf, Item.Value); if St /= Success then return St; end if;
St := Memory_Structures.Append_Byte (Buf, Item.Flags); if St /= Success then return St; end if;
St := Put_Word16 (Buf, Item.Checksum); if St /= Success then return St; end if;
if Item.Valid then return Memory_Structures.Append_Byte (Buf, 1); else return Memory_Structures.Append_Byte (Buf, 0); end if;
end Serialize_Item;
function Deserialize_Item (Buf : Memory_Structures.Buffer; Offset : Index_Type; Item : out Data_Item; Next : out Index_Type) return Status_Code is
St : Status_Code; B : Byte; Pos : Index_Type := Offset;
begin
Item := (Id => 0, Value => 0, Flags => 0, Checksum => 0, Valid => False);
Next := Offset;
St := Get_Word16 (Buf, Pos, Item.Id); if St /= Success then return St; end if; Pos := Pos + 2;
St := Get_Word32 (Buf, Pos, Item.Value); if St /= Success then return St; end if; Pos := Pos + 4;
St := Memory_Structures.Get_Byte (Buf, Pos, Item.Flags); if St /= Success then return St; end if; Pos := Pos + 1;
St := Get_Word16 (Buf, Pos, Item.Checksum); if St /= Success then return St; end if; Pos := Pos + 2;
St := Memory_Structures.Get_Byte (Buf, Pos, B); if St /= Success then return St; end if;
Item.Valid := (B = 1); Next := Pos + 1;
return Success;
end Deserialize_Item;
function Serialize_Store (Store : Memory_Structures.Data_Store; Buf : in out Memory_Structures.Buffer; Log : in out Errors.Error_Log) return Status_Code is
Count : Natural := Memory_Structures.Store_Count (Store);
Item : Data_Item; St : Status_Code; Hdr : Serial_Header;
begin
Memory_Structures.Clear_Buffer (Buf);
Hdr := (Magic => 16#ADA1#, Version => 1, Length => Length_Type (Count), Checksum => 0, State => Processing);
St := Serialize_Header (Hdr, Buf);
if St /= Success then Errors.Set_Error (Log, St, 0, "header"); return St; end if;
for I in 0 .. Count - 1 loop
St := Memory_Structures.Get_Item (Store, I, Item);
if St /= Success then Errors.Set_Error (Log, St, Medium_Natural (I), "get"); return St; end if;
St := Serialize_Item (Item, Buf);
if St /= Success then Errors.Set_Error (Log, St, Medium_Natural (I), "ser"); return St; end if;
end loop;
return Success;
end Serialize_Store;
function Deserialize_Store (Buf : Memory_Structures.Buffer; Store : in out Memory_Structures.Data_Store; Log : in out Errors.Error_Log) return Status_Code is
Hdr : Serial_Header; St : Status_Code; Item : Data_Item; Pos : Index_Type := 7; Next : Index_Type; Count : Natural;
begin
Memory_Structures.Clear_Store (Store);
St := Deserialize_Header (Buf, Hdr);
if St /= Success then Errors.Set_Error (Log, St, 0, "hdr"); return St; end if;
Count := Natural (Hdr.Length);
if Count > Memory_Structures.Store_Capacity (Store) then
Errors.Set_Error (Log, Buffer_Overflow, 0, "many"); return Buffer_Overflow;
end if;
for I in 1 .. Count loop
St := Deserialize_Item (Buf, Pos, Item, Next);
if St /= Success then Errors.Set_Error (Log, St, Medium_Natural (I), "item"); return St; end if;
St := Memory_Structures.Insert_Item (Store, Item);
if St /= Success then Errors.Set_Error (Log, St, Medium_Natural (I), "ins"); return St; end if;
Pos := Next;
end loop;
return Success;
end Deserialize_Store;
function Header_Size return Length_Type is (7);
end Serialization;
|