===================================================================
@@ -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 --
----------------------
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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;
===================================================================
@@ -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