-- For functions that are not inlined, there is no restriction on the body,
-- and XEINFO generates a direct reference in the C header file which allows
--- the C code in the backend to directly call the corresponding Ada body.
+-- the C code in the backend to directly call the corresponding Ada body.
----------------------------------
-- Handling of Type'Size Values --
-- generic entities before the corresponding generic body has been seen.
-- If a package has a forward instantiation, we cannot inline subprograms
-- appearing in the same package because the placement requirements of
--- the instance will conflict with the linear elaboration of front-end
+-- the instance will conflict with the linear elaboration of front-end
-- inlining.
-- Has_Fully_Qualified_Name (Flag173)
-- Is_Fixed_Point_Type (synthesized)
-- Applies to all entities, true for decimal and ordinary fixed
--- point types and subtypes
+-- point types and subtypes.
-- Is_Floating_Point_Type (synthesized)
-- Applies to all entities, true for float types and subtypes
-- Is_Invariant_Procedure (Flag257)
-- Defined in functions an procedures. Set for a generated invariant
--- procedure to identify it easily in the
+-- procedure to identify it easily in the.
-- Is_Itype (Flag91)
-- Defined in all entities. Set to indicate that a type is an Itype,
-- Is_Private_Type (synthesized)
-- Applies to all entities, true for private types and subtypes,
--- as well as for record with private types as subtypes
+-- as well as for record with private types as subtypes.
-- Is_Processed_Transient (Flag252)
-- Defined in variables, loop parameters, and constants, including the
-- Is_Record_Type (synthesized)
-- Applies to all entities, true for record types and subtypes,
--- includes class-wide types and subtypes (which are also records)
+-- includes class-wide types and subtypes (which are also records).
-- Is_Remote_Call_Interface (Flag62)
-- Defined in all entities. Set in E_Package and E_Generic_Package
-- vtable (i.e. the one to be extended by derivation).
-- Is_Tagged_Type (Flag55)
--- Defined in all entities. Set for an entity that is a tagged type.
+-- Defined in all entities. Set for an entity that is a tagged type
-- Is_Task_Interface (synthesized)
-- Defined in types that are interfaces. True if interface is declared as
-- access type, or if an explicit pragma No_Strict_Aliasing applies.
-- No_Tagged_Streams_Pragma (Node32)
--- Present in all subtype and type entities. Set for tagged types and
+-- Present in all subtype and type entities. Set for tagged types and
-- subtypes (i.e. entities with Is_Tagged_Type set True) if a valid
-- pragma/aspect applies to the type.
-- Parameter_Mode (synthesized)
-- Applies to formal parameter entities. This is a synonym for Ekind,
-- used when obtaining the formal kind of a formal parameter (the result
--- is one of E_[In/Out/In_Out]_Parameter)
+-- is one of E_[In/Out/In_Out]_Parameter).
-- Parent_Subtype (Node19) [base type only]
-- Defined in E_Record_Type. Set only for derived tagged types, in which
-- Indicates the number of scopes that statically enclose the declaration
-- of the unit or type. Library units have a depth of zero. Note that
-- record types can act as scopes but do NOT have this field set (see
--- Scope_Depth above)
+-- Scope_Depth above).
-- Scope_Depth_Set (synthesized)
-- Applies to a special predicate function that returns a Boolean value
-- The classification of program entities which follows is a refinement of
-- the list given in RM 3.1(1). E.g., separate entities denote subtypes of
-- different type classes. Ada 95 entities include class wide types,
--- protected types, subprogram types, generalized access types, generic
+-- protected types, subprogram types, generalized access types, generic
-- formal derived types and generic formal packages.
-- The order chosen for these kinds allows us to classify related entities
E_Access_Attribute_Type,
-- An access type created for an access attribute (such as 'Access,
- -- 'Unrestricted_Access and Unchecked_Access)
+ -- 'Unrestricted_Access and Unchecked_Access).
E_Allocator_Type,
-- A special internal type used to label allocators and references to
E_Protected_Body,
-- A protected body. This entity serves almost no function, since all
- -- semantic analysis uses the protected entity (E_Protected_Type)
+ -- semantic analysis uses the protected entity (E_Protected_Type).
E_Task_Body,
-- A task body. This entity serves almost no function, since all
-- types, and a field in the type entities contains a value of the
-- following type indicating which alignment choice applies. For full
-- details of the meaning of these alignment types, see description
- -- of the Component_Alignment pragma
+ -- of the Component_Alignment pragma.
type Component_Alignment_Kind is (
Calign_Default, -- default alignment
-- attributes are procedural, and require some small amount of
-- computation. Of course, from the point of view of a user of this
-- package, the distinction is not visible (even the field information
- -- provided below should be disregarded, as it is subject to change
- -- without notice). A number of attributes appear as lists: lists of
- -- formals, lists of actuals, of discriminants, etc. For these, pairs
+ -- provided below should be disregarded, as it is subject to change
+ -- without notice). A number of attributes appear as lists: lists of
+ -- formals, lists of actuals, of discriminants, etc. For these, pairs
-- of functions are defined, which take the form:
-- function First_Thing (E : Enclosing_Construct) return Thing;
-- whether an Ekind value belongs to a specified kind, for example the
-- function Is_Elementary_Type tests if its argument is in Elementary_Kind.
-- In some cases, the test is of an entity attribute (e.g. in the case of
- -- Is_Generic_Type where the Ekind does not provide the needed information)
+ -- Is_Generic_Type where the Ekind does not provide the needed
+ -- information).
function Is_Access_Type (Id : E) return B;
function Is_Access_Protected_Subprogram_Type (Id : E) return B;
procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String);
-- Writes a series of entries giving a line for each flag that is
- -- set to True. Each line is prefixed by the given string
+ -- set to True. Each line is prefixed by the given string.
procedure Write_Entity_Info (Id : Entity_Id; Prefix : String);
-- A debugging procedure to write out information about an entity
Name : Entity_Id := Empty;
Next : Subp_Index := No_Subp;
First_Succ : Succ_Index := No_Succ;
- Listed : Boolean := False;
Main_Call : Boolean := False;
Processed : Boolean := False;
end record;
-- called, and for the inlined subprogram that contains the call. If
-- the call is in the main compilation unit, Caller is Empty.
- procedure Add_Inlined_Subprogram (Index : Subp_Index);
- -- Add the subprogram to the list of inlined subprogram for the unit
+ procedure Add_Inlined_Subprogram (E : Entity_Id);
+ -- Add subprogram E to the list of inlined subprogram for the unit
function Add_Subp (E : Entity_Id) return Subp_Index;
-- Make entry in Inlined table for subprogram E, or return table index
return Inline_Package;
end if;
- -- The call is not in the main unit. See if it is in some inlined
- -- subprogram. If so, inline the call and, if the inlining level is
- -- set to 1, stop there; otherwise also compile the package as above.
+ -- The call is not in the main unit. See if it is in some subprogram
+ -- that can be inlined outside its unit. If so, inline the call and,
+ -- if the inlining level is set to 1, stop there; otherwise also
+ -- compile the package as above.
Scop := Current_Scope;
while Scope (Scop) /= Standard_Standard
and then not Is_Child_Unit (Scop)
loop
- if Is_Overloadable (Scop) and then Is_Inlined (Scop) then
+ if Is_Overloadable (Scop)
+ and then Is_Inlined (Scop)
+ and then not Is_Nested (Scop)
+ then
Add_Call (E, Scop);
if Inline_Level = 1 then
begin
Append_New_Elmt (N, To => Backend_Calls);
+ -- Skip subprograms that cannot be inlined outside their unit
+
+ if Is_Abstract_Subprogram (E)
+ or else Convention (E) = Convention_Protected
+ or else Is_Nested (E)
+ then
+ return;
+ end if;
+
-- Find unit containing E, and add to list of inlined bodies if needed.
-- If the body is already present, no need to load any other unit. This
-- is the case for an initialization procedure, which appears in the
-- no enclosing package to retrieve. In this case, it is the body of
-- the function that will have to be loaded.
- if Is_Abstract_Subprogram (E)
- or else Is_Nested (E)
- or else Convention (E) = Convention_Protected
- then
- return;
- end if;
-
Level := Must_Inline;
if Level /= Dont_Inline then
-- Add_Inlined_Subprogram --
----------------------------
- procedure Add_Inlined_Subprogram (Index : Subp_Index) is
- E : constant Entity_Id := Inlined.Table (Index).Name;
+ procedure Add_Inlined_Subprogram (E : Entity_Id) is
Decl : constant Node_Id := Parent (Declaration_Node (E));
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
else
Register_Backend_Not_Inlined_Subprogram (E);
end if;
-
- Inlined.Table (Index).Listed := True;
end Add_Inlined_Subprogram;
------------------------
Inlined.Table (Inlined.Last).Name := E;
Inlined.Table (Inlined.Last).Next := No_Subp;
Inlined.Table (Inlined.Last).First_Succ := No_Succ;
- Inlined.Table (Inlined.Last).Listed := False;
Inlined.Table (Inlined.Last).Main_Call := False;
Inlined.Table (Inlined.Last).Processed := False;
end New_Entry;
-- as part of an inlined package, but are not themselves called. An
-- accurate computation of just those subprograms that are needed
-- requires that we perform a transitive closure over the call graph,
- -- starting from calls in the main program.
+ -- starting from calls in the main compilation unit.
for Index in Inlined.First .. Inlined.Last loop
if not Is_Called (Inlined.Table (Index).Name) then
-- subprograms for the unit.
for Index in Inlined.First .. Inlined.Last loop
- if Is_Called (Inlined.Table (Index).Name)
- and then not Inlined.Table (Index).Listed
- then
- Add_Inlined_Subprogram (Index);
+ if Is_Called (Inlined.Table (Index).Name) then
+ Add_Inlined_Subprogram (Inlined.Table (Index).Name);
end if;
end loop;
projects / gcc.git / commitdiff