------------------------------------------------------------------------------
--                                                                          --
--                        JGNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.3 $
--                                                                          --
--           Copyright (C) 1998-2000 Ada Core Technologies, Inc.            --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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 GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, 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.                                      --
--                                                                          --
-- JGNAT -  The GNAT Ada 95 tool chain for the Java (TM) Virtual Machine is --
--          maintained by Ada Core Technologies, Inc. - http://www.gnat.com --
--                                                                          --
------------------------------------------------------------------------------

--  This is the JGNAT-specific version of the body of System.Stream_Attributes

with Ada.IO_Exceptions;
with Ada.Streams; use Ada.Streams;

package body System.Stream_Attributes is

   Err : exception renames Ada.IO_Exceptions.End_Error;
   --  Exception raised if insufficient data read (note that the RM implies
   --  that Data_Error might be the appropriate choice, but AI195-00132
   --  decides with a binding interpretation that End_Error is preferred).

   SU : constant := System.Storage_Unit;

   subtype SEA is Ada.Streams.Stream_Element_Array;
   subtype SEO is Ada.Streams.Stream_Element_Offset;

   --  generic function UC renames Unchecked_Conversion;

   --  Subtypes used to define Stream_Element_Array values that map
   --  into the elementary types, using unchecked conversion.

   --  Thin_Pointer_Size : constant := System.Address'Size;
   --  Fat_Pointer_Size  : constant := System.Address'Size * 2;

   --  subtype S_AD  is SEA (1 .. (Fat_Pointer_Size      + SU - 1) / SU);
   --  subtype S_AS  is SEA (1 .. (Thin_Pointer_Size     + SU - 1) / SU);
   subtype S_B   is SEA (1 .. (Boolean'Size              + SU - 1) / SU);
   subtype S_C   is SEA (1 .. (Character'Size            + SU - 1) / SU);
   subtype S_F   is SEA (1 .. (Float'Size                + SU - 1) / SU);
   subtype S_I   is SEA (1 .. (Integer'Size              + SU - 1) / SU);
   subtype S_LF  is SEA (1 .. (Long_Float'Size           + SU - 1) / SU);
   subtype S_LI  is SEA (1 .. (Long_Integer'Size         + SU - 1) / SU);
   subtype S_LLF is SEA (1 .. (Long_Long_Float'Size      + SU - 1) / SU);
   subtype S_LLI is SEA (1 .. (Long_Long_Integer'Size     + SU - 1) / SU);
   subtype S_LLU is SEA (1 .. (UST.Long_Long_Unsigned'Size   + SU - 1) / SU);
   subtype S_LU  is SEA (1 .. (UST.Long_Unsigned'Size        + SU - 1) / SU);
   subtype S_SF  is SEA (1 .. (Short_Float'Size              + SU - 1) / SU);
   --  subtype S_SI  is SEA (1 .. (Short_Integer'Size        + SU - 1) / SU);
   subtype S_SSI is SEA (1 .. (Short_Short_Integer'Size      + SU - 1) / SU);
   subtype S_SSU is SEA (1 .. (UST.Short_Short_Unsigned'Size + SU - 1) / SU);
   subtype S_SU  is SEA (1 .. (UST.Short_Unsigned'Size       + SU - 1) / SU);
   subtype S_U   is SEA (1 .. (UST.Unsigned'Size             + SU - 1) / SU);
   subtype S_WC  is SEA (1 .. (Wide_Character'Size           + SU - 1) / SU);

   --  Unchecked conversions from the elementary type to the stream type

   --  The JVM does not directly support unchecked conversions from
   --  scalar types to byte arrays, so we import a set of conversion
   --  methods that are implemented using the API DataOutputStream class.

   --  ??? function From_AD  (From : Fat_Pointer) return S_AD;
   --  ??? function From_AS  (From : Thin_Pointer) return S_AS;

   function From_C   (From : Character) return S_C;
   pragma Import (MSIL, From_C, "mgnat.adalib.Prim_Conversions.From_C");

   function From_F   (From : Float) return S_F;
   pragma Import (MSIL, From_F, "mgnat.adalib.Prim_Conversions.From_F");

   function From_I   (From : Integer) return S_I;
   pragma Import (MSIL, From_I, "mgnat.adalib.Prim_Conversions.From_I");

   function From_LF  (From : Long_Float) return S_LF;
   pragma Import (MSIL, From_LF, "mgnat.adalib.Prim_Conversions.From_LF");

   function From_LI  (From : Long_Integer) return S_LI;
   pragma Import (MSIL, From_LI, "mgnat.adalib.Prim_Conversions.From_LI");

   --  function From_LLF (From : Long_Long_Float) return S_LLF;
   --  pragma Import (MSIL, From_LLF, "mgnat.adalib.Prim_Conversions.From_LF");

   --  function From_LLI (From : Long_Long_Integer) return S_LLI;
   --  pragma Import (MSIL, From_LLI, "mgnat.adalib.Prim_Conversions.From_LI");

   function From_LLU (From : UST.Long_Long_Unsigned) return S_LLU;
   pragma Import (MSIL, From_LLU, "mgnat.adalib.Prim_Conversions.From_LI");

   function From_LU  (From : UST.Long_Unsigned) return S_LU;
   pragma Import (MSIL, From_LU, "mgnat.adalib.Prim_Conversions.From_LI");

   function From_SF  (From : Short_Float) return S_SF;
   pragma Import (MSIL, From_SF, "mgnat.adalib.Prim_Conversions.From_F");

   --  function From_SI  (From : Short_Integer) return S_SI;
   --  pragma Import (MSIL, From_SI, "mgnat.adalib.Prim_Conversions.From_SI");

   function From_SSI (From : Short_Short_Integer) return S_SSI;
   pragma Import (MSIL, From_SSI, "mgnat.adalib.Prim_Conversions.From_B");

   function From_SSU (From : UST.Short_Short_Unsigned) return S_SSU;
   pragma Import (MSIL, From_SSU, "mgnat.adalib.Prim_Conversions.From_B");

   function From_SU  (From : UST.Short_Unsigned) return S_SU;
   pragma Import (MSIL, From_SU, "mgnat.adalib.Prim_Conversions.From_I");
   --  pragma Import (MSIL, From_SU, "mgnat.adalib.Prim_Conversions.From_SI");

   function From_U   (From : UST.Unsigned) return S_U;
   pragma Import (MSIL, From_U, "mgnat.adalib.Prim_Conversions.From_I");

   function From_WC  (From : Wide_Character) return S_WC;
   pragma Import (MSIL, From_WC, "mgnat.adalib.Prim_Conversions.From_WC");

   --  Unchecked conversions from the stream type to elementary type

   --  The JVM does not directly support unchecked conversions from
   --  byte arrays to scalar types, so we import a set of conversion
   --  methods that are implemented using the API DataInputStream class.

   --  ??? function To_AD  (From : S_AD) return Fat_Pointer;
   --  ??? function To_AS  (From : S_AS) return Thin_Pointer;

   function To_C   (From : S_C) return Character;
   pragma Import (MSIL, To_C, "mgnat.adalib.Prim_Conversions.To_C");

   function To_F   (From : S_F) return Float;
   pragma Import (MSIL, To_F, "mgnat.adalib.Prim_Conversions.To_F");

   function To_I   (From : S_I) return Integer;
   pragma Import (MSIL, To_I, "mgnat.adalib.Prim_Conversions.To_I");

   function To_LF  (From : S_LF) return Long_Float;
   pragma Import (MSIL, To_LF, "mgnat.adalib.Prim_Conversions.To_LF");

   function To_LI  (From : S_LI) return Long_Integer;
   pragma Import (MSIL, To_LI, "mgnat.adalib.Prim_Conversions.To_LI");

   function To_LLF (From : S_LLF) return Long_Long_Float;
   pragma Import (MSIL, To_LLF, "mgnat.adalib.Prim_Conversions.To_LF");

   function To_LLI (From : S_LLI) return Long_Long_Integer;
   pragma Import (MSIL, To_LLI, "mgnat.adalib.Prim_Conversions.To_LI");

   function To_LLU (From : S_LLU) return UST.Long_Long_Unsigned;
   pragma Import (MSIL, To_LLU, "mgnat.adalib.Prim_Conversions.To_LI");

   function To_LU  (From : S_LU) return UST.Long_Unsigned;
   pragma Import (MSIL, To_LU, "mgnat.adalib.Prim_Conversions.To_LI");

   function To_SF  (From : S_SF) return Short_Float;
   pragma Import (MSIL, To_SF, "mgnat.adalib.Prim_Conversions.To_F");

   --  function To_SI  (From : S_SI) return Short_Integer;
   --  pragma Import (MSIL, To_SI, "mgnat.adalib.Prim_Conversions.To_I");
   --  pragma Import (MSIL, To_SI, "mgnat.adalib.Prim_Conversions.To_SI");

   function To_SSI (From : S_SSI) return Short_Short_Integer;
   pragma Import (MSIL, To_SSI, "mgnat.adalib.Prim_Conversions.To_B");

   function To_SSU (From : S_SSU) return UST.Short_Short_Unsigned;
   pragma Import (MSIL, To_SSU, "mgnat.adalib.Prim_Conversions.To_B");

   function To_SU  (From : S_SU) return UST.Short_Unsigned;
   pragma Import (MSIL, To_SU, "mgnat.adalib.Prim_Conversions.To_I");
   --  pragma Import (MSIL, To_SU, "mgnat.adalib.Prim_Conversions.To_SI");

   function To_U (From : S_U) return UST.Unsigned;
   pragma Import (MSIL, To_U, "mgnat.adalib.Prim_Conversions.To_I");

   function To_WC  (From : S_WC) return Wide_Character;
   pragma Import (MSIL, To_WC, "mgnat.adalib.Prim_Conversions.To_WC");

   ----------
   -- I_AD --
   ----------

   function I_AD (Stream : access RST) return Fat_Pointer is
   begin
      --  Reading of fat pointers not supported for JGNAT ???

      raise Program_Error;

      return (Null_Address, Null_Address);
   end I_AD;

   ----------
   -- I_AS --
   ----------

   function I_AS (Stream : access RST) return Thin_Pointer is
   begin
      --  Reading of thin pointers not supported for JGNAT ???

      raise Program_Error;

      return (P1 => Null_Address);
   end I_AS;

   ---------
   -- I_B --
   ---------

   function I_B (Stream : access RST) return Boolean is
      T : S_B;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return Boolean'Val (T (1));
      end if;
   end I_B;

   ---------
   -- I_C --
   ---------

   function I_C (Stream : access RST) return Character is
      T : S_C;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_C (T);
      end if;
   end I_C;

   ---------
   -- I_F --
   ---------

   function I_F (Stream : access RST) return Float is
      T : S_F;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_F (T);
      end if;
   end I_F;

   ---------
   -- I_I --
   ---------

   function I_I (Stream : access RST) return Integer is
      T : S_I;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_I (T);
      end if;
   end I_I;

   ----------
   -- I_LF --
   ----------

   function I_LF (Stream : access RST) return Long_Float is
      T : S_LF;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LF (T);
      end if;
   end I_LF;

   ----------
   -- I_LI --
   ----------

   function I_LI (Stream : access RST) return Long_Integer is
      T : S_LI;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LI (T);
      end if;
   end I_LI;

   -----------
   -- I_LLF --
   -----------

   function I_LLF (Stream : access RST) return Long_Long_Float is
      T : S_LLF;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LLF (T);
      end if;
   end I_LLF;

   -----------
   -- I_LLI --
   -----------

   function I_LLI (Stream : access RST) return Long_Long_Integer is
      T : S_LLI;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LLI (T);
      end if;
   end I_LLI;

   -----------
   -- I_LLU --
   -----------

   function I_LLU (Stream : access RST) return UST.Long_Long_Unsigned is
      T : S_LLU;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LLU (T);
      end if;
   end I_LLU;

   ----------
   -- I_LU --
   ----------

   function I_LU (Stream : access RST) return UST.Long_Unsigned is
      T : S_LU;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_LU (T);
      end if;
   end I_LU;

   ----------
   -- I_SF --
   ----------

   function I_SF (Stream : access RST) return Short_Float is
      T : S_SF;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_SF (T);
      end if;
   end I_SF;

   ----------
   -- I_SI --
   ----------

   function I_SI (Stream : access RST) return Short_Integer is
      --  Read the value in as a four-byte int value rather than
      --  a two-byte short value. Workaround needed because currently
      --  we map Short_Integer values to 32 bits.
      --
      --  T : S_SI;
      T : S_I;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         --  return To_SI (T);
         return Short_Integer (To_I (T));
      end if;
   end I_SI;

   -----------
   -- I_SSI --
   -----------

   function I_SSI (Stream : access RST) return Short_Short_Integer is
      T : S_SSI;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_SSI (T);
      end if;
   end I_SSI;

   -----------
   -- I_SSU --
   -----------

   function I_SSU (Stream : access RST) return UST.Short_Short_Unsigned is
      T : S_SSU;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_SSU (T);
      end if;
   end I_SSU;

   ----------
   -- I_SU --
   ----------

   function I_SU (Stream : access RST) return UST.Short_Unsigned is
      --  Read the value in as a four-byte int value rather than
      --  a two-byte short value. Workaround needed because currently
      --  we map Short_Unsigned values to 32 bits.
      --
      T : S_SU;
      --  T : S_I;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_SU (T);
      end if;
   end I_SU;

   ---------
   -- I_U --
   ---------

   function I_U (Stream : access RST) return UST.Unsigned is
      T : S_U;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_U (T);
      end if;
   end I_U;

   ----------
   -- I_WC --
   ----------

   function I_WC (Stream : access RST) return Wide_Character is
      T : S_WC;
      L : SEO;

   begin
      Ada.Streams.Read (Stream.all, T, L);

      if L < T'Last then
         raise Err;
      else
         return To_WC (T);
      end if;
   end I_WC;

   ----------
   -- W_AD --
   ----------

   procedure W_AD (Stream : access RST; Item : in Fat_Pointer) is
   begin
      --  Writing of fat pointers not supported for JGNAT ???

      raise Program_Error;
   end W_AD;

   ----------
   -- W_AS --
   ----------

   procedure W_AS (Stream : access RST; Item : in Thin_Pointer) is
   begin
      --  Writing of thin pointers not supported for JGNAT ???

      raise Program_Error;
   end W_AS;

   ---------
   -- W_B --
   ---------

   procedure W_B (Stream : access RST; Item : in Boolean) is
      T : S_B;

   begin
      T (1) := Boolean'Pos (Item);
      Ada.Streams.Write (Stream.all, T);
   end W_B;

   ---------
   -- W_C --
   ---------

   procedure W_C (Stream : access RST; Item : in Character) is
      T : constant S_C := From_C (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_C;

   ---------
   -- W_F --
   ---------

   procedure W_F (Stream : access RST; Item : in Float) is
      T : constant S_F := From_F (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_F;

   ---------
   -- W_I --
   ---------

   procedure W_I (Stream : access RST; Item : in Integer) is
      T : constant S_I := From_I (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_I;

   ----------
   -- W_LF --
   ----------

   procedure W_LF (Stream : access RST; Item : in Long_Float) is
      T : constant S_LF := From_LF (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LF;

   ----------
   -- W_LI --
   ----------

   procedure W_LI (Stream : access RST; Item : in Long_Integer) is
      T : constant S_LI := From_LI (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LI;

   -----------
   -- W_LLF --
   -----------

   procedure W_LLF (Stream : access RST; Item : in Long_Long_Float) is
      --  T : constant S_LLF := From_LLF (Item);
      T : constant S_LF := From_LF (Long_Float (Item));

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LLF;

   -----------
   -- W_LLI --
   -----------

   procedure W_LLI (Stream : access RST; Item : in Long_Long_Integer) is
      --  T : constant S_LLI := From_LLI (Item);
      T : constant S_LI := From_LI (Long_Integer (Item));

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LLI;

   -----------
   -- W_LLU --
   -----------

   procedure W_LLU (Stream : access RST; Item : in UST.Long_Long_Unsigned) is
      T : constant S_LLU := From_LLU (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LLU;

   ----------
   -- W_LU --
   ----------

   procedure W_LU (Stream : access RST; Item : in UST.Long_Unsigned) is
      T : constant S_LU := From_LU (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_LU;

   ----------
   -- W_SF --
   ----------

   procedure W_SF (Stream : access RST; Item : in Short_Float) is
      T : constant S_SF := From_SF (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_SF;

   ----------
   -- W_SI --
   ----------

   procedure W_SI (Stream : access RST; Item : in Short_Integer) is
      --  T : constant S_SI := From_SI (Item);
      T : constant S_I := From_I (Integer (Item));

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_SI;

   -----------
   -- W_SSI --
   -----------

   procedure W_SSI (Stream : access RST; Item : in Short_Short_Integer) is
      T : constant S_SSI := From_SSI (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_SSI;

   -----------
   -- W_SSU --
   -----------

   procedure W_SSU (Stream : access RST; Item : in UST.Short_Short_Unsigned) is
      T : constant S_SSU := From_SSU (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_SSU;

   ----------
   -- W_SU --
   ----------

   procedure W_SU (Stream : access RST; Item : in UST.Short_Unsigned) is
      T : constant S_SU := From_SU (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_SU;

   ---------
   -- W_U --
   ---------

   procedure W_U (Stream : access RST; Item : in UST.Unsigned) is
      T : constant S_U := From_U (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_U;

   ----------
   -- W_WC --
   ----------

   procedure W_WC (Stream : access RST; Item : in Wide_Character) is
      T : constant S_WC := From_WC (Item);

   begin
      Ada.Streams.Write (Stream.all, T);
   end W_WC;

end System.Stream_Attributes;
