The internal tree nodes for the standard Ada floating point types are
derived from back-end information provided via a type registration hook.
 
The registration is performed by the set_targ elaboration code, constructing
the FPT_Mode_Table which cstand.Create_Standard scans later on to construct
front-end type nodes.
 
But downstream within the compiler, the Standard type nodes aren't the only
source of information regarding floating point types: the ttypes package is
also used for this purpose in many places.
 
The two sources of information (ttypes' exposed values and attributes in tree
nodes for standard floating types) have to agree. A range of bad things might
happen otherwise.
 
Now it turns out that the Set_Targ functions used to initialize ttypes for
floating point values don't use the FPT_Mode_Table at all. They resort to gigi
functions conveying back-end attributes instead.
 
Keeping the two in sync is a pain, in particular when it comes to
Long_Long_Float. The gigi code resorts to the WIDEST_HARDWARE_FP_SIZE macro
which is not so well defined, and the get_target_long_double_size function
doesn't compute what the name implies.
 
This patch is a first step towards fixing this by providing a common ground to
initialize both ttypes and the front-end nodes from the FPT_Mode_Table.
 
The basic idea is to generalize what cstand.Create_Float_Types does: refer to
specific C (back-end) types to initialize the Ada type nodes. 

No functional change. This allows removing code in gigi, which will be done
as a separate patch.

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-01-06  Olivier Hainque  <hain...@adacore.com>

        * set_targ.ads (C_Type_For): New function. Return the name of
        a C type supported by the back-end and suitable as a basis to
        construct the standard Ada floating point type identified by
        the T parameter. This is used as a common ground to feed both
        ttypes values and the GNAT tree nodes for the standard floating
        point types.
        * set_targ.adb (Long_Double_Index): The index at which "long
        double" gets registered in the FPT_Mode_Table. This is useful to
        know whether we have a "long double" available at all and get at
        it's characteristics without having to search the FPT_Mode_Table
        when we need to decide which C type should be used as the
        basis for Long_Long_Float in Ada.
        (Register_Float_Type): Fill Long_Double_Index.
        (FPT_Mode_Index_For): New function. Return the index in
        FPT_Mode_Table that designates the entry corresponding to the
        provided C type name.
        (FPT_Mode_Index_For): New function. Return the index in
        FPT_Mode_Table that designates the entry for a back-end type
        suitable as a basis to construct the standard Ada floating point
        type identified by the input T parameter.
        (elaboration code): Register_Back_End_Types unconditionally,
        so C_Type_For can operate regardless of -gnateT. Do it
        early so we can query it for the floating point sizes, via
        FPT_Mode_Index_For. Initialize Float_Size, Double_Size and
        Long_Double_Size from the FPT_Mode_Table, as cstand will do.
        * cstand.adb (Create_Float_Types): Use C_Type_For to determine
        which C type should be used as the basis for the construction
        of the Standard Ada floating point types.
        * get_targ.ads (Get_Float_Size, Get_Double_Size,
        Get_Long_Double_Size): Remove.
        * get_targ.adb: Likewise.

Index: get_targ.adb
===================================================================
--- get_targ.adb        (revision 219191)
+++ get_targ.adb        (working copy)
@@ -126,42 +126,6 @@
       return C_Get_Long_Long_Size;
    end Get_Long_Long_Size;
 
-   --------------------
-   -- Get_Float_Size --
-   --------------------
-
-   function Get_Float_Size return Pos is
-      function C_Get_Float_Size return Pos;
-      pragma Import (C, C_Get_Float_Size,
-                        "get_target_float_size");
-   begin
-      return C_Get_Float_Size;
-   end Get_Float_Size;
-
-   ---------------------
-   -- Get_Double_Size --
-   ---------------------
-
-   function Get_Double_Size return Pos is
-      function C_Get_Double_Size return Pos;
-      pragma Import (C, C_Get_Double_Size,
-                        "get_target_double_size");
-   begin
-      return C_Get_Double_Size;
-   end Get_Double_Size;
-
-   --------------------------
-   -- Get_Long_Double_Size --
-   --------------------------
-
-   function Get_Long_Double_Size return Pos is
-      function C_Get_Long_Double_Size return Pos;
-      pragma Import (C, C_Get_Long_Double_Size,
-                        "get_target_long_double_size");
-   begin
-      return C_Get_Long_Double_Size;
-   end Get_Long_Double_Size;
-
    ----------------------
    -- Get_Pointer_Size --
    ----------------------
