[multiple changes]

2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Add_Inlined_Body): Adjust check for library-level inlined
	functions to previous change.  Reorganize code slightly.

2011-08-02  Geert Bosch  <bosch@adacore.com>

	* back_end.ads (Register_Type_Proc): New call back procedure type for
	allowing the back end to provide information about available types.
	(Register_Back_End_Types): New procedure to register back end types.
	* back_end.adb (Register_Back_End_Types): Call the back end to enumerate
	available types.
	* cstand.adb (Back_End_Float_Types): New list for floating point types
	supported by the back end.
	(Build_Float_Type): Add extra parameter for Float_Rep_Kind.
	(Copy_Float_Type): New procedure to make new copies of predefined types.
	(Register_Float_Type): New call back procedure to populate the BEFT list
	(Find_Back_End_Float_Type): New procedure to find a BEFT by name
	(Create_Back_End_Float_Types): New procedure to populate the BEFT list.
	(Create_Float_Types): New procedure to create entities for floating
	point types predefined in Standard, and put these and any remaining
	BEFTs on the Predefined_Float_Types list.
	* stand.ads (Predefined_Float_Types): New list for predefined floating
	point types that do not have declarations in package Standard.

From-SVN: r177137
This commit is contained in:
Arnaud Charlet 2011-08-02 14:36:58 +02:00
parent feecad6893
commit f8726f2b03
6 changed files with 298 additions and 61 deletions

View File

@ -1,3 +1,28 @@
2011-08-02 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Add_Inlined_Body): Adjust check for library-level inlined
functions to previous change. Reorganize code slightly.
2011-08-02 Geert Bosch <bosch@adacore.com>
* back_end.ads (Register_Type_Proc): New call back procedure type for
allowing the back end to provide information about available types.
(Register_Back_End_Types): New procedure to register back end types.
* back_end.adb (Register_Back_End_Types): Call the back end to enumerate
available types.
* cstand.adb (Back_End_Float_Types): New list for floating point types
supported by the back end.
(Build_Float_Type): Add extra parameter for Float_Rep_Kind.
(Copy_Float_Type): New procedure to make new copies of predefined types.
(Register_Float_Type): New call back procedure to populate the BEFT list
(Find_Back_End_Float_Type): New procedure to find a BEFT by name
(Create_Back_End_Float_Types): New procedure to populate the BEFT list.
(Create_Float_Types): New procedure to create entities for floating
point types predefined in Standard, and put these and any remaining
BEFTs on the Predefined_Float_Types list.
* stand.ads (Predefined_Float_Types): New list for predefined floating
point types that do not have declarations in package Standard.
2011-08-02 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Get_Code_Unit_Entity): New local function. Returns the

View File

@ -325,4 +325,16 @@ package body Back_End is
Next_Arg := Next_Arg + 1;
end loop;
end Scan_Compiler_Arguments;
-----------------------------
-- Register_Back_End_Types --
-----------------------------
procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
pragma Import (C, Enumerate_Modes, "enumerate_modes");
begin
Enumerate_Modes (Call_Back);
end Register_Back_End_Types;
end Back_End;

View File

