'Idiomatic way to use data buffer with non-uniform byte skips in Ada

I'm trying to read from a byte buffer in Ada, such as a file or via buffer for a network connection. The messages are variable in size with a common header, in C++ it'd look something like this:

enum class MessageType : uint16_t {
    Foo = 0, Bar = 1
};

// Force the layout.
#pragma pack(push,1)

// 4 byte message header
struct MessageHeader {
    uint16_t checksum;
    uint16_t type;
};

// 4 byte header + 4 byte message
struct FooMessage {
    MessageHeader header;
    uint32_t tomatoes;
};

// 4 byte header + 8 byte message
struct BarMessage {
    MessageHeader header;
    uint32_t oranges;
    uint32_t apples;
};
#pragma pack(pop)

// For simplicity, assume the buffer is complete and only holds full messages.
void read(char* buffer, uint32_t bytesLeft) {
    while (bytesLeft > 0) {
        MessageHeader* header = reinterpret_cast<MessageHeader*>(buffer);
        switch (header->type) {
            case FooType: {
                FooMessage* foo = reinterpret_case<FooMessage*>(buffer);
                // process as const FooMessage&
                processFoo(*foo);
            }
            case BarType: {
                BarMessage* bar = reinterpret_cast<BarMessage*>(buffer);
                // process as const BarMessage&
                processBar(*bar);
            }
        }
        const auto size = (header->type == Foo ? sizeof(FooMessage) : sizeof(BarMessage));
        buffer += size;
        bytesLeft -= size;
    }
}

I'm not sure of the idiomatic way of doing it. Note that in some formats, the message type might not be the leading data member in the header, as well. Should you be writing to and reading off an array of Character or something from Interfaces.C.char_array, or an address of memory from System.Address or something else? Or should this be an address to an array elsewhere here, or just an array with "Convention => C" to prevent the leading size from being included?

This is what I have so far in Ada:

type Message_Type is (Foo, Bar) with Size => 16;
for Message_Type use (Foo => 0, Bar => 1);

-- Assume these work correctly and I don't need to do bit layout directly.
type Message_Header is record
    Checksum : Interfaces.Integer_16;
    Msg_Type : Message_Type;
end record
    with Convention => C, Size => 32;

type Foo_Message is record
    Header   : Message_Header;
    Tomatoes : Interfaces.Integer_32;
end record
    with Convention => C, Size => 64;

type Bar_Message is record
    Header  : Message_Header;
    Oranges : Interfaces.Integer_32;
    Apples  : Interfaces.Integer_32;
end record
    with Convention => C, Size => 96;

procedure Read(
    -- System.Address seems really weird here
    Buffer     : in out System.Address;
    Bytes_Left : in out Interfaces.Integer_64)
is
    use type Interfaces.Integer_64;
    use type System.Address;
    function To_Address is new Ada.Unchecked_Conversion (Interfaces.Integer_64, System.Address);
    function To_Integer is new Ada.Unchecked_Conversion (System.Address, Interfaces.Integer_64);

    procedure Process_Bar (B : aliased Bar_Message) is null;
    procedure Process_Foo (F : aliased Foo_Message) is null;
begin
    while Bytes_Left > 0 loop
        declare
            -- I'm really lost here.
            --
            -- Do you use access types to access the buffer or
            -- setting the address with "for Foo'Address use Buffer"??
            --
            Header : Message_Header;
            for Header'Address use Buffer;
    enter code here
            -- I'm assuming this doesn't initialize Foo and Bar here?    
            Foo_Msg : aliased Foo_Message;
            Bar_Msg : aliased Bar_Message;
            for Foo_Msg'Address use Buffer;
            for Bar_Msg'Address use Buffer;
            -- I'm assuming this doesn't initialize Foo and Bar here?    
            Size : System.Address := To_Address(0);
        begin
            case Header.Msg_Type is
                when Foo => Process_Foo (Foo_Msg);
                when Bar => Process_Bar (Bar_Msg);
            end case;
            Size := To_Address (if Header.Msg_Type = Foo then Foo'Size else Bar'Size);

            -- There's probably a better way to do this.
            Buffer := To_Address(To_Integer (Buffer) + To_Integer (Size));
            Bytes_Left := Bytes_Left - To_Integer (Size);
        end;
    end loop;
end Read;

What's the idiomatic way to march in a variable way across bytes in buffers and read the data in place?



Solution 1:[1]

I would keep it simple: just define a buffer array at the given address:

Buf : System.Storage_Elements.Storage_Array (0 .. Bytes_Left - 1)
        with Address => Buffer;

and then parse the buffer, message-by-message. The example below provides a sketch of how I would solve this (disclaimer: did not test it).

message_reader.ads

with System;
with System.Storage_Elements;
with Interfaces;

