File : flex_common.adb

--                              -*- Mode: Ada -*-
-- Filename        : flex_common.adb
-- Description     : common procedures for flex
-- Author          : Christfried Webers
-- Created On      : Wed Nov 10 15:07:55 1999
-- Last Modified By: .
-- Last Modified On: .
-- Update Count    : 0
-- Status          : Experimental
------------------------------------------------------------------------------

with Text_IO;             use Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

package body Flex_Common is

   ----------------------------------------------------------------------------
   ---
   --
   -- Utility routines
   --
   ----------------------------------------------------------------------------
   ---

   function ByteArrayToString (Data : in ByteArray) return String is
      DataString : String (1 .. Data'Length);
   begin
      for Index in 1 .. Data'Length loop
         DataString (Index) := Character'Val (Data (Data'First + Index - 1));
      end loop;
      return DataString;
   end ByteArrayToString;

   function StringToByteArray (Data : String) return ByteArray is
      DataArray : ByteArray (1 .. Data'Length);
   begin
      for Index in Data'Range loop
         DataArray (Index) := Character'Pos (Data (Index));
      end loop;
      return DataArray;
   end StringToByteArray;

   procedure PutHex (Number : Raw_8Bit) is
      procedure PutNibble (n : Raw_8Bit) is
      begin
         if n < 10 then
            Put (Character'Val (Character'Pos ('0') + n));
         else
            Put (Character'Val (Character'Pos ('A') + n - 10));
         end if;
      end PutNibble;
   begin
      PutNibble (Number / 2 ** 4);
      PutNibble (Number mod 2 ** 4);
   end PutHex;

   procedure PutHex (Number : Raw_16Bit) is
   begin
      PutHex (Raw_8Bit (Number / 2 ** 8));
      PutHex (Raw_8Bit (Number mod 2 ** 8));
   end PutHex;

   procedure PutHex (Number : Raw_32Bit) is
   begin
      PutHex (Raw_16Bit (Number / 2 ** 16));
      PutHex (Raw_16Bit (Number mod 2 ** 16));
   end PutHex;

   function TwoBytes_To_Raw_16Bit (Bytes : ByteArray) return Raw_16Bit is
      First : Integer := Bytes'First;
   begin
      pragma Assert
        (Bytes'Length = 2,
         "TwoBytes2Integer: called with number of bytes /= 2");

      return Raw_16Bit (Bytes (First)) * 2 ** 8 +
             Raw_16Bit (Bytes (First + 1));
   end TwoBytes_To_Raw_16Bit;

   function FourBytes_To_Raw_32Bit (Bytes : ByteArray) return Raw_32Bit is
      First : Integer := Bytes'First;
   begin
      pragma Assert
        (Bytes'Length = 4,
         "FourBytes2Integer: called with number of bytes /= 4");

      return Raw_32Bit (Bytes (First)) * 2 ** 24 +
             Raw_32Bit (Bytes (First + 1)) * 2 ** 16 +
             Raw_32Bit (Bytes (First + 2)) * 2 ** 8 +
             Raw_32Bit (Bytes (First + 3));
   end FourBytes_To_Raw_32Bit;

   function FourBytes_To_Signed_32Bit
     (Bytes : ByteArray)
      return  Signed_32Bit
   is
      First      : Integer := Bytes'First;
      Raw_Number : Raw_32Bit;
   begin
      pragma Assert
        (Bytes'Length = 4,
         "FourBytes2Integer: called with number of bytes /= 4");

      Raw_Number := Raw_32Bit (Bytes (First)) * 2 ** 24 +
                    Raw_32Bit (Bytes (First + 1)) * 2 ** 16 +
                    Raw_32Bit (Bytes (First + 2)) * 2 ** 8 +
                    Raw_32Bit (Bytes (First + 3));
      if Raw_Number < 2 ** 31 then
         return Signed_32Bit (Raw_Number);
      else
         return -2 ** 31 + Signed_32Bit (Raw_Number - 2 ** 31);
      end if;
   end FourBytes_To_Signed_32Bit;

   function Raw_32Bit_To_FourBytes (Number : Raw_32Bit) return ByteArray is
      Result : ByteArray (1 .. 4);
      Rest   : Raw_32Bit := Number;
   begin
      for K in reverse 1 .. 4 loop
         Result (K) := Raw_8Bit (Rest mod 2 ** 8);
         Rest       := Rest / 2 ** 8;
      end loop;
      return Result;
   end Raw_32Bit_To_FourBytes;

   procedure ShowContents (Contents : ByteArray) is
   begin
      for I in Contents'First .. Contents'Last loop
         PutHex (Contents (I));
         Put (" ");
      end loop;
   end ShowContents;

end Flex_Common;