@ -26,6 +26,8 @@
-- Call the back end with all the information needed. Also contains other
-- back-end specific interfaces required by the front end.
with Einfo; use Einfo;
package Back_End is
type Back_End_Mode_Type is (
@ -44,6 +46,25 @@ package Back_End is
pragma Convention (C, Back_End_Mode_Type);
for Back_End_Mode_Type use (0, 1, 2);
type C_String is array (0 .. 255) of aliased Character;
pragma Convention (C, C_String);
type Register_Type_Proc is access procedure
(C_Name : C_String; -- Nul-terminated string with name of type
Digs : Natural; -- Nr or digits for floating point, 0 otherwise
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
Size : Positive; -- Size of representation in bits
Alignment : Natural); -- Required alignment in bits
pragma Convention (C, Register_Type_Proc);
-- Call back procedure for Register_Back_End_Types. This is to be used by
-- Create_Standard to create predefined types for all types supported by
-- the back end.
procedure Register_Back_End_Types (Call_Back : Register_Type_Proc);
-- Calls the Call_Back function with information for each supported type.
procedure Call_Back_End (Mode : Back_End_Mode_Type);
-- Call back end, i.e. make call to driver traversing the tree and
-- outputting code. This call is made with all tables locked.

View File

@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Back_End; use Back_End;
with Csets; use Csets;
with Debug; use Debug;
with Einfo; use Einfo;
@ -51,14 +52,25 @@ package body CStand is
Staloc : constant Source_Ptr := Standard_ASCII_Location;
-- Standard abbreviations used throughout this package
Back_End_Float_Types : List_Id := No_List;
-- 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.
-----------------------
-- Local Subprograms --
-----------------------
procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);
procedure Build_Float_Type
(E : Entity_Id;
Siz : Int;
Rep : Float_Rep_Kind;
Digs : Int);
-- Procedure to build standard predefined float base type. The first
-- parameter is the entity for the type, and the second parameter
-- is the size in bits. The third parameter is the digits value.
-- parameter is the entity for the type, and the second parameter is the
-- size in bits. The third parameter indicates the kind of representation
-- to be used. The fourth parameter is the digits value. Each type
-- is added to the list of predefined floating point types.
procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);
-- Procedure to build standard predefined signed integer subtype. The
@ -66,6 +78,11 @@ package body CStand is
-- is the size in bits. The corresponding base type is not built by
-- this routine but instead must be built by the caller where needed.
procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id);
-- Build a floating point type, copying representation details from From.
-- This is used to create predefined floating point types based on
-- available types in the back end.
procedure Create_Operators;
-- Make entries for each of the predefined operators in Standard
@ -89,6 +106,12 @@ package body CStand is
-- bounds, but do not statically match, since a subtype with constraints
-- never matches a subtype with no constraints.
function Find_Back_End_Float_Type (Name : String) return Entity_Id;
-- Return the first float type in Back_End_Float_Types with the given name.
-- Names of entities in back end types, are either type names of C
-- predefined types (all lower case), or mode names (upper case).
-- These are not generally valid identifier names.
function Identifier_For (S : Standard_Entity_Type) return Node_Id;
-- Returns an identifier node with the same name as the defining
-- identifier corresponding to the given Standard_Entity_Type value
@ -121,6 +144,20 @@ package body CStand is
procedure Print_Standard;
-- Print representation of package Standard if switch set
procedure Register_Float_Type
(Name : C_String; -- Nul-terminated string with name of type
Digs : Natural; -- Nr or digits for floating point, 0 otherwise
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
Size : Positive; -- Size of representation in bits
Alignment : Natural); -- Required alignment in bits
pragma Convention (C, Register_Float_Type);
-- Call back to allow the back end to register available types.
-- This call back currently creates predefined floating point base types
-- for any floating point types reported by the back end, and adds them
-- to the list of predefined float types.
procedure Set_Integer_Bounds
(Id : Entity_Id;
Typ : Entity_Id;
@ -135,7 +172,12 @@ package body CStand is
-- Build_Float_Type --
----------------------
procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int) is
procedure Build_Float_Type
(E : Entity_Id;
Siz : Int;
Rep : Float_Rep_Kind;
Digs : Int)
is
begin
Set_Type_Definition (Parent (E),
Make_Floating_Point_Definition (Stloc,
@ -143,13 +185,7 @@ package body CStand is
Set_Ekind (E, E_Floating_Point_Type);
Set_Etype (E, E);
if AAMP_On_Target then
Set_Float_Rep (E, AAMP);
else
Set_Float_Rep (E, IEEE_Binary);
end if;
Set_Float_Rep (E, Rep);
Init_Size (E, Siz);
Set_Elem_Alignment (E);
Init_Digits_Value (E, Digs);
@ -159,6 +195,21 @@ package body CStand is
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);
begin
while Present (N) and then Get_Name_String (Chars (N)) /= Name loop
Next (N);
end loop;
return Entity_Id (N);
end Find_Back_End_Float_Type;
-------------------------------
-- Build_Signed_Integer_Type --
-------------------------------
@ -185,6 +236,16 @@ package body CStand is
Set_Size_Known_At_Compile_Time (E);
end Build_Signed_Integer_Type;
---------------------
-- Copy_Float_Type --
---------------------
procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id) is
begin
Build_Float_Type (To, UI_To_Int (Esize (From)), Float_Rep (From),
UI_To_Int (Digits_Value (From)));
end Copy_Float_Type;
----------------------
-- Create_Operators --
----------------------
@ -306,10 +367,11 @@ package body CStand is
-- The tree for the package Standard is prefixed to all compilations.
-- Several entities required by semantic analysis are denoted by global
-- variables that are initialized to point to the corresponding
-- occurrences in STANDARD. The visible entities of STANDARD are
-- created here. The private entities defined in STANDARD are created
-- by Initialize_Standard in the semantics module.
-- variables that are initialized to point to the corresponding occurrences
-- in Standard. The visible entities of Standard are created here. Special
-- entities maybe created here as well or may be created from the semantics
-- module. By not adding them to the Decls list of Standard they will not
-- be visible to Ada programs.
procedure Create_Standard is
Decl_S : constant List_Id := New_List;
@ -330,6 +392,14 @@ package body CStand is
procedure Build_Exception (S : Standard_Entity_Type);
-- Procedure to declare given entity as an exception
procedure Create_Back_End_Float_Types;
-- Initialize the Back_End_Float_Types list by having the back end
-- enumerate all available types and building type entities for them.
procedure Create_Float_Types;
-- Creates entities for all predefined floating point types, and
-- adds these to the Predefined_Float_Types list in package Standard.
procedure Pack_String_Type (String_Type : Entity_Id);
-- Generate proper tree for pragma Pack that applies to given type, and
-- mark type as having the pragma.
@ -351,6 +421,78 @@ package body CStand is
Append (Decl, Decl_S);
end Build_Exception;
---------------------------
-- Create_Back_End_Float_Types --
---------------------------
procedure Create_Back_End_Float_Types is
begin
Back_End_Float_Types := No_List;
Register_Back_End_Types (Register_Float_Type'Access);
end Create_Back_End_Float_Types;
------------------------
-- Create_Float_Types --
------------------------
procedure Create_Float_Types is
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_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);
-- ??? 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;
LF_Digs : constant Pos :=
UI_To_Int (Digits_Value (Standard_Long_Float));
LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
N : Node_Id := First (Back_End_Float_Types);
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
LLF := Standard_Long_Float;
end if;
Copy_Float_Type (Standard_Long_Long_Float, LLF);
Append (Standard_Long_Long_Float, Predefined_Float_Types);
end;
Append_List (Back_End_Float_Types, To => Predefined_Float_Types);
end Create_Float_Types;
----------------------
-- Pack_String_Type --
----------------------
@ -431,6 +573,8 @@ package body CStand is
Append (Decl, Decl_S);
end loop;
Create_Back_End_Float_Types;
-- Create type definition node for type Boolean. The Size is set to
-- 1 as required by Ada 95 and current ARG interpretations for Ada/83.
@ -539,27 +683,7 @@ package body CStand is
Create_Unconstrained_Base_Type
(Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
-- Create type definition nodes for predefined float types
Build_Float_Type
(Standard_Short_Float,
Standard_Short_Float_Size,
Standard_Short_Float_Digits);
Build_Float_Type
(Standard_Float,
Standard_Float_Size,
Standard_Float_Digits);
Build_Float_Type
(Standard_Long_Float,
Standard_Long_Float_Size,
Standard_Long_Float_Digits);
Build_Float_Type
(Standard_Long_Long_Float,
Standard_Long_Long_Float_Size,
Standard_Long_Long_Float_Digits);
Create_Float_Types;
-- Create type definition node for type Character. Note that we do not
-- set the Literals field, since type Character is handled with special
@ -1209,10 +1333,7 @@ package body CStand is
Set_Defining_Identifier (Decl, Universal_Real);
Make_Name (Universal_Real, "universal_real");
Set_Scope (Universal_Real, Standard_Standard);
Build_Float_Type
(Universal_Real,
Standard_Long_Long_Float_Size,
Standard_Long_Long_Float_Digits);
Copy_Float_Type (Universal_Real, Standard_Long_Long_Float);
-- Note: universal fixed, unlike universal integer and universal real,
-- is never used at runtime, so it does not need to have bounds set.
@ -1874,6 +1995,53 @@ package body CStand is
P ("end Standard;");
end Print_Standard;
-------------------------
-- Register_Float_Type --
-------------------------
procedure Register_Float_Type
(Name : C_String;
Digs : Natural;
Complex : Boolean;
Count : Natural;
Float_Rep : Float_Rep_Kind;
Size : Positive;
Alignment : Natural)
is
Last : Natural := Name'First - 1;
begin
for J in Name'Range loop
if Name (J) = ASCII.NUL then
Last := J - 1;
exit;
end if;
end loop;
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)));
Set_Scope (Ent, Standard_Standard);
Build_Float_Type (Ent, Esize, Float_Rep, Pos (Digs));
Set_RM_Size (Ent, UI_From_Int (Int (Size)));
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);
end if;
end;
end if;
end Register_Float_Type;
----------------------
-- Set_Float_Bounds --
----------------------

