-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
with Csets; use Csets;
with Debug; use Debug;
with Einfo; use Einfo;
+with Elists; use Elists;
with Layout; use Layout;
with Namet; use Namet;
with Nlists; use Nlists;
Staloc : constant Source_Ptr := Standard_ASCII_Location;
-- Standard abbreviations used throughout this package
- Back_End_Float_Types : List_Id := No_List;
+ Back_End_Float_Types : Elist_Id := No_Elist;
-- List used for any floating point supported by the back end. This needs
-- to be at the library level, because the call back procedures retrieving
-- this information are at that level.
Complex : Boolean; -- True iff type has real and imaginary parts
Count : Natural; -- Number of elements in vector, 0 otherwise
Float_Rep : Float_Rep_Kind; -- Representation used for fpt type
+ Precision : Positive; -- Precision of representation in bits
Size : Positive; -- Size of representation in bits
Alignment : Natural); -- Required alignment in bits
pragma Convention (C, Register_Float_Type);
Set_Size_Known_At_Compile_Time (E);
end Build_Float_Type;
- ------------------------
+ ------------------------------
-- Find_Back_End_Float_Type --
- ------------------------
+ ------------------------------
function Find_Back_End_Float_Type (Name : String) return Entity_Id is
- N : Node_Id := First (Back_End_Float_Types);
+ N : Elmt_Id;
begin
- while Present (N) and then Get_Name_String (Chars (N)) /= Name loop
- Next (N);
+ N := First_Elmt (Back_End_Float_Types);
+ while Present (N) and then Get_Name_String (Chars (Node (N))) /= Name
+ loop
+ Next_Elmt (N);
end loop;
- return Entity_Id (N);
+ return Node (N);
end Find_Back_End_Float_Type;
-------------------------------
procedure Create_Back_End_Float_Types is
begin
- Back_End_Float_Types := No_List;
+ Back_End_Float_Types := No_Elist;
Register_Back_End_Types (Register_Float_Type'Access);
end Create_Back_End_Float_Types;
begin
-- Create type definition nodes for predefined float types
- Copy_Float_Type (Standard_Short_Float,
- Find_Back_End_Float_Type ("float"));
+ Copy_Float_Type
+ (Standard_Short_Float,
+ Find_Back_End_Float_Type ("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"));
- Predefined_Float_Types := New_List
- (Standard_Short_Float, Standard_Float, Standard_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);
-- ??? 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
declare
Max_HW_Digs : constant := 18;
- LF_Digs : constant Pos :=
- UI_To_Int (Digits_Value (Standard_Long_Float));
+ -- Maximum hardware digits supported
+
LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
- N : Node_Id := First (Back_End_Float_Types);
+ -- Entity for long double type
begin
- if Digits_Value (LLF) > Max_HW_Digs then
- LLF := Empty;
- end if;
-
- while No (LLF) and then Present (N) loop
- if UI_To_Int (Digits_Value (N)) in LF_Digs + 1 .. Max_HW_Digs
- and then Machine_Radix_Value (N) = Uint_2
- then
- LLF := N;
- end if;
-
- Next (N);
- end loop;
-
- if No (LLF) then
+ 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 (Standard_Long_Long_Float, Predefined_Float_Types);
+ Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
end;
- Append_List (Back_End_Float_Types, To => Predefined_Float_Types);
+ -- 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
+ -- requested through a pragma Import.
+
+ while not Is_Empty_Elmt_List (Back_End_Float_Types) loop
+ declare
+ E : constant Elmt_Id := First_Elmt (Back_End_Float_Types);
+ begin
+ Append_Elmt (Node (E), To => Predefined_Float_Types);
+ Remove_Elmt (Back_End_Float_Types, E);
+ end;
+ end loop;
end Create_Float_Types;
----------------------
Build_Signed_Integer_Type
(Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
+ Set_Is_Implementation_Defined (Standard_Long_Long_Integer);
Create_Unconstrained_Base_Type
(Standard_Short_Short_Integer, E_Signed_Integer_Subtype);
+ Set_Is_Implementation_Defined (Standard_Short_Short_Integer);
Create_Unconstrained_Base_Type
(Standard_Short_Integer, E_Signed_Integer_Subtype);
Create_Unconstrained_Base_Type
(Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
+ Set_Is_Implementation_Defined (Standard_Short_Short_Integer);
Create_Float_Types;
begin
-- In 32 bit mode, the size is 32 bits, and the delta and
- -- small values are set to 20 milliseconds (20.0**(10.0**(-3)).
+ -- small values are set to 20 milliseconds (20.0*(10.0**(-3)).
if Duration_32_Bits_On_Target then
Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
-- In standard 64-bit mode, the size is 64-bits and the delta and
- -- small values are set to nanoseconds (1.0**(10.0**(-9))
+ -- small values are set to nanoseconds (1.0*(10.0**(-9))
else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
begin
Ident_Node := New_Node (N_Identifier, Stloc);
Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
+ Set_Entity (Ident_Node, Standard_Entity (S));
return Ident_Node;
end Identifier_For;
Complex : Boolean;
Count : Natural;
Float_Rep : Float_Rep_Kind;
+ Precision : Positive;
Size : Positive;
Alignment : Natural)
is
- Last : Natural := Name'First - 1;
+ T : String (1 .. Name'Length);
+ Last : Natural := 0;
+
+ procedure Dump;
+ -- Dump information given by the back end for the type to register
+
+ procedure Dump is
+ begin
+ Write_Str ("type " & T (1 .. Last) & " is ");
+
+ if Count > 0 then
+ Write_Str ("array (1 .. ");
+ Write_Int (Int (Count));
+
+ if Complex then
+ Write_Str (", 1 .. 2");
+ end if;
+
+ Write_Str (") of ");
+
+ elsif Complex then
+ Write_Str ("array (1 .. 2) of ");
+ end if;
+
+ if Digs > 0 then
+ Write_Str ("digits ");
+ Write_Int (Int (Digs));
+ Write_Line (";");
+
+ Write_Str ("pragma Float_Representation (");
+
+ case Float_Rep is
+ when IEEE_Binary => Write_Str ("IEEE");
+ when VAX_Native =>
+ case Digs is
+ when 6 => Write_Str ("VAXF");
+ when 9 => Write_Str ("VAXD");
+ when 15 => Write_Str ("VAXG");
+ when others => Write_Str ("VAX_"); Write_Int (Int (Digs));
+ end case;
+ when AAMP => Write_Str ("AAMP");
+ end case;
+ Write_Line (", " & T & ");");
+
+ else
+ Write_Str ("mod 2**");
+ Write_Int (Int (Precision / Positive'Max (1, Count)));
+ Write_Line (";");
+ end if;
+
+ if Precision = Size then
+ Write_Str ("for " & T (1 .. Last) & "'Size use ");
+ Write_Int (Int (Size));
+ Write_Line (";");
+
+ else
+ Write_Str ("for " & T (1 .. Last) & "'Value_Size use ");
+ Write_Int (Int (Precision));
+ Write_Line (";");
+
+ Write_Str ("for " & T (1 .. Last) & "'Object_Size use ");
+ Write_Int (Int (Size));
+ Write_Line (";");
+ end if;
+
+ Write_Str ("for " & T & "'Alignment use ");
+ Write_Int (Int (Alignment / 8));
+ Write_Line (";");
+ end Dump;
begin
- for J in Name'Range loop
- if Name (J) = ASCII.NUL then
+ for J in T'Range loop
+ T (J) := Name (Name'First + J - 1);
+ if T (J) = ASCII.NUL then
Last := J - 1;
exit;
end if;
end loop;
+ if Debug_Flag_Dot_B then
+ Dump;
+ end if;
+
if Digs > 0 and then not Complex and then Count = 0 then
declare
Ent : constant Entity_Id := New_Standard_Entity;
- Esize : constant Pos := Pos ((Size + Alignment - 1)
- / Alignment * Alignment);
begin
Set_Defining_Identifier
(New_Node (N_Full_Type_Declaration, Stloc), Ent);
- Make_Name (Ent, String (Name (Name'First .. Last)));
+ Make_Name (Ent, T (1 .. Last));
Set_Scope (Ent, Standard_Standard);
- Build_Float_Type (Ent, Esize, Float_Rep, Pos (Digs));
- Set_RM_Size (Ent, UI_From_Int (Int (Size)));
+ Build_Float_Type (Ent, Int (Size), Float_Rep, Pos (Digs));
+ Set_RM_Size (Ent, UI_From_Int (Int (Precision)));
Set_Alignment (Ent, UI_From_Int (Int (Alignment / 8)));
if No (Back_End_Float_Types) then
- Back_End_Float_Types := New_List (Ent);
-
- else
- Append (Ent, Back_End_Float_Types);
+ Back_End_Float_Types := New_Elmt_List;
end if;
+
+ Append_Elmt (Ent, Back_End_Float_Types);
end;
end if;
end Register_Float_Type;