Index: get_targ.ads
===================================================================
--- get_targ.ads        (revision 219191)
+++ get_targ.ads        (working copy)
@@ -68,15 +68,6 @@
    function Get_Long_Long_Size             return Pos;
    --  Size of Standard.Long_Long_Integer
 
-   function Get_Float_Size                 return Pos;
-   --  Size of Standard.Float
-
-   function Get_Double_Size                return Pos;
-   --  Size of Standard.Long_Float
-
-   function Get_Long_Double_Size           return Pos;
-   --  Size of Standard.Long_Long_Float
-
    function Get_Pointer_Size               return Pos;
    --  Size of System.Address
 
Index: cstand.adb
===================================================================
--- cstand.adb  (revision 219191)
+++ cstand.adb  (working copy)
@@ -504,46 +504,27 @@
 
          Copy_Float_Type
            (Standard_Short_Float,
-            Find_Back_End_Float_Type ("float"));
+            Find_Back_End_Float_Type (C_Type_For (S_Short_Float)));
          Set_Is_Implementation_Defined (Standard_Short_Float);
 
          Copy_Float_Type (Standard_Float, Standard_Short_Float);
 
-         Copy_Float_Type (Standard_Long_Float,
-           Find_Back_End_Float_Type ("double"));
+         Copy_Float_Type
+           (Standard_Long_Float,
+            Find_Back_End_Float_Type (C_Type_For (S_Long_Float)));
 
+         Copy_Float_Type
+           (Standard_Long_Long_Float,
+            Find_Back_End_Float_Type (C_Type_For (S_Long_Long_Float)));
+         Set_Is_Implementation_Defined (Standard_Long_Long_Float);
+
          Predefined_Float_Types := New_Elmt_List;
+
          Append_Elmt (Standard_Short_Float, Predefined_Float_Types);
          Append_Elmt (Standard_Float, Predefined_Float_Types);
          Append_Elmt (Standard_Long_Float, Predefined_Float_Types);
+         Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
 
-         --  ??? For now, we don't have a good way to tell the widest float
-         --  type with hardware support. Basically, GCC knows the size of that
-         --  type, but on x86-64 there often are two or three 128-bit types,
-         --  one double extended that has 18 decimal digits, a 128-bit quad
-         --  precision type with 33 digits and possibly a 128-bit decimal float
-         --  type with 34 digits. As a workaround, we define Long_Long_Float as
-         --  C's "long double" if that type exists and has at most 18 digits,
-         --  or otherwise the same as Long_Float.
-
-         declare
-            Max_HW_Digs : constant := 18;
-            --  Maximum hardware digits supported
-
-            LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
-            --  Entity for long double type
-
-         begin
-            if No (LLF) or else Digits_Value (LLF) > Max_HW_Digs then
-               LLF := Standard_Long_Float;
-            end if;
-
-            Set_Is_Implementation_Defined (Standard_Long_Long_Float);
-            Copy_Float_Type (Standard_Long_Long_Float, LLF);
-
-            Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
-         end;
-
          --  Any other back end types are appended at the end of the list of
          --  predefined float types, and will only be selected if the none of
          --  the types in Standard is suitable, or if a specific named type is
Index: set_targ.adb
===================================================================
--- set_targ.adb        (revision 219191)
+++ set_targ.adb        (working copy)
@@ -159,9 +159,65 @@
    --  floating-point type, and Precision, Size and Alignment are the precision
    --  size and alignment in bits.
    --