View File

@ -236,7 +236,6 @@ package body Inline is
----------------------
procedure Add_Inlined_Body (E : Entity_Id) is
Pack : Entity_Id;
function Must_Inline return Boolean;
-- Inlining is only done if the call statement N is in the main unit,
@ -318,35 +317,39 @@ package body Inline is
-- no enclosing package to retrieve. In this case, it is the body of
-- the function that will have to be loaded.
if not Is_Abstract_Subprogram (E) and then not Is_Nested (E)
if not Is_Abstract_Subprogram (E)
and then not Is_Nested (E)
and then Convention (E) /= Convention_Protected
and then Must_Inline
then
Pack := Get_Code_Unit_Entity (E);
declare
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
if Must_Inline
and then Ekind (Pack) = E_Package
then
Set_Is_Called (E);
if Pack = Standard_Standard then
begin
if Pack = E then
-- Library-level inlined function. Add function itself to
-- list of needed units.
Set_Is_Called (E);
Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
elsif Is_Generic_Instance (Pack) then
null;
elsif Ekind (Pack) = E_Package then
Set_Is_Called (E);
elsif not Is_Inlined (Pack)
and then not Has_Completion (E)
then
Set_Is_Inlined (Pack);
Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
if Is_Generic_Instance (Pack) then
null;
elsif not Is_Inlined (Pack)
and then not Has_Completion (E)
then
Set_Is_Inlined (Pack);
Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
end if;
end if;
end if;
end;
end if;
end Add_Inlined_Body;

