Hacker/Hacker.iso/HACKER/DECOMP/DECAF/byteutil.adb

Text File | 1996-09-19 | 16.4 KB | 497 lines

--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: Gilles Demailly
--
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose.  It is provided "as is" without express
-- or implied warranty.
--

with Ada.Unchecked_Conversion;

package body Byte_Utilities is

   Mask_32 : constant Unsigned_64 := 16#FFFFFFFF#;
   Mask_16 : constant Unsigned_32 := 16#FFFF#;
   Mask_8  : constant Unsigned_16 := 16#FF#;

   --
   -- Unchecked conversion is used to convert bytes to
   -- the differents types declared in Basic_Definitions
   --
   function To_Integer  is new Ada.Unchecked_Conversion
                                  (Unsigned_8, Integer_8);
   function To_Integer  is new Ada.Unchecked_Conversion
                                  (Unsigned_16, Integer_16);
   function To_Integer  is new Ada.Unchecked_Conversion
                                  (Unsigned_32, Integer_32);
   function To_Integer  is new Ada.Unchecked_Conversion
                                  (Unsigned_64, Integer_64);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Integer_8, Unsigned_8);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Integer_16, Unsigned_16);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Integer_32, Unsigned_32);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Integer_64, Unsigned_64);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Float_32, Unsigned_32);
   function To_Unsigned is new Ada.Unchecked_Conversion
                                  (Float_64, Unsigned_64);
   function To_Float    is new Ada.Unchecked_Conversion
                                  (Unsigned_32, Float_32);
   function To_Float    is new Ada.Unchecked_Conversion
                                  (Unsigned_64, Float_64);


   -- conversion to file_mode declared in Sequential_Io
   ----------------------------------------------------
   function To_File_Mode (Mode : File_Mode) return Byte_Io.File_Mode is
   begin
      case Mode is
         when In_File =>
            return Byte_Io.In_File;
         when Out_File =>
            return Byte_Io.Out_File;
         when Append_File =>
            return Byte_Io.Append_File;
      end case;
   end To_File_Mode;

   --
   -- basic services just make a call to the Sequential_Io
   -- instanciation services
   --

   procedure Create (File       : in out File_Type;
                     Mode       : in File_Mode         := Out_File;
                     Byte_Order : in Byte_Order_Scheme := Big_Endian;
                     Name       : in String) is
   begin
      File.Byte_Order := Byte_Order;
      Byte_Io.Create (File.File, To_File_Mode (Mode), Name);
   end Create;

   procedure Open   (File       : in out File_Type;
                     Mode       : in File_Mode;
                     Byte_Order : in Byte_Order_Scheme;
                     Name       : in String) is
   begin
      File.Byte_Order := Byte_Order;
      Byte_Io.Open (File.File, To_File_Mode (Mode), Name);
   end Open;

   procedure Close  (File : in out File_Type) is
   begin
      Byte_Io.Close (File.File);
   end Close;

   procedure Delete (File : in out File_Type) is
   begin
      Byte_Io.Delete (File.File);
   end Delete;

   procedure Reset  (File       : in out File_Type;
                     Mode       : in File_mode;
                     Byte_Order : in Byte_Order_Scheme) is
   begin
      Byte_Io.Reset (File.File, To_File_Mode (Mode));
      File.Byte_Order := Byte_Order;
   end Reset;

   procedure Reset  (File : in out File_Type) is
   begin
      Byte_Io.Reset (File.File);
   end Reset;


   --
   -- Read procedures for types defined in Basic_Definitions
   -- types sized other 8 bits receive special treatment depending
   -- on the underlying representation of data in the file
   --

   procedure Read   (File : in File_Type; Item : out Unsigned_8) is
   begin
      Byte_Io.Read (File.File, Item);
   end Read;

   procedure Read   (File : in File_Type; Item : out Unsigned_16) is
      Part   : Unsigned_8;
      Answer : Unsigned_16;
   begin
      Byte_Io.Read (File.File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_16 (Part), 8);
         when Little_Endian =>
            Answer := Unsigned_16 (Part);
      end case;
      Byte_Io.Read (File.File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Answer + Unsigned_16 (Part);
         when Little_Endian =>
            Answer := Answer + Shift_Left (Unsigned_16 (Part), 8);
      end case;
      Item := Answer;
   end Read;

   procedure Read   (File : in File_Type; Item : out Unsigned_32) is
      Part   : Unsigned_16;
      Answer : Unsigned_32;
   begin
      Read (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_32 (Part), 16);
         when Little_Endian =>
            Answer := Unsigned_32 (Part);
      end case;
      Read (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Answer + Unsigned_32 (Part);
         when Little_Endian =>
            Answer := Answer + Shift_Left (Unsigned_32 (Part), 16);
      end case;
      Item := Answer;
   end Read;

   procedure Read   (File : in File_Type; Item : out Unsigned_64) is
      Part   : Unsigned_32;
      Answer : Unsigned_64;
   begin
      Read (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_64 (Part), 32);
         when Little_Endian =>
            Answer := Unsigned_64 (Part);
      end case;
      Read (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Answer := Answer + Unsigned_64 (Part);
         when Little_Endian =>
            Answer := Answer + Shift_Left (Unsigned_64 (Part), 32);
      end case;
      Item := Answer;
   end Read;

   procedure Read   (File : in File_Type; Item : out Integer_8) is
      Answer : Unsigned_8;
   begin
      Read (File, Answer);
      Item := To_Integer (Answer);
   end Read;

   procedure Read   (File : in File_Type; Item : out Integer_16) is
      Answer : Unsigned_16;
   begin
      Read (File, Answer);
      Item := To_Integer (Answer);
   end Read;

   procedure Read   (File : in File_Type; Item : out Integer_32) is
      Answer : Unsigned_32;
   begin
      Read (File, Answer);
      Item := To_Integer (Answer);
   end Read;

   procedure Read   (File : in File_Type; Item : out Integer_64) is
      Answer : Unsigned_64;
   begin
      Read (File, Answer);
      Item := To_Integer (Answer);
   end Read;

   procedure Read   (File : in File_Type; Item : out Float_32) is
      Answer : Unsigned_32;
   begin
      Read (File, Answer);
      Item := To_Float (Answer);
   end Read;

   procedure Read   (File : in File_Type; Item : out Float_64) is
      Answer : Unsigned_64;
   begin
      Read (File, Answer);
      Item := To_Float (Answer);
   end Read;


   --
   -- Write procedures for types defined in Basic_Definitions
   -- types sized other 8 bits receive special treatment depending
   -- on the underlying representation of data in the file
   --

   procedure Write  (File : in File_Type; Item : in Unsigned_8) is
   begin
      Byte_Io.Write (File.File, Item);
   end Write;

   procedure Write  (File : in File_Type; Item : in Unsigned_16) is
      Part : Unsigned_8;
   begin
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_8 (Shift_Right (Item, 8) and Mask_8);
         when Little_Endian =>
            Part := Unsigned_8 (Item and Mask_8);
      end case;
      Byte_Io.Write (File.File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_8 (Item and Mask_8);
         when Little_Endian =>
            Part := Unsigned_8 (Shift_Right (Item, 8) and Mask_8);
      end case;
      Byte_Io.Write (File.File, Part);
   end Write;

   procedure Write  (File : in File_Type; Item : in Unsigned_32) is
      Part : Unsigned_16;
   begin
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_16 (Shift_Right (Item, 16) and Mask_16);
         when Little_Endian =>
            Part := Unsigned_16 (Item and Mask_16);
      end case;
      Write (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_16 (Item and Mask_16);
         when Little_Endian =>
            Part := Unsigned_16 (Shift_Right (Item, 16) and Mask_16);
      end case;
      Write (File, Part);
   end Write;

   procedure Write  (File : in File_Type; Item : in Unsigned_64) is
      Part : Unsigned_32;
   begin
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_32 (Shift_Right (Item, 32) and Mask_32);
         when Little_Endian =>
            Part := Unsigned_32 (Item and Mask_32);
      end case;
      Write (File, Part);
      case File.Byte_Order is
         when Big_Endian =>
            Part := Unsigned_32 (Item and Mask_32);
         when Little_Endian =>
            Part := Unsigned_32 (Shift_Right (Item, 32) and Mask_32);
      end case;
      Write (File, Part);
   end Write;

   procedure Write  (File : in File_Type; Item : in Integer_8) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;

   procedure Write  (File : in File_Type; Item : in Integer_16) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;

   procedure Write  (File : in File_Type; Item : in Integer_32) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;

   procedure Write  (File : in File_Type; Item : in Integer_64) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;

   procedure Write  (File : in File_Type; Item : in Float_32) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;

   procedure Write  (File : in File_Type; Item : in Float_64) is
   begin
      Write (File, To_Unsigned (Item));
   end Write;


   --
   -- Read functions for types defined in Basic_Definitions
   -- types sized other 8 bits receive special treatment depending
   -- on the underlying representation of data in the file
   --

   function Get_Unsigned_8
               (From       : Acc_Bytes;
                Index      : Unsigned_32)
            return Unsigned_8 is
   begin
      return From (Index);
   end Get_Unsigned_8;

   function Get_Unsigned_16
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Unsigned_16 is
      Answer : Unsigned_16;
   begin
      case Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_16 (From (Index)), 8);
            Answer := Answer + Unsigned_16 (From (Index + 1));
         when Little_Endian =>
            Answer := Shift_Left (Unsigned_16 (From (Index + 1)), 8);
            Answer := Answer + Unsigned_16 (From (Index));
      end case;
      return Answer;
   end Get_Unsigned_16;

   function Get_Unsigned_32
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Unsigned_32 is
      Answer : Unsigned_32;
   begin
      case Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_32 (From (Index)), 24);
            Answer := Answer + Shift_Left (Unsigned_32 (From (Index + 1)), 16);
            Answer := Answer + Shift_Left (Unsigned_32 (From (Index + 2)), 8);
            Answer := Answer + Unsigned_32 (From (Index + 3));
         when Little_Endian =>
            Answer := Shift_Left (Unsigned_32 (From (Index + 3)), 24);
            Answer := Answer + Shift_Left (Unsigned_32 (From (Index + 2)), 16);
            Answer := Answer + Shift_Left (Unsigned_32 (From (Index + 1)), 8);
            Answer := Answer + Unsigned_32 (From (Index));
      end case;
      return Answer;
   end Get_Unsigned_32;

   function Get_Unsigned_64
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Unsigned_64 is
      Answer : Unsigned_64;
   begin
      case Byte_Order is
         when Big_Endian =>
            Answer := Shift_Left (Unsigned_64 (From (Index)), 56);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 1)), 48);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 2)), 40);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 3)), 32);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 4)), 24);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 5)), 16);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 6)), 8);
            Answer := Answer + Unsigned_64 (From (Index + 7));
         when Little_Endian =>
            Answer := Shift_Left (Unsigned_64 (From (Index + 7)), 56);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 6)), 48);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 5)), 40);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 4)), 32);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 3)), 24);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 2)), 16);
            Answer := Answer + Shift_Left (Unsigned_64 (From (Index + 1)), 8);
            Answer := Answer + Unsigned_64 (From (Index));
      end case;
      return Answer;
   end Get_Unsigned_64;


   function Get_Float_32
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Float_32 is
      Answer : Unsigned_32;
   begin
      Answer := Get_Unsigned_32
                   (From       => From,
                    Index      => Index,
                    Byte_Order => Byte_Order);
      return To_Float (Answer);
   end Get_Float_32;

   function Get_Float_64
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Float_64 is
      Answer : Unsigned_64;
   begin
      Answer := Get_Unsigned_64
                   (From       => From,
                    Index      => Index,
                    Byte_Order => Byte_Order);
      return To_Float (Answer);
   end Get_Float_64;


   function Get_Integer_8
               (From       : Acc_Bytes;
                Index      : Unsigned_32)
            return Integer_8 is
   begin
      return To_Integer (Get_Unsigned_8 (From, Index));
   end Get_Integer_8;

   function Get_Integer_16
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Integer_16 is
   begin
      return To_Integer (Get_Unsigned_16 (From, Index, Byte_Order));
   end Get_Integer_16;

   function Get_Integer_32
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Integer_32 is
   begin
      return To_Integer (Get_Unsigned_32 (From, Index, Byte_Order));
   end Get_Integer_32;

   function Get_Integer_64
               (From       : Acc_Bytes;
                Index      : Unsigned_32;
                Byte_Order : Byte_Order_Scheme := Big_Endian)
            return Integer_64 is
   begin
      return To_Integer (Get_Unsigned_64 (From, Index, Byte_Order));
   end Get_Integer_64;

   function Get_String
               (From   : Acc_Bytes;
                Index  : Unsigned_32;
                Length : Positive)
            return String is

      subtype String_Loc is String (1..Length);
      subtype Bytes_Loc is  Bytes  (1..Unsigned_32(Length));

      function To_String is new Ada.Unchecked_Conversion
                                   (Bytes_Loc, String_Loc);
   begin
      return To_String (From.all (Index .. Index + Unsigned_32(Length) - 1));
   end Get_String;

end Byte_Utilities;