polyorb_hi-utils.adb 4.94 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                          PolyORB HI COMPONENTS                           --
--                                                                          --
--                     P O L Y O R B _ H I . U T I L S                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--       Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE.        --
--                                                                          --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. 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.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27 28
--              PolyORB-HI/Ada is maintained by the TASTE project           --
--                      (taste-users@lists.tuxfamily.org)                   --
29 30 31 32 33 34 35 36 37
--                                                                          --
------------------------------------------------------------------------------

package body PolyORB_HI.Utils is

   ------------------
   -- To_HI_String --
   ------------------

38
   function To_HI_String (S : String) return HI_String is
39
      R : String (1 .. HI_String_Size) := (others => ' ');
40
   begin
41 42 43
      if S'Length < 1 then
         return HI_String'(S => R,
                           L => 0);
44

45 46 47
      elsif S'Length <= HI_String_Size then
         for J in 1 .. S'Length loop
            R (J) := S (S'First + (J - 1));
48

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
         end loop;

         --  XXX GNATProve GPL2014 cannot prove the code below, which
         --  appears equivalent, TBI
         --  R (1 .. S'Length) := S (S'First .. S'Last);

         return HI_String'(S => R,
                           L => S'Length);

      else
         R (1 .. HI_String_Size) := S (S'First .. S'First + HI_String_Size - 1);
         return HI_String'(S => R,
                           L => HI_String_Size);
      end if;

   end To_HI_String;
65 66 67 68

   ----------------
   -- Swap_Bytes --
   ----------------
yoogx's avatar
yoogx committed
69
   --  XXX check intrinsic __builtint_bswapXX
70

71 72
   function Swap_Bytes (B : Interfaces.Unsigned_16)
                       return Interfaces.Unsigned_16
73 74
   is
      use System;
yoogx's avatar
yoogx committed
75

76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
   begin
      pragma Warnings (Off);
      --  Note: this is to disable a warning on the following test
      --  being always true/false on a node.

      if Default_Bit_Order = High_Order_First then
         return B;

         pragma Warnings (On);

      --  Little-endian case. We must swap the high and low bytes

      else
         return (B / 256) + (B mod 256) * 256;
      end if;
   end Swap_Bytes;

   -------------------
   -- Internal_Code --
   -------------------

97
   function Internal_Code (P : Port_Type) return Unsigned_16 is
98
      function To_Internal_Code is new Ada.Unchecked_Conversion
99
        (Port_Type, Unsigned_16);
100 101 102 103 104 105 106 107
   begin
      return Swap_Bytes (To_Internal_Code (P));
   end Internal_Code;

   ------------------------
   -- Corresponding_Port --
   ------------------------

108
   function Corresponding_Port (I : Unsigned_16) return Port_Type is
109
      function To_Corresponding_Port is new Ada.Unchecked_Conversion
110
        (Unsigned_16, Port_Type);
111 112 113 114
   begin
      return To_Corresponding_Port (Swap_Bytes (I));
   end Corresponding_Port;

115 116 117 118 119 120 121
   ------------------
   -- Parse_String --
   ------------------

   function Parse_String (S : String; First : Integer; Delimiter : Character)
                         return Integer
   is
122
      Last : Integer := S'Last;
123
   begin
124
      for J in First .. S'Last loop
125 126 127 128 129 130 131 132 133
         if S (J) = Delimiter then
            Last := J - 1;
            exit;
         end if;
      end loop;

      return Last;
   end Parse_String;

134
end PolyORB_HI.Utils;