View File

@ -229,9 +229,9 @@ package Stand is
type Standard_Entity_Array_Type is array (Standard_Entity_Type) of Node_Id;
Standard_Entity : Standard_Entity_Array_Type;
-- This array contains pointers to the Defining Identifier nodes
-- for each of the entities defined in Standard_Entities_Type. It
-- is initialized by the Create_Standard procedure.
-- This array contains pointers to the Defining Identifier nodes for
-- each of the visible entities defined in Standard_Entities_Type. It is
-- initialized by the Create_Standard procedure.
Standard_Package_Node : Node_Id;
-- Points to the N_Package_Declaration node for standard. Also
@ -343,6 +343,14 @@ package Stand is
-- A zero-size subtype of Integer, used as the type of variables used
-- to provide the debugger with name encodings for renaming declarations.
Predefined_Float_Types : List_Id;
-- Entities for predefined floating point types. These are used by
-- the semantic phase to select appropriate types for floating point
-- declarations. This list is ordered by preference. All types up to
-- Long_Long_Float_Type are considered for plain "digits N" declarations,
-- while selection of later types requires a range specification and
-- possibly other attributes or pragmas.
-- The entities labeled Any_xxx are used in situations where the full
-- characteristics of an entity are not yet known, e.g. Any_Character
-- is used to label a character literal before resolution is complete.