-   --  So to summarize, the only types that are actually registered have Digs
-   --  non-zero, Complex zero (false), and Count zero (not a vector).
+   --  The only types that are actually registered have Digs non-zero, Complex
+   --  zero (false), and Count zero (not a vector). The Long_Double_Index
+   --  variable below is updated to indicate the index at which a "long double"
+   --  type can be found if it gets registered at all.
 
+   Long_Double_Index : Integer := -1;
+   --  Once all the back-end types have been registered, the index in
+   --  FPT_Mode_Table at which "long double" can be found, if anywhere. A
+   --  negative value means that no "long double" has been registered. This
+   --  is useful to know whether we have a "long double" available at all and
+   --  get at it's characteristics without having to search the FPT_Mode_Table
+   --  when we need to decide which C type should be used as the basis for
+   --  Long_Long_Float in Ada.
+
+   function FPT_Mode_Index_For (Name : String) return Natural;
+   --  Return the index in FPT_Mode_Table that designates the entry
+   --  corresponding to the C type named Name. Raise Program_Error if
+   --  there is no such entry.
+
+   function FPT_Mode_Index_For (T : S_Float_Types) return Natural;
+   --  Return the index in FPT_Mode_Table that designates the entry for
+   --  a back-end type suitable as a basis to construct the standard Ada
+   --  floating point type identified by T.
+
+   ----------------
+   -- C_Type_For --
+   ----------------
+
+   function C_Type_For (T : S_Float_Types) return String is
+
+      --  ??? For now, we don't have a good way to tell the widest float
+      --  type with hardware support. Basically, GCC knows the size of that
+      --  type, but on x86-64 there often are two or three 128-bit types,
+      --  one double extended that has 18 decimal digits, a 128-bit quad
+      --  precision type with 33 digits and possibly a 128-bit decimal float
+      --  type with 34 digits. As a workaround, we define Long_Long_Float as
+      --  C's "long double" if that type exists and has at most 18 digits,
+      --  or otherwise the same as Long_Float.
+
+      Max_HW_Digs : constant := 18;
+      --  Maximum hardware digits supported
+
+   begin
+      case T is
+         when S_Short_Float | S_Float =>
+            return "float";
+         when S_Long_Float =>
+            return "double";
+         when S_Long_Long_Float =>
+            if Long_Double_Index >= 0
+              and then FPT_Mode_Table (Long_Double_Index).DIGS <= Max_HW_Digs
+            then
+               return "long double";
+            else
+               return "double";
+            end if;
+      end case;
+   end C_Type_For;
+
    ----------
    -- Fail --
    ----------
@@ -169,12 +225,33 @@
    procedure Fail (E : String) is
       E_Fatal : constant := 4;
       --  Code for fatal error
+
    begin
       Write_Str (E);
       Write_Eol;
       OS_Exit (E_Fatal);
    end Fail;
 
+   ------------------------
+   -- FPT_Mode_Index_For --
+   ------------------------
+
+   function FPT_Mode_Index_For (Name : String) return Natural is
+   begin
+      for J in FPT_Mode_Table'First .. Num_FPT_Modes loop
+         if FPT_Mode_Table (J).NAME.all = Name then
+            return J;
+         end if;
+      end loop;
+
+      raise Program_Error;
+   end FPT_Mode_Index_For;
+
+   function FPT_Mode_Index_For (T : S_Float_Types) return Natural is
+   begin
+      return FPT_Mode_Index_For (C_Type_For (T));
+   end FPT_Mode_Index_For;
+
    -------------------------
    -- Register_Float_Type --
    -------------------------
@@ -281,14 +358,23 @@
       --  Acquire entry if non-vector non-complex fpt type (digits non-zero)
 
       if Digs > 0 and then not Complex and then Count = 0 then
-         Num_FPT_Modes := Num_FPT_Modes + 1;
-         FPT_Mode_Table (Num_FPT_Modes) :=
-           (NAME      => new String'(T (1 .. Last)),
-            DIGS      => Digs,
-            FLOAT_REP => Float_Rep,
-            PRECISION => Precision,
-            SIZE      => Size,
-            ALIGNMENT => Alignment);
+
+         declare
+            This_Name : constant String := T (1 .. Last);
+         begin
+            Num_FPT_Modes := Num_FPT_Modes + 1;
+            FPT_Mode_Table (Num_FPT_Modes) :=
+              (NAME      => new String'(This_Name),
+               DIGS      => Digs,
+               FLOAT_REP => Float_Rep,
+               PRECISION => Precision,
+               SIZE      => Size,
+               ALIGNMENT => Alignment);
+
+            if Long_Double_Index < 0 and then This_Name = "long double" then
+               Long_Double_Index := Num_FPT_Modes;
+            end if;
+         end;
       end if;
    end Register_Float_Type;
 
@@ -801,6 +887,13 @@
       end loop;
    end;
 
+   --  Register floating-point types from the back end. We do this
+   --  unconditionally so C_Type_For may be called regardless of -gnateT, for
+   --  which cstand has a use, and early so we can use FPT_Mode_Table below to
+   --  compute some FP attributes.
+
+   Register_Back_End_Types (Register_Float_Type'Access);
+
    --  Case of reading the target dependent values from file
 
    --  This is bit more complex than might be expected, because it has to be
@@ -832,11 +925,8 @@
             Char_Size                  := Get_Char_Size;
             Double_Float_Alignment     := Get_Double_Float_Alignment;
             Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
-            Double_Size                := Get_Double_Size;
-            Float_Size                 := Get_Float_Size;
             Float_Words_BE             := Get_Float_Words_BE;
             Int_Size                   := Get_Int_Size;
-            Long_Double_Size           := Get_Long_Double_Size;
             Long_Long_Size             := Get_Long_Long_Size;
             Long_Size                  := Get_Long_Size;
             Maximum_Alignment          := Get_Maximum_Alignment;
@@ -849,9 +939,29 @@
             Wchar_T_Size               := Get_Wchar_T_Size;
             Words_BE                   := Get_Words_BE;
 
-            --  Register floating-point types from the back end
+            --  Compute the sizes of floating point types
 
-            Register_Back_End_Types (Register_Float_Type'Access);
+            declare
+               T : FPT_Mode_Entry renames
+                 FPT_Mode_Table (FPT_Mode_Index_For (S_Float));
+            begin
+               Float_Size := Int (T.SIZE);
+            end;
+
+            declare
+               T : FPT_Mode_Entry renames
+                 FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float));
+            begin
+               Double_Size := Int (T.SIZE);
+            end;
+
+            declare
+               T : FPT_Mode_Entry renames
+                 FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float));
+            begin
+               Long_Double_Size := Int (T.SIZE);
+            end;
+
          end if;
       end;
    end if;
Index: set_targ.ads
===================================================================
--- set_targ.ads        (revision 219191)
+++ set_targ.ads        (working copy)
@@ -37,6 +37,7 @@
 --  size of wchar_t, since this corresponds to expected Ada usage.
 
 with Einfo; use Einfo;
+with Stand; use Stand;
 with Types; use Types;
 
 package Set_Targ is
@@ -107,6 +108,15 @@
    -- Subprograms --
    -----------------
 
+   subtype S_Float_Types is
+     Standard_Entity_Type range S_Short_Float .. S_Long_Long_Float;
+
+   function C_Type_For (T : S_Float_Types) return String;
+   --  Return the name of a C type supported by the back-end and suitable as
+   --  a basis to construct the standard Ada floating point type identified by
+   --  T. This is used as a common ground to feed both ttypes values and the
+   --  GNAT tree nodes for the standard floating point types.
+
    procedure Write_Target_Dependent_Values;
    --  This routine writes the file target.atp in the current directory with
    --  the values of the global target parameters as listed above, and as set

Reply via email to