polyorb_hi-messages.adb 7.13 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                          PolyORB HI COMPONENTS                           --
--                                                                          --
--                  P O L Y O R B _ H I . M E S S A G E S                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--    Copyright (C) 2006-2009 Telecom ParisTech, 2010-2013 ESA & ISAE.      --
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
--                                                                          --
-- PolyORB HI is free software; you  can  redistribute  it and/or modify it --
-- under terms of the GNU General Public License as published by the Free   --
-- Software Foundation; either version 2, or (at your option) any later.    --
-- PolyORB HI is distributed  in the hope that it will be useful, but       --
-- WITHOUT ANY WARRANTY;  without even the implied warranty of              --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received  a copy of the --
-- GNU General Public  License  distributed with PolyORB HI; see file       --
-- COPYING. If not, write  to the Free  Software Foundation, 51 Franklin    --
-- Street, Fifth Floor, Boston, MA 02111-1301, USA.                         --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
jhugues's avatar
jhugues committed
29 30
--              PolyORB-HI/Ada is maintained by the TASTE project           --
--                      (taste-users@lists.tuxfamily.org)                   --
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
--                                                                          --
------------------------------------------------------------------------------

with Interfaces;
with PolyORB_HI.Utils;
with Ada.Unchecked_Conversion;

package body PolyORB_HI.Messages is

   use PolyORB_HI.Utils;
   use Interfaces;

   --  Message format:
   --  - the first byte is set to the message length,
   --  - the second one is the destination entity (Thread),
   --  - the third one is the sender entity (Thread),
   --  - other bytes are the message payload.

   type Wrapper is new Stream_Element_Count range
     0 .. 2 ** (8 * Message_Length_Size) - 1;
   for Wrapper'Size use Message_Length_Size * 8;

   function Internal_To_Length is new Ada.Unchecked_Conversion
     (Message_Size_Buffer, Wrapper);
   function Internal_To_Buffer is new Ada.Unchecked_Conversion
     (Wrapper, Message_Size_Buffer);

   --  The message header offsets. Must be synchronized with the
   --  header size.

   Receiver_Offset : constant Stream_Element_Offset := Message_Length_Size + 1;
   Sender_Offset   : constant Stream_Element_Offset := Message_Length_Size + 2;

64 65 66
   function Length (M : Message_Type) return PDU_Index;
   --  Return length of message M

67 68 69 70 71 72 73 74 75 76
   -----------------
   -- Encapsulate --
   -----------------

   function Encapsulate
     (Message : Message_Type;
      From    : Entity_Type;
      Entity  : Entity_Type)
     return Stream_Element_Array
   is
77
      L : constant Stream_Element_Count := Message.Last + Header_Size;
78 79 80 81 82
      R : Stream_Element_Array (1 .. L);
   begin
      R (1 .. Message_Length_Size) := To_Buffer (L - 1);
      R (Receiver_Offset) := Stream_Element (Internal_Code (Entity));
      R (Sender_Offset)   := Stream_Element (Internal_Code (From));
83 84
      R (Header_Size +  1 .. Header_Size + Message.Last)
        := Message.Content (Message.First .. Message.Last);
85 86 87 88 89 90 91 92

      return R;
   end Encapsulate;

   ------------
   -- Length --
   ------------

93
   function Length (M : Message_Type) return PDU_Index is
94
   begin
95 96 97 98 99 100 101
      if M.First >= 1
        and then M.Last - M.First >= 0
      then
         return M.Last - M.First + 1;
      else
         return 0; --  XXX defensive
      end if;
102 103 104 105 106 107 108 109
   end Length;

   -------------
   -- Payload --
   -------------

   function Payload (M : Message_Type) return Stream_Element_Array is
   begin
110
      return M.Content (M.First .. M.Last);
111 112 113 114 115 116 117 118 119 120 121 122 123
   end Payload;

   ------------
   -- Sender --
   ------------

   function Sender (M : Message_Type) return Entity_Type is
   begin
      return Sender (M.Content (M.First .. M.Last));
   end Sender;

   function Sender (M : Stream_Element_Array) return Entity_Type is
   begin
124
      return Corresponding_Entity (Unsigned_8 (M (Sender_Offset)));
125 126 127 128 129 130 131 132 133 134 135
   end Sender;

   ----------
   -- Read --
   ----------

   procedure Read
     (Stream : in out Message_Type;
      Item   :    out Stream_Element_Array;
      Last   :    out Stream_Element_Offset)
   is
136 137
      Read_Elts : constant Stream_Element_Count
        := Stream_Element_Count'Min (Item'Length, Length (Stream));
138
   begin
139 140 141 142 143 144 145 146
      if Read_Elts < 1 then
         --  We have nothing to read, exit
         Last := 0;
         return;
      elsif Read_Elts = Item'Length then
         Last := Item'Last;
      else
         Last := Item'First + Read_Elts - 1;
147 148
      end if;

149 150
      Item (Item'First .. Last)
        := Stream.Content (Stream.First .. Stream.First + Read_Elts - 1);
151

152 153 154 155 156
      if Stream.First + Read_Elts < Stream.Content'Last then
         Stream.First := Stream.First + Read_Elts;
      else
         Stream.First := 0;
      end if;
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
   end Read;

   ----------------
   -- Reallocate --
   ----------------

   procedure Reallocate (M : in out Message_Type) is
   begin
      M.First := 1;
      M.Last  := 0;
   end Reallocate;

   -----------
   -- Write --
   -----------

   procedure Write
     (Stream : in out Message_Type;
      Item   :        Stream_Element_Array)
   is
   begin
      if Stream.First > Stream.Last then
179 180
         -- The message is invalid, we reset it

181 182 183 184
         Stream.First := 1;
         Stream.Last := 0;
      end if;

185 186 187
      if Item'Length > Stream.Content'Last - Stream.Last then
         raise Program_Error;
      end if;
188

189
      Stream.Content (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
190 191 192 193 194 195 196 197 198 199 200
      Stream.Last := Stream.Last + Item'Length;
   end Write;

   ---------------
   -- To_Length --
   ---------------

   function To_Length (B : Message_Size_Buffer) return Stream_Element_Count is
   begin
      return Stream_Element_Count
        (Swap_Bytes
201
           (Interfaces.Unsigned_16 (Internal_To_Length (B))));
202 203 204 205 206 207 208 209 210
   end To_Length;

   ---------------
   -- To_Buffer --
   ---------------

   function To_Buffer (L : Stream_Element_Count) return Message_Size_Buffer is
   begin
      return Internal_To_Buffer
211
        (Wrapper (Swap_Bytes (Interfaces.Unsigned_16 (L))));
212 213 214
   end To_Buffer;

end PolyORB_HI.Messages;