package Message_Reader is

   package SSE renames System.Storage_Elements;
   
   --  NOTE: Not using an enum type eases the implementation of the parser (I think).
   --        In particular for detecting unknown message types.

   type Message_Type is new Interfaces.Unsigned_16;   
   Message_Type_Foo : constant Message_Type := 0;
   Message_Type_Bar : constant Message_Type := 1;

   -- Assume these work correctly and I don't need to do bit layout directly.
   type Message_Header is record
      Checksum : Interfaces.Integer_16;
      Msg_Type : Message_Type;
   end record
     with Convention => C, Size => 32;

   type Foo_Message is record
      Header   : Message_Header;
      Tomatoes : Interfaces.Integer_32;
   end record
     with Convention => C, Size => 64;

   type Bar_Message is record
      Header  : Message_Header;
      Oranges : Interfaces.Integer_32;
      Apples  : Interfaces.Integer_32;
   end record
     with Convention => C, Size => 96;
   
   Unknown_Message_Type : exception;
   
   procedure Read
     (Buffer     : in     System.Address;
      Bytes_Left : in out SSE.Storage_Count);
   
private
   use type SSE.Storage_Count;

   pragma Compile_Time_Error 
     (System.Storage_Unit /= 8, "implementation expects a storage unit size of 8");
   
   Foo_Msg_Size_Bytes : constant SSE.Storage_Count := 
                          Foo_Message'Size / System.Storage_Unit;
   Bar_Msg_Size_Bytes : constant SSE.Storage_Count := 
                          Bar_Message'Size / System.Storage_Unit;
   
   procedure Process_Bar (B : Bar_Message) is null;
   procedure Process_Foo (F : Foo_Message) is null;
   
end Message_Reader;

message_reader.adb

with Ada.Unchecked_Conversion;

package body Message_Reader is   
   
   generic
      type Chunk_Type is private;      
   procedure Read_Chunk 
     (Buffer  : in     SSE.Storage_Array;
      Offset  : in     SSE.Storage_Offset;
      Chunk   :    out Chunk_Type;
      Success :    out Boolean);
   
   ----------
   -- Read --
   ----------

   procedure Read
     (Buffer     : in     System.Address;
      Bytes_Left : in out SSE.Storage_Count)
   is      
      Buf : SSE.Storage_Array (0 .. Bytes_Left - 1)
        with Address => Buffer;
      
      procedure Read_Header  is new Read_Chunk (Message_Header);
      procedure Read_Foo_Msg is new Read_Chunk (Foo_Message);
      procedure Read_Bar_Msg is new Read_Chunk (Bar_Message);
      
      Header  : Message_Header;
      Success : Boolean;
      
   begin
      loop
         Read_Header (Buf, Buf'Last - Bytes_Left - 1, Header, Success);         
         if not Success then
            exit;  --  Not enough data left in buffer.
         end if;
         
         case Header.Msg_Type is
                  
            when Message_Type_Foo =>
               declare
                  Foo : Foo_Message;
               begin
                  Read_Foo_Msg (Buf, Buf'Last - Bytes_Left - 1, Foo, Success);
                  if not Success then
                     exit;  --  Not enough data left in buffer.
                  end if;
                  
                  Bytes_Left := Bytes_Left - Foo_Msg_Size_Bytes; 
                  Process_Foo (Foo);
                  
               end;
                     
            when Message_Type_Bar =>
               declare
                  Bar : Bar_Message;
               begin
                  Read_Bar_Msg (Buf, Buf'Last - Bytes_Left - 1, Bar, Success);
                  if not Success then
                     exit;  --  Not enough data left in buffer.
                  end if;                  
                  
                  Bytes_Left := Bytes_Left - Bar_Msg_Size_Bytes;   
                  Process_Bar (Bar);
                  
               end;
                     
            when others =>
               raise Unknown_Message_Type;
                     
         end case;
      end loop;      
      
   end Read;
      
   ----------------
   -- Read_Chunk --
   ----------------

   procedure Read_Chunk 
     (Buffer  : in     SSE.Storage_Array;
      Offset  : in     SSE.Storage_Offset;
      Chunk   :    out Chunk_Type;
      Success :    out Boolean)
   is
      Chunk_Type_Bytes : constant SSE.Storage_Count := 
                            Chunk_Type'Size / System.Storage_Unit;
      
      subtype Chunk_Raw is SSE.Storage_Array (0 .. Chunk_Type_Bytes - 1);  
      
      function To_Chunk is new Ada.Unchecked_Conversion 
        (Source => Chunk_Raw, Target => Chunk_Type);
      
      Slice_First : constant SSE.Storage_Offset := Offset;
      Slice_Last  : constant SSE.Storage_Offset := Offset + Chunk_Type_Bytes - 1;
      
   begin      
      if Slice_Last <= Buffer'Last then
         Chunk := To_Chunk (Buffer (Slice_First .. Slice_Last));
         Success := True;
      else
         Success := False;
      end if;
      
   end Read_Chunk;   

end Message_Reader;

Solution 2:[2]

Use can use a record with a Unchecked_Union aspect.

type Message (Msg_Type : Message_Type) is record
    Header : Message_Header;

    case Msg_Type is
        when Foo =>
            Tomatoes : Interfaces.Integer_16;
        when Bar =>
            Oranges : Interfaces.Integer_32;
            Apples  : Interfaces.Integer_32;
    end case;
end record
    with Unchecked_Union;

Please note the discriminant is not accessible when using Unchecked_Union.

Note : Tomatoes has not the same size in the C code and the Ada code you provided.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1
Solution 2 DrPi