[Ada] improve handling of streams and floats

Arnaud Charlet charlet@adacore.com
Mon Jun 11 16:01:00 GMT 2007


Tested on i686-linux, committed on trunk

The selection of the right routine in System.Stream_Attributes in
the floating-point case was done only by size. This meant that on
a machine with Long_Float'Size = Long_Long_Float'Size (most cases
except x86), the Long_Float routines could be used instead of the
Long_Long_Float routines even for Long_Long_Float types. This was
relatively harmless, since the code is identical. However, in
specialized applications where the Stream_Attribute package was
customized to aid in inter-target portability, this caused some
difficulty.

The patch now ensures that the type correct routine is chosen, as
long as there are no strange Size or Stream_Size choices that force
another choice.

When the following program is compiled using -gnatG

with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure g is
   LLF : Long_Long_Float;
   FLT : Float;
   FCB : Ada.Streams.Stream_IO.File_Type;

begin
   Create (FCB, Out_File, "tmp");
   LLF := 1.2345;
   FLT := 3.1416;
   Long_Long_Float'Output (Stream (FCB), LLF);
   Float'Output (Stream (FCB), FLT);
   Close (FCB);
   Open (FCB, In_File, "tmp");
   LLF := Long_Long_Float'Input (Stream (FCB));
   Put_Line (Long_Float (LLF)'Img);
   FLT := Float'Input (Stream (FCB));
   Put_Line (FLT'Img);
end;

and the output put into a file log, doing a grep command:

grep system__stream_attributes log

should generate five lines:

with system.system__stream_attributes;
   $system__stream_attributes__w_llf (R2b, llf);
   $system__stream_attributes__w_f (R3b, flt);
   llf := long_long_float!($system__stream_attributes__i_llf (R5b));
   flt := float!($system__stream_attributes__i_f (R7b));

Without the patch w_sf and i_sf were used, and on non-x86 targets
w_lf and i_lf.

2007-06-06  Robert Dewar  <dewar@adacore.com>

	* exp_strm.adb (Make_Field_Attributes): Avoid _Parent components that
	are interface type.
	(Build_Elementary_Input_Call): For floating-point use right type in the
	absence of strange size or stream size clauses.
	(Build_Elementary_Write_Call): Same fix
	(Has_Stream_Standard_Rep): Returns False if Stream_Size attribute
	set to value that does not match base type size.

-------------- next part --------------
Index: exp_strm.adb
===================================================================
--- exp_strm.adb	(revision 124068)
+++ exp_strm.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, 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- --
@@ -80,11 +80,12 @@ package body Exp_Strm is
    --  The parameter Fnam is the name of the constructed function.
 
    function Has_Stream_Standard_Rep (U_Type : Entity_Id) return Boolean;
-   --  This function is used to test U_Type, which is a type
-   --  Returns True if U_Type has a standard representation for stream
-   --  purposes, i.e. there is no non-standard enumeration representation
-   --  clause, and the size of the first subtype is the same as the size
-   --  of the root type.
+   --  This function is used to test the type U_Type, to determine if it has
+   --  a standard representation from a streaming point of view. Standard means
+   --  that it has a standard representation (e.g. no enumeration rep clause),
+   --  and the size of the root type is the same as the streaming size (which
+   --  is defined as value specified by a Stream_Size clause if present, or
+   --  the Esize of U_Type if not).
 
    function Make_Stream_Subprogram_Name
      (Loc : Source_Ptr;
@@ -456,7 +457,7 @@ package body Exp_Strm is
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
 
-      if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then
+      if Has_Stream_Size_Clause (FST) then
          P_Size := Static_Integer (Expression (Stream_Size_Clause (FST)));
       else
          P_Size := Esize (FST);
@@ -491,13 +492,37 @@ package body Exp_Strm is
       --  Floating point types
 
       elsif Is_Floating_Point_Type (U_Type) then
-         if P_Size <= Standard_Short_Float_Size then
+
+         --  Question: should we use P_Size or Rt_Type to distinguish between
+         --  possible floating point types? If a non-standard size or a stream
+         --  size is specified, then we should certainly use the size. But if
+         --  we have two types the same (notably Short_Float_Size = Float_Size
+         --  which is close to universally true, and Long_Long_Float_Size =
+         --  Long_Float_Size, true on most targets except the x86), then we
+         --  would really rather use the root type, so that if people want to
+         --  fiddle with System.Stream_Attributes to get inter-target portable
+         --  streams, they get the size they expect. Consider in particular the
+         --  case of a stream written on an x86, with 96-bit Long_Long_Float
+         --  being read into a non-x86 target with 64 bit Long_Long_Float. A
+         --  special version of System.Stream_Attributes can deal with this
+         --  provided the proper type is always used.
+
+         --  To deal with these two requirements we add the special checks
+         --  on equal sizes and use the root type to distinguish.
+
+         if P_Size <= Standard_Short_Float_Size
+           and then (Standard_Short_Float_Size /= Standard_Float_Size
+                     or else Rt_Type = Standard_Short_Float)
+         then
             Lib_RE := RE_I_SF;
 
          elsif P_Size <= Standard_Float_Size then
             Lib_RE := RE_I_F;
 
-         elsif P_Size <= Standard_Long_Float_Size then
+         elsif P_Size <= Standard_Long_Float_Size
+           and then (Standard_Long_Float_Size /= Standard_Long_Long_Float_Size
+                       or else Rt_Type = Standard_Float)
+         then
             Lib_RE := RE_I_LF;
 
          else
@@ -644,7 +669,7 @@ package body Exp_Strm is
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
 
-      if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then
+      if Has_Stream_Size_Clause (FST) then
          P_Size := Static_Integer (Expression (Stream_Size_Clause (FST)));
       else
          P_Size := Esize (FST);
@@ -681,12 +706,39 @@ package body Exp_Strm is
       --  Floating point types
 
       elsif Is_Floating_Point_Type (U_Type) then
-         if P_Size <= Standard_Short_Float_Size then
+
+         --  Question: should we use P_Size or Rt_Type to distinguish between
+         --  possible floating point types? If a non-standard size or a stream
+         --  size is specified, then we should certainly use the size. But if
+         --  we have two types the same (notably Short_Float_Size = Float_Size
+         --  which is close to universally true, and Long_Long_Float_Size =
+         --  Long_Float_Size, true on most targets except the x86), then we
+         --  would really rather use the root type, so that if people want to
+         --  fiddle with System.Stream_Attributes to get inter-target portable
+         --  streams, they get the size they expect. Consider in particular the
+         --  case of a stream written on an x86, with 96-bit Long_Long_Float
+         --  being read into a non-x86 target with 64 bit Long_Long_Float. A
+         --  special version of System.Stream_Attributes can deal with this
+         --  provided the proper type is always used.
+
+         --  To deal with these two requirements we add the special checks
+         --  on equal sizes and use the root type to distinguish.
+
+         if P_Size <= Standard_Short_Float_Size
+           and then (Standard_Short_Float_Size /= Standard_Float_Size
+                      or else Rt_Type = Standard_Short_Float)
+         then
             Lib_RE := RE_W_SF;
+
          elsif P_Size <= Standard_Float_Size then
             Lib_RE := RE_W_F;
-         elsif P_Size <= Standard_Long_Float_Size then
+
+         elsif P_Size <= Standard_Long_Float_Size
+           and then (Standard_Long_Float_Size /= Standard_Long_Long_Float_Size
+                      or else Rt_Type = Standard_Float)
+         then
             Lib_RE := RE_W_LF;
+
          else
             Lib_RE := RE_W_LLF;
          end if;
@@ -713,6 +765,8 @@ package body Exp_Strm is
       --     type W is range -1 .. +254;
       --     for W'Size use 8;
 
+      --  forcing a biased and unsigned representation
+
       elsif not Is_Unsigned_Type (FST)
         and then
           (Is_Fixed_Point_Type (U_Type)
@@ -1378,12 +1432,15 @@ package body Exp_Strm is
             --  Loop through components, skipping all internal components,
             --  which are not part of the value (e.g. _Tag), except that we
             --  don't skip the _Parent, since we do want to process that
-            --  recursively.
+            --  recursively. If _Parent is an interface type, being abstract
+            --  with no components there is no need to handle it.
 
             while Present (Item) loop
                if Nkind (Item) = N_Component_Declaration
                  and then
-                   (Chars (Defining_Identifier (Item)) = Name_uParent
+                   ((Chars (Defining_Identifier (Item)) = Name_uParent
+                       and then not Is_Interface
+                                      (Etype (Defining_Identifier (Item))))
                      or else
                     not Is_Internal_Name (Chars (Defining_Identifier (Item))))
                then
@@ -1586,13 +1643,20 @@ package body Exp_Strm is
    -----------------------------
 
    function Has_Stream_Standard_Rep (U_Type : Entity_Id) return Boolean is
+      Siz : Uint;
+
    begin
       if Has_Non_Standard_Rep (U_Type) then
          return False;
+      end if;
+
+      if Has_Stream_Size_Clause (U_Type) then
+         Siz := Static_Integer (Expression (Stream_Size_Clause (U_Type)));
       else
-         return
-           Esize (First_Subtype (U_Type)) = Esize (Root_Type (U_Type));
+         Siz := Esize (First_Subtype (U_Type));
       end if;
+
+      return Siz = Esize (Root_Type (U_Type));
    end Has_Stream_Standard_Rep;
 
    ---------------------------------


More information about the Gcc-patches mailing list