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