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;