exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place functions returning nonlimited types.
2017-09-29 Bob Duff <duff@adacore.com> * exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place functions returning nonlimited types. Allow for qualified expressions and type conversions. (Expand_N_Extended_Return_Statement): Correct the computation of Func_Bod to allow for child units. (Expand_Simple_Function_Return): Remove assumption that b-i-p implies limited (initialization of In_Place_Expansion), and implies >= Ada 2005. (Is_Build_In_Place_Result_Type): New function to accompany Is_Build_In_Place_Function and Is_Build_In_Place_Function_Call, because sometimes we just have the type on our hands, not the function. For now, does the same thing as the old version, so build-in-place is disabled for nonlimited types, except that you can use -gnatd.9 to enable it. * exp_ch6.ads (Is_Build_In_Place_Result_Type): New function to accompany Is_Build_In_Place_Function and Is_Build_In_Place_Function_Call, because sometimes we just have the type on our hands, not the function. (Make_Build_In_Place_Call_In_...): Handle nonlimited build-in-place cases. (Make_Build_In_Place_Call_In_Object_Declaration): Remove the questionable code at the end that was setting the Etype. * exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): New function to determine whether "return (...agg...);" is returning from a build-in-place function. (Initialize_Ctrl_Array_Component, Initialize_Ctrl_Record_Component): Remove assumption that b-i-p implies limited (initialization of In_Place_Expansion). (Build_Record_Aggr_Code): AI-287: fix comment; it can't be wrapped in an unchecked conversion. Add assertions. (Convert_Aggr_In_Object_Decl): Establish_Transient_Scope -- no need for secondary stack here, just because the type needs finalization. That code is obsolete. (Convert_To_Assignments): Only set Unc_Decl if Nkind (N) = N_Aggregate. For "return (...agg...);" don't assume b-i-p implies limited. Needs_Finalization does not imply secondary stack. (Expand_Array_Aggregate): Named notation. Reverse the sense of Component_OK_For_Backend -- more readability with fewer double negatives. * exp_attr.adb (Expand_N_Attribute_Reference): Remove assumptions that b-i-p implies >= Ada 2005. * exp_ch3.adb (Expand_N_Object_Declaration): Remove assumptions that b-i-p implies >= Ada 2005. Remove Adjust if we're building the return object of an extended return statement in place. * exp_ch4.adb (Expand_Allocator_Expression, Expand_N_Indexed_Component, Expand_N_Selected_Component, Expand_N_Slice): Remove assumptions that b-i-p implies >= Ada 2005. * exp_ch5.adb (Expand_N_Assignment_Statement): Remove assumption that b-i-p implies >= Ada 2005. * exp_ch7.adb: Comment fix. * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Remove assumptions that b-i-p implies >= Ada 2005. * exp_disp.adb (Expand_Interface_Actuals): Remove assumptions that b-i-p implies >= Ada 2005. * exp_util.adb (Build_Allocate_Deallocate_Proc): Look at Storage_Pool (Expr), in case Pool_Id is not set. (Initialized_By_Aliased_BIP_Func_Call): Handle case where the call is qualified or converted. (Is_Secondary_Stack_BIP_Func_Call): Don't check if Nkind (Selector_Name (Param)) = N_Identifier; that's all it could be. * sinfo.ads: Comment fixes. * snames.ads-tmpl: Comment fixes. * debug.adb: Add flag gnatd.9, to enable the build-in-place machinery. From-SVN: r253290
This commit is contained in:
parent
52c6ab7443
commit
d4dfb00562
|
@ -1,3 +1,69 @@
|
|||
2017-09-29 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place
|
||||
functions returning nonlimited types. Allow for qualified expressions
|
||||
and type conversions.
|
||||
(Expand_N_Extended_Return_Statement): Correct the computation of
|
||||
Func_Bod to allow for child units.
|
||||
(Expand_Simple_Function_Return): Remove assumption that b-i-p implies
|
||||
limited (initialization of In_Place_Expansion), and implies >= Ada
|
||||
2005.
|
||||
(Is_Build_In_Place_Result_Type): New function to accompany
|
||||
Is_Build_In_Place_Function and Is_Build_In_Place_Function_Call, because
|
||||
sometimes we just have the type on our hands, not the function. For
|
||||
now, does the same thing as the old version, so build-in-place is
|
||||
disabled for nonlimited types, except that you can use -gnatd.9 to
|
||||
enable it.
|
||||
* exp_ch6.ads (Is_Build_In_Place_Result_Type): New function to
|
||||
accompany Is_Build_In_Place_Function and
|
||||
Is_Build_In_Place_Function_Call, because sometimes we just have the
|
||||
type on our hands, not the function.
|
||||
(Make_Build_In_Place_Call_In_...): Handle nonlimited build-in-place
|
||||
cases.
|
||||
(Make_Build_In_Place_Call_In_Object_Declaration): Remove the
|
||||
questionable code at the end that was setting the Etype.
|
||||
* exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): New function to
|
||||
determine whether "return (...agg...);" is returning from a
|
||||
build-in-place function.
|
||||
(Initialize_Ctrl_Array_Component, Initialize_Ctrl_Record_Component):
|
||||
Remove assumption that b-i-p implies limited (initialization of
|
||||
In_Place_Expansion).
|
||||
(Build_Record_Aggr_Code): AI-287: fix comment; it can't be wrapped in
|
||||
an unchecked conversion. Add assertions.
|
||||
(Convert_Aggr_In_Object_Decl): Establish_Transient_Scope -- no need for
|
||||
secondary stack here, just because the type needs finalization. That
|
||||
code is obsolete.
|
||||
(Convert_To_Assignments): Only set Unc_Decl if Nkind (N) = N_Aggregate.
|
||||
For "return (...agg...);" don't assume b-i-p implies limited.
|
||||
Needs_Finalization does not imply secondary stack.
|
||||
(Expand_Array_Aggregate): Named notation. Reverse the sense of
|
||||
Component_OK_For_Backend -- more readability with fewer double
|
||||
negatives.
|
||||
* exp_attr.adb (Expand_N_Attribute_Reference): Remove assumptions that
|
||||
b-i-p implies >= Ada 2005.
|
||||
* exp_ch3.adb (Expand_N_Object_Declaration): Remove assumptions that
|
||||
b-i-p implies >= Ada 2005. Remove Adjust if we're building the return
|
||||
object of an extended return statement in place.
|
||||
* exp_ch4.adb (Expand_Allocator_Expression, Expand_N_Indexed_Component,
|
||||
Expand_N_Selected_Component, Expand_N_Slice): Remove assumptions that
|
||||
b-i-p implies >= Ada 2005.
|
||||
* exp_ch5.adb (Expand_N_Assignment_Statement): Remove assumption that
|
||||
b-i-p implies >= Ada 2005.
|
||||
* exp_ch7.adb: Comment fix.
|
||||
* exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Remove
|
||||
assumptions that b-i-p implies >= Ada 2005.
|
||||
* exp_disp.adb (Expand_Interface_Actuals): Remove assumptions that
|
||||
b-i-p implies >= Ada 2005.
|
||||
* exp_util.adb (Build_Allocate_Deallocate_Proc): Look at Storage_Pool
|
||||
(Expr), in case Pool_Id is not set.
|
||||
(Initialized_By_Aliased_BIP_Func_Call): Handle case where the call is
|
||||
qualified or converted.
|
||||
(Is_Secondary_Stack_BIP_Func_Call): Don't check if Nkind (Selector_Name
|
||||
(Param)) = N_Identifier; that's all it could be.
|
||||
* sinfo.ads: Comment fixes.
|
||||
* snames.ads-tmpl: Comment fixes.
|
||||
* debug.adb: Add flag gnatd.9, to enable the build-in-place machinery.
|
||||
|
||||
2017-09-29 Justin Squirek <squirek@adacore.com>
|
||||
|
||||
* sem_ch8.adb (Mark_Use_Clauses): Add recursive call to properly handle
|
||||
|
|
|
@ -163,7 +163,7 @@ package body Debug is
|
|||
-- d.6 Do not avoid declaring unreferenced types in C code
|
||||
-- d.7
|
||||
-- d.8
|
||||
-- d.9
|
||||
-- d.9 Enable build-in-place for nonlimited types
|
||||
|
||||
-- Debug flags for binder (GNATBIND)
|
||||
|
||||
|
@ -820,6 +820,9 @@ package body Debug is
|
|||
-- referenced by the generated C code. This debug flag restores the
|
||||
-- output of all the types.
|
||||
|
||||
-- d.9 Enable build-in-place for function calls returning some nonlimited
|
||||
-- types.
|
||||
|
||||
------------------------------------------
|
||||
-- Documentation for Binder Debug Flags --
|
||||
------------------------------------------
|
||||
|
|
|
@ -175,6 +175,10 @@ package body Exp_Aggr is
|
|||
-- Local subprograms for Record Aggregate Expansion --
|
||||
------------------------------------------------------
|
||||
|
||||
function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean;
|
||||
-- True if N is an aggregate (possibly qualified or converted) that is
|
||||
-- being returned from a build-in-place function.
|
||||
|
||||
function Build_Record_Aggr_Code
|
||||
(N : Node_Id;
|
||||
Typ : Entity_Id;
|
||||
|
@ -186,10 +190,9 @@ package body Exp_Aggr is
|
|||
-- types.
|
||||
|
||||
procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id);
|
||||
-- N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the
|
||||
-- aggregate (which can only be a record type, this procedure is only used
|
||||
-- for record types). Transform the given aggregate into a sequence of
|
||||
-- assignments performed component by component.
|
||||
-- Transform a record aggregate into a sequence of assignments performed
|
||||
-- component by component. N is an N_Aggregate or N_Extension_Aggregate.
|
||||
-- Typ is the type of the record aggregate.
|
||||
|
||||
procedure Expand_Record_Aggregate
|
||||
(N : Node_Id;
|
||||
|
@ -762,10 +765,10 @@ package body Exp_Aggr is
|
|||
-- Checks 5 (if the component type is tagged, then we may need to do
|
||||
-- tag adjustments. Perhaps this should be refined to check for any
|
||||
-- component associations that actually need tag adjustment, similar
|
||||
-- to the test in Component_Not_OK_For_Backend for record aggregates
|
||||
-- with tagged components, but not clear whether it's worthwhile ???;
|
||||
-- in the case of virtual machines (no Tagged_Type_Expansion), object
|
||||
-- tags are handled implicitly).
|
||||
-- to the test in Component_OK_For_Backend for record aggregates with
|
||||
-- tagged components, but not clear whether it's worthwhile ???; in the
|
||||
-- case of virtual machines (no Tagged_Type_Expansion), object tags are
|
||||
-- handled implicitly).
|
||||
|
||||
if Is_Tagged_Type (Component_Type (Typ))
|
||||
and then Tagged_Type_Expansion
|
||||
|
@ -1347,7 +1350,7 @@ package body Exp_Aggr is
|
|||
|
||||
In_Place_Expansion :=
|
||||
Nkind (Expr) = N_Function_Call
|
||||
and then not Is_Limited_Type (Comp_Typ);
|
||||
and then not Is_Build_In_Place_Result_Type (Comp_Typ);
|
||||
|
||||
-- The initialization expression is a controlled function call.
|
||||
-- Perform in-place removal of side effects to avoid creating a
|
||||
|
@ -2831,7 +2834,7 @@ package body Exp_Aggr is
|
|||
|
||||
In_Place_Expansion :=
|
||||
Nkind (Init_Expr) = N_Function_Call
|
||||
and then not Is_Limited_Type (Comp_Typ);
|
||||
and then not Is_Build_In_Place_Result_Type (Comp_Typ);
|
||||
|
||||
-- The initialization expression is a controlled function call.
|
||||
-- Perform in-place removal of side effects to avoid creating a
|
||||
|
@ -2967,7 +2970,10 @@ package body Exp_Aggr is
|
|||
|
||||
-- [Deep_]Adjust (Rec_Comp);
|
||||
|
||||
if Finalization_OK and then not Is_Limited_Type (Comp_Typ) then
|
||||
if Finalization_OK
|
||||
and then not Is_Limited_Type (Comp_Typ)
|
||||
and then not Is_Build_In_Place_Function_Call (Init_Expr)
|
||||
then
|
||||
Adj_Call :=
|
||||
Make_Adjust_Call
|
||||
(Obj_Ref => New_Copy_Tree (Rec_Comp),
|
||||
|
@ -3229,12 +3235,8 @@ package body Exp_Aggr is
|
|||
-- Ada 2005 (AI-287): If the ancestor part is an aggregate of
|
||||
-- limited type, a recursive call expands the ancestor. Note that
|
||||
-- in the limited case, the ancestor part must be either a
|
||||
-- function call (possibly qualified, or wrapped in an unchecked
|
||||
-- conversion) or aggregate (definitely qualified).
|
||||
|
||||
-- The ancestor part can also be a function call (that may be
|
||||
-- transformed into an explicit dereference) or a qualification
|
||||
-- of one such.
|
||||
-- function call (possibly qualified) or aggregate (definitely
|
||||
-- qualified).
|
||||
|
||||
elsif Is_Limited_Type (Etype (Ancestor))
|
||||
and then Nkind_In (Unqualify (Ancestor), N_Aggregate,
|
||||
|
@ -3330,6 +3332,7 @@ package body Exp_Aggr is
|
|||
|
||||
if Needs_Finalization (Etype (Ancestor))
|
||||
and then not Is_Limited_Type (Etype (Ancestor))
|
||||
and then not Is_Build_In_Place_Function_Call (Ancestor)
|
||||
then
|
||||
Adj_Call :=
|
||||
Make_Adjust_Call
|
||||
|
@ -3351,6 +3354,10 @@ package body Exp_Aggr is
|
|||
Check_Ancestor_Discriminants (Init_Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
pragma Assert (Nkind (N) = N_Extension_Aggregate);
|
||||
pragma Assert
|
||||
(not (Ancestor_Is_Expression and Ancestor_Is_Subtype_Mark));
|
||||
end;
|
||||
|
||||
-- Generate assignments of hidden discriminants. If the base type is
|
||||
|
@ -4073,10 +4080,7 @@ package body Exp_Aggr is
|
|||
and then Ekind (Current_Scope) /= E_Return_Statement
|
||||
and then not Is_Limited_Type (Typ)
|
||||
then
|
||||
Establish_Transient_Scope
|
||||
(Aggr,
|
||||
Sec_Stack =>
|
||||
Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
|
||||
Establish_Transient_Scope (Aggr, Sec_Stack => False);
|
||||
end if;
|
||||
|
||||
declare
|
||||
|
@ -4121,6 +4125,25 @@ package body Exp_Aggr is
|
|||
-- Convert_To_Assignments --
|
||||
----------------------------
|
||||
|
||||
function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is
|
||||
P : Node_Id := Parent (N);
|
||||
begin
|
||||
while Nkind (P) = N_Qualified_Expression loop
|
||||
P := Parent (P);
|
||||
end loop;
|
||||
|
||||
if Nkind (P) = N_Simple_Return_Statement then
|
||||
null;
|
||||
elsif Nkind (Parent (P)) = N_Extended_Return_Statement then
|
||||
P := Parent (P);
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
|
||||
return Is_Build_In_Place_Function
|
||||
(Return_Applies_To (Return_Statement_Entity (P)));
|
||||
end Is_Build_In_Place_Aggregate_Return;
|
||||
|
||||
procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
T : Entity_Id;
|
||||
|
@ -4134,6 +4157,7 @@ package body Exp_Aggr is
|
|||
Parent_Node : Node_Id;
|
||||
|
||||
begin
|
||||
pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate));
|
||||
pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N));
|
||||
pragma Assert (Is_Record_Type (Typ));
|
||||
|
||||
|
@ -4141,10 +4165,9 @@ package body Exp_Aggr is
|
|||
Parent_Kind := Nkind (Parent_Node);
|
||||
|
||||
if Parent_Kind = N_Qualified_Expression then
|
||||
|
||||
-- Check if we are in a unconstrained declaration because in this
|
||||
-- Check if we are in an unconstrained declaration because in this
|
||||
-- case the current delayed expansion mechanism doesn't work when
|
||||
-- the declared object size depend on the initializing expr.
|
||||
-- the declared object size depends on the initializing expr.
|
||||
|
||||
Parent_Node := Parent (Parent_Node);
|
||||
Parent_Kind := Nkind (Parent_Node);
|
||||
|
@ -4152,8 +4175,9 @@ package body Exp_Aggr is
|
|||
if Parent_Kind = N_Object_Declaration then
|
||||
Unc_Decl :=
|
||||
not Is_Entity_Name (Object_Definition (Parent_Node))
|
||||
or else Has_Discriminants
|
||||
(Entity (Object_Definition (Parent_Node)))
|
||||
or else (Nkind (N) = N_Aggregate
|
||||
and then Has_Discriminants
|
||||
(Entity (Object_Definition (Parent_Node))))
|
||||
or else Is_Class_Wide_Type
|
||||
(Entity (Object_Definition (Parent_Node)));
|
||||
end if;
|
||||
|
@ -4195,11 +4219,7 @@ package body Exp_Aggr is
|
|||
-- finalization of the return object (which is built in place
|
||||
-- within the caller's scope).
|
||||
|
||||
or else
|
||||
(Is_Limited_View (Typ)
|
||||
and then
|
||||
(Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement
|
||||
or else Nkind (Parent_Node) = N_Simple_Return_Statement))
|
||||
or else Is_Build_In_Place_Aggregate_Return (N)
|
||||
then
|
||||
Set_Expansion_Delayed (N);
|
||||
return;
|
||||
|
@ -4214,7 +4234,7 @@ package body Exp_Aggr is
|
|||
-- Should the condition be more restrictive ???
|
||||
|
||||
if Requires_Transient_Scope (Typ) and then not Inside_Init_Proc then
|
||||
Establish_Transient_Scope (N, Sec_Stack => Needs_Finalization (Typ));
|
||||
Establish_Transient_Scope (N, Sec_Stack => False);
|
||||
end if;
|
||||
|
||||
-- If the aggregate is nonlimited, create a temporary. If it is limited
|
||||
|
@ -6111,8 +6131,7 @@ package body Exp_Aggr is
|
|||
-- for default initialization, e.g. with Initialize_Scalars.
|
||||
|
||||
if Requires_Transient_Scope (Typ) then
|
||||
Establish_Transient_Scope
|
||||
(N, Sec_Stack => Has_Controlled_Component (Typ));
|
||||
Establish_Transient_Scope (N, Sec_Stack => False);
|
||||
end if;
|
||||
|
||||
if Has_Default_Init_Comps (N) then
|
||||
|
@ -6251,7 +6270,7 @@ package body Exp_Aggr is
|
|||
if Ekind (Current_Scope) = E_Loop
|
||||
and then Nkind (Parent (Parent (N))) = N_Allocator
|
||||
then
|
||||
Establish_Transient_Scope (N, False);
|
||||
Establish_Transient_Scope (N, Sec_Stack => False);
|
||||
end if;
|
||||
|
||||
Insert_Action (N, Tmp_Decl);
|
||||
|
@ -6646,13 +6665,13 @@ package body Exp_Aggr is
|
|||
|
||||
-- If the ancestor part is an expression, add a component association for
|
||||
-- the parent field. If the type of the ancestor part is not the direct
|
||||
-- parent of the expected type, build recursively the needed ancestors.
|
||||
-- If the ancestor part is a subtype_mark, replace aggregate with a decla-
|
||||
-- ration for a temporary of the expected type, followed by individual
|
||||
-- assignments to the given components.
|
||||
-- parent of the expected type, build recursively the needed ancestors.
|
||||
-- If the ancestor part is a subtype_mark, replace aggregate with a
|
||||
-- declaration for a temporary of the expected type, followed by
|
||||
-- individual assignments to the given components.
|
||||
|
||||
procedure Expand_N_Extension_Aggregate (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
A : constant Node_Id := Ancestor_Part (N);
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
|
||||
|
@ -6709,7 +6728,7 @@ package body Exp_Aggr is
|
|||
Static_Components : Boolean := True;
|
||||
-- Flag to indicate whether all components are compile-time known,
|
||||
-- and the aggregate can be constructed statically and handled by
|
||||
-- the back-end.
|
||||
-- the back-end. Set to False by Component_OK_For_Backend.
|
||||
|
||||
procedure Build_Back_End_Aggregate;
|
||||
-- Build a proper aggregate to be handled by the back-end
|
||||
|
@ -6722,7 +6741,7 @@ package body Exp_Aggr is
|
|||
-- This returns true for N_Aggregate with Compile_Time_Known_Aggregate
|
||||
-- set and constants whose expression is such an aggregate, recursively.
|
||||
|
||||
function Component_Not_OK_For_Backend return Boolean;
|
||||
function Component_OK_For_Backend return Boolean;
|
||||
-- Check for presence of a component which makes it impossible for the
|
||||
-- backend to process the aggregate, thus requiring the use of a series
|
||||
-- of assignment statements. Cases checked for are a nested aggregate
|
||||
|
@ -6741,6 +6760,9 @@ package body Exp_Aggr is
|
|||
-- in order to minimize elaboration code. This is one case where the
|
||||
-- semantics of Ada complicate the analysis and lead to anomalies in
|
||||
-- the gcc back-end if the aggregate is not expanded into assignments.
|
||||
--
|
||||
-- NOTE: This sets the global Static_Components to False in most, but
|
||||
-- not all, cases when it returns False.
|
||||
|
||||
function Has_Per_Object_Constraint (L : List_Id) return Boolean;
|
||||
-- Return True if any element of L has Has_Per_Object_Constraint set.
|
||||
|
@ -7043,7 +7065,7 @@ package body Exp_Aggr is
|
|||
-- The ancestor part may be a nested aggregate that has
|
||||
-- delayed expansion: recheck now.
|
||||
|
||||
if Component_Not_OK_For_Backend then
|
||||
if not Component_OK_For_Backend then
|
||||
Convert_To_Assignments (N, Typ);
|
||||
end if;
|
||||
end;
|
||||
|
@ -7110,17 +7132,17 @@ package body Exp_Aggr is
|
|||
|
||||
end Compile_Time_Known_Composite_Value;
|
||||
|
||||
----------------------------------
|
||||
-- Component_Not_OK_For_Backend --
|
||||
----------------------------------
|
||||
------------------------------
|
||||
-- Component_OK_For_Backend --
|
||||
------------------------------
|
||||
|
||||
function Component_Not_OK_For_Backend return Boolean is
|
||||
function Component_OK_For_Backend return Boolean is
|
||||
C : Node_Id;
|
||||
Expr_Q : Node_Id;
|
||||
|
||||
begin
|
||||
if No (Comps) then
|
||||
return False;
|
||||
return True;
|
||||
end if;
|
||||
|
||||
C := First (Comps);
|
||||
|
@ -7130,7 +7152,7 @@ package body Exp_Aggr is
|
|||
-- and component is not ready for backend.
|
||||
|
||||
if Box_Present (C) then
|
||||
return True;
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Nkind (Expression (C)) = N_Qualified_Expression then
|
||||
|
@ -7139,7 +7161,7 @@ package body Exp_Aggr is
|
|||
Expr_Q := Expression (C);
|
||||
end if;
|
||||
|
||||
-- Return true if the aggregate has any associations for tagged
|
||||
-- Return False if the aggregate has any associations for tagged
|
||||
-- components that may require tag adjustment.
|
||||
|
||||
-- These are cases where the source expression may have a tag that
|
||||
|
@ -7156,36 +7178,36 @@ package body Exp_Aggr is
|
|||
and then Tagged_Type_Expansion
|
||||
then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
|
||||
elsif Is_Delayed_Aggregate (Expr_Q) then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
|
||||
elsif Possible_Bit_Aligned_Component (Expr_Q) then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
|
||||
elsif Modify_Tree_For_C
|
||||
and then Nkind (C) = N_Component_Association
|
||||
and then Has_Per_Object_Constraint (Choices (C))
|
||||
then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
|
||||
elsif Modify_Tree_For_C
|
||||
and then Nkind (Expr_Q) = N_Identifier
|
||||
and then Is_Array_Type (Etype (Expr_Q))
|
||||
then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
|
||||
elsif Modify_Tree_For_C
|
||||
and then Nkind (Expr_Q) = N_Type_Conversion
|
||||
and then Is_Array_Type (Etype (Expr_Q))
|
||||
then
|
||||
Static_Components := False;
|
||||
return True;
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Is_Elementary_Type (Etype (Expr_Q)) then
|
||||
|
@ -7199,15 +7221,15 @@ package body Exp_Aggr is
|
|||
if Is_Private_Type (Etype (Expr_Q))
|
||||
and then Has_Discriminants (Etype (Expr_Q))
|
||||
then
|
||||
return True;
|
||||
return False;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (C);
|
||||
end loop;
|
||||
|
||||
return False;
|
||||
end Component_Not_OK_For_Backend;
|
||||
return True;
|
||||
end Component_OK_For_Backend;
|
||||
|
||||
-------------------------------
|
||||
-- Has_Per_Object_Constraint --
|
||||
|
@ -7297,7 +7319,7 @@ package body Exp_Aggr is
|
|||
-- Ada 2005 (AI-318-2): We need to convert to assignments if components
|
||||
-- are build-in-place function calls. The assignments will each turn
|
||||
-- into a build-in-place function call. If components are all static,
|
||||
-- we can pass the aggregate to the backend regardless of limitedness.
|
||||
-- we can pass the aggregate to the back end regardless of limitedness.
|
||||
|
||||
-- Extension aggregates, aggregates in extended return statements, and
|
||||
-- aggregates for C++ imported types must be expanded.
|
||||
|
@ -7314,7 +7336,7 @@ package body Exp_Aggr is
|
|||
Convert_To_Assignments (N, Typ);
|
||||
|
||||
elsif not Size_Known_At_Compile_Time (Typ)
|
||||
or else Component_Not_OK_For_Backend
|
||||
or else not Component_OK_For_Backend
|
||||
or else not Static_Components
|
||||
then
|
||||
Convert_To_Assignments (N, Typ);
|
||||
|
@ -7349,7 +7371,7 @@ package body Exp_Aggr is
|
|||
|
||||
-- Check components
|
||||
|
||||
elsif Component_Not_OK_For_Backend then
|
||||
elsif not Component_OK_For_Backend then
|
||||
Convert_To_Assignments (N, Typ);
|
||||
|
||||
-- If an ancestor is private, some components are not inherited and we
|
||||
|
|
|
@ -1753,23 +1753,16 @@ package body Exp_Attr is
|
|||
|
||||
-- Ada 2005 (AI-318-02): If attribute prefix is a call to a build-in-
|
||||
-- place function, then a temporary return object needs to be created
|
||||
-- and access to it must be passed to the function. Currently we limit
|
||||
-- such functions to those with inherently limited result subtypes, but
|
||||
-- eventually we plan to expand the functions that are treated as
|
||||
-- build-in-place to include other composite result types.
|
||||
-- and access to it must be passed to the function.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Pref)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Pref) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
|
||||
|
||||
-- Ada 2005 (AI-318-02): Specialization of the previous case for prefix
|
||||
-- containing build-in-place function calls whose returned object covers
|
||||
-- interface types.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (Pref))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (Pref)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Pref);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -6299,9 +6299,7 @@ package body Exp_Ch3 is
|
|||
-- plan to expand the allowed forms of functions that are treated as
|
||||
-- build-in-place.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Expr_Q)
|
||||
then
|
||||
elsif Is_Build_In_Place_Function_Call (Expr_Q) then
|
||||
Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);
|
||||
|
||||
-- The previous call expands the expression initializing the
|
||||
|
@ -6317,9 +6315,7 @@ package body Exp_Ch3 is
|
|||
-- in-place object to reference the secondary dispatch table of a
|
||||
-- covered interface type.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (Expr_Q))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (Expr_Q)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Object_Declaration (N, Expr_Q);
|
||||
|
||||
-- The previous call expands the expression initializing the
|
||||
|
@ -6617,13 +6613,19 @@ package body Exp_Ch3 is
|
|||
-- the target is adjusted after the copy and attached to the
|
||||
-- finalization list. However, no adjustment is done in the case
|
||||
-- where the object was initialized by a call to a function whose
|
||||
-- result is built in place, since no copy occurred. (Eventually
|
||||
-- we plan to support in-place function results for some cases
|
||||
-- of nonlimited types. ???) Similarly, no adjustment is required
|
||||
-- if we are going to rewrite the object declaration into a
|
||||
-- renaming declaration.
|
||||
-- result is built in place, since no copy occurred. Similarly, no
|
||||
-- adjustment is required if we are going to rewrite the object
|
||||
-- declaration into a renaming declaration.
|
||||
|
||||
if Needs_Finalization (Typ)
|
||||
if Is_Build_In_Place_Result_Type (Typ)
|
||||
and then Nkind (Parent (N)) = N_Extended_Return_Statement
|
||||
and then not Is_Definite_Subtype
|
||||
(Etype (Return_Applies_To
|
||||
(Return_Statement_Entity (Parent (N)))))
|
||||
then
|
||||
null;
|
||||
|
||||
elsif Needs_Finalization (Typ)
|
||||
and then not Is_Limited_View (Typ)
|
||||
and then not Rewrite_As_Renaming
|
||||
then
|
||||
|
@ -6755,9 +6757,9 @@ package body Exp_Ch3 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- Cases where the back end cannot handle the initialization directly
|
||||
-- In such cases, we expand an assignment that will be appropriately
|
||||
-- handled by Expand_N_Assignment_Statement.
|
||||
-- Cases where the back end cannot handle the initialization
|
||||
-- directly. In such cases, we expand an assignment that will
|
||||
-- be appropriately handled by Expand_N_Assignment_Statement.
|
||||
|
||||
-- The exclusion of the unconstrained case is wrong, but for now it
|
||||
-- is too much trouble ???
|
||||
|
|
|
@ -793,14 +793,9 @@ package body Exp_Ch4 is
|
|||
|
||||
-- Ada 2005 (AI-318-02): If the initialization expression is a call
|
||||
-- to a build-in-place function, then access to the allocated object
|
||||
-- must be passed to the function. Currently we limit such functions
|
||||
-- to those with constrained limited result subtypes, but eventually
|
||||
-- we plan to expand the allowed forms of functions that are treated
|
||||
-- as build-in-place.
|
||||
-- must be passed to the function.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Exp)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Exp) then
|
||||
Make_Build_In_Place_Call_In_Allocator (N, Exp);
|
||||
Apply_Accessibility_Check (N, Built_In_Place => True);
|
||||
return;
|
||||
|
@ -812,9 +807,7 @@ package body Exp_Ch4 is
|
|||
-- in-place object to reference the secondary dispatch table of a
|
||||
-- covered interface type.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (Exp))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (Exp)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Allocator (N, Exp);
|
||||
Apply_Accessibility_Check (N, Built_In_Place => True);
|
||||
return;
|
||||
|
@ -1223,14 +1216,9 @@ package body Exp_Ch4 is
|
|||
|
||||
-- Ada 2005 (AI-318-02): If the initialization expression is a call
|
||||
-- to a build-in-place function, then access to the allocated object
|
||||
-- must be passed to the function. Currently we limit such functions
|
||||
-- to those with constrained limited result subtypes, but eventually
|
||||
-- we plan to expand the allowed forms of functions that are treated
|
||||
-- as build-in-place.
|
||||
-- must be passed to the function.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Exp)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Exp) then
|
||||
Make_Build_In_Place_Call_In_Allocator (N, Exp);
|
||||
end if;
|
||||
end if;
|
||||
|
@ -6572,18 +6560,14 @@ package body Exp_Ch4 is
|
|||
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
|
||||
-- function, then additional actuals must be passed.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (P)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (P) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (P);
|
||||
|
||||
-- Ada 2005 (AI-318-02): Specialization of the previous case for prefix
|
||||
-- containing build-in-place function calls whose returned object covers
|
||||
-- interface types.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (P))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (P)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
|
||||
end if;
|
||||
|
||||
|
@ -10221,18 +10205,14 @@ package body Exp_Ch4 is
|
|||
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
|
||||
-- function, then additional actuals must be passed.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (P)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (P) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (P);
|
||||
|
||||
-- Ada 2005 (AI-318-02): Specialization of the previous case for prefix
|
||||
-- containing build-in-place function calls whose returned object covers
|
||||
-- interface types.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (P))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (P)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
|
||||
end if;
|
||||
|
||||
|
@ -10587,18 +10567,14 @@ package body Exp_Ch4 is
|
|||
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
|
||||
-- function, then additional actuals must be passed.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Pref)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Pref) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
|
||||
|
||||
-- Ada 2005 (AI-318-02): Specialization of the previous case for prefix
|
||||
-- containing build-in-place function calls whose returned object covers
|
||||
-- interface types.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (Pref))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (Pref)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Pref);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -2390,13 +2390,13 @@ package body Exp_Ch5 is
|
|||
end;
|
||||
end if;
|
||||
|
||||
-- Build-in-place function call case. Note that we're not yet doing
|
||||
-- build-in-place for user-written assignment statements (the assignment
|
||||
-- here came from an aggregate.)
|
||||
-- Build-in-place function call case. This is for assignment statements
|
||||
-- that come from aggregate component associations or from init procs.
|
||||
-- User-written assignment statements with b-i-p calls are handled
|
||||
-- elsewhere.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Rhs)
|
||||
then
|
||||
elsif Is_Build_In_Place_Function_Call (Rhs) then
|
||||
pragma Assert (not Comes_From_Source (N));
|
||||
Make_Build_In_Place_Call_In_Assignment (N, Rhs);
|
||||
|
||||
elsif Is_Tagged_Type (Typ)
|
||||
|
|
|
@ -2252,6 +2252,9 @@ package body Exp_Ch6 is
|
|||
procedure Expand_Call (N : Node_Id) is
|
||||
Post_Call : List_Id;
|
||||
begin
|
||||
pragma Assert
|
||||
(Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement,
|
||||
N_Entry_Call_Statement));
|
||||
Expand_Call_Helper (N, Post_Call);
|
||||
Insert_Post_Call_Actions (N, Post_Call);
|
||||
end Expand_Call;
|
||||
|
@ -4327,29 +4330,30 @@ package body Exp_Ch6 is
|
|||
-- result from the secondary stack.
|
||||
|
||||
if Needs_Finalization (Etype (Subp)) then
|
||||
if not Is_Limited_View (Etype (Subp))
|
||||
-- Build-in-place function calls which appear in anonymous contexts
|
||||
-- need a transient scope to ensure the proper finalization of the
|
||||
-- intermediate result after its use.
|
||||
|
||||
if Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
Nkind_In (Parent (Unqual_Conv (Call_Node)),
|
||||
N_Attribute_Reference,
|
||||
N_Function_Call,
|
||||
N_Indexed_Component,
|
||||
N_Object_Renaming_Declaration,
|
||||
N_Procedure_Call_Statement,
|
||||
N_Selected_Component,
|
||||
N_Slice)
|
||||
then
|
||||
Establish_Transient_Scope (Call_Node, Sec_Stack => True);
|
||||
|
||||
elsif not Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
(No (First_Formal (Subp))
|
||||
or else
|
||||
not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
|
||||
then
|
||||
Expand_Ctrl_Function_Call (Call_Node);
|
||||
|
||||
-- Build-in-place function calls which appear in anonymous contexts
|
||||
-- need a transient scope to ensure the proper finalization of the
|
||||
-- intermediate result after its use.
|
||||
|
||||
elsif Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
Nkind_In (Parent (Call_Node), N_Attribute_Reference,
|
||||
N_Function_Call,
|
||||
N_Indexed_Component,
|
||||
N_Object_Renaming_Declaration,
|
||||
N_Procedure_Call_Statement,
|
||||
N_Selected_Component,
|
||||
N_Slice)
|
||||
then
|
||||
Establish_Transient_Scope (Call_Node, Sec_Stack => True);
|
||||
end if;
|
||||
end if;
|
||||
end Expand_Call_Helper;
|
||||
|
@ -4756,6 +4760,12 @@ package body Exp_Ch6 is
|
|||
Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
|
||||
end if;
|
||||
|
||||
if Nkind (Func_Bod) = N_Function_Specification then
|
||||
Func_Bod := Parent (Func_Bod); -- one more level for child units
|
||||
end if;
|
||||
|
||||
pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body);
|
||||
|
||||
-- Create a flag to track the function state
|
||||
|
||||
Flag_Id := Make_Temporary (Loc, 'F');
|
||||
|
@ -4781,8 +4791,7 @@ package body Exp_Ch6 is
|
|||
-- Build a simple_return_statement that returns the return object when
|
||||
-- there is a statement sequence, or no expression, or the result will
|
||||
-- be built in place. Note however that we currently do this for all
|
||||
-- composite cases, even though nonlimited composite results are not yet
|
||||
-- built in place (though we plan to do so eventually).
|
||||
-- composite cases, even though not all are built in place.
|
||||
|
||||
if Present (HSS)
|
||||
or else Is_Composite_Type (Ret_Typ)
|
||||
|
@ -6385,8 +6394,8 @@ package body Exp_Ch6 is
|
|||
end if;
|
||||
|
||||
-- For the case of a simple return that does not come from an extended
|
||||
-- return, in the case of Ada 2005 where we are returning a limited
|
||||
-- type, we rewrite "return <expression>;" to be:
|
||||
-- return, in the case of build-in-place, we rewrite "return
|
||||
-- <expression>;" to be:
|
||||
|
||||
-- return _anon_ : <return_subtype> := <expression>
|
||||
|
||||
|
@ -6414,9 +6423,13 @@ package body Exp_Ch6 is
|
|||
-- class-wide interface type, which is not a limited type, even though
|
||||
-- the type of the expression may be.
|
||||
|
||||
pragma Assert
|
||||
(Comes_From_Extended_Return_Statement (N)
|
||||
or else not Is_Build_In_Place_Function_Call (Exp)
|
||||
or else Is_Build_In_Place_Function (Scope_Id));
|
||||
|
||||
if not Comes_From_Extended_Return_Statement (N)
|
||||
and then Is_Limited_View (Etype (Expression (N)))
|
||||
and then Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function (Scope_Id)
|
||||
and then not Debug_Flag_Dot_L
|
||||
|
||||
-- The functionality of interface thunks is simple and it is always
|
||||
|
@ -6494,7 +6507,7 @@ package body Exp_Ch6 is
|
|||
-- type that requires special processing (indicated by the fact that
|
||||
-- it requires a cleanup scope for the secondary stack case).
|
||||
|
||||
if Is_Limited_View (Exptyp)
|
||||
if Is_Build_In_Place_Function (Scope_Id)
|
||||
or else Is_Limited_Interface (Exptyp)
|
||||
then
|
||||
null;
|
||||
|
@ -7186,6 +7199,24 @@ package body Exp_Ch6 is
|
|||
return False;
|
||||
end Has_Unconstrained_Access_Discriminants;
|
||||
|
||||
-----------------------------------
|
||||
-- Is_Build_In_Place_Result_Type --
|
||||
-----------------------------------
|
||||
|
||||
function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean is
|
||||
begin
|
||||
-- In Ada 2005 all functions with an inherently limited return type
|
||||
-- must be handled using a build-in-place profile, including the case
|
||||
-- of a function with a limited interface result, where the function
|
||||
-- may return objects of nonlimited descendants.
|
||||
|
||||
if Is_Limited_View (Typ) then
|
||||
return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L;
|
||||
else
|
||||
return Debug_Flag_Dot_9;
|
||||
end if;
|
||||
end Is_Build_In_Place_Result_Type;
|
||||
|
||||
--------------------------------
|
||||
-- Is_Build_In_Place_Function --
|
||||
--------------------------------
|
||||
|
@ -7216,19 +7247,9 @@ package body Exp_Ch6 is
|
|||
-- intended to be compatible with the other language, but the build-
|
||||
-- in place machinery can ensure that the object is not copied.
|
||||
|
||||
if Has_Foreign_Convention (E) then
|
||||
return False;
|
||||
|
||||
-- In Ada 2005 all functions with an inherently limited return type
|
||||
-- must be handled using a build-in-place profile, including the case
|
||||
-- of a function with a limited interface result, where the function
|
||||
-- may return objects of nonlimited descendants.
|
||||
|
||||
else
|
||||
return Is_Limited_View (Etype (E))
|
||||
and then Ada_Version >= Ada_2005
|
||||
and then not Debug_Flag_Dot_L;
|
||||
end if;
|
||||
return Is_Build_In_Place_Result_Type (Etype (E))
|
||||
and then not Has_Foreign_Convention (E)
|
||||
and then not Debug_Flag_Dot_L;
|
||||
|
||||
else
|
||||
return False;
|
||||
|
@ -7256,34 +7277,33 @@ package body Exp_Ch6 is
|
|||
-- may end up with a call that is neither resolved to an entity, nor
|
||||
-- an indirect call.
|
||||
|
||||
if not Expander_Active then
|
||||
if not Expander_Active or else Nkind (Exp_Node) /= N_Function_Call then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Nkind (Exp_Node) /= N_Function_Call then
|
||||
return False;
|
||||
if Is_Entity_Name (Name (Exp_Node)) then
|
||||
Function_Id := Entity (Name (Exp_Node));
|
||||
|
||||
-- In the case of an explicitly dereferenced call, use the subprogram
|
||||
-- type generated for the dereference.
|
||||
|
||||
elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
|
||||
Function_Id := Etype (Name (Exp_Node));
|
||||
|
||||
-- This may be a call to a protected function.
|
||||
|
||||
elsif Nkind (Name (Exp_Node)) = N_Selected_Component then
|
||||
Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node))));
|
||||
|
||||
else
|
||||
if Is_Entity_Name (Name (Exp_Node)) then
|
||||
Function_Id := Entity (Name (Exp_Node));
|
||||
|
||||
-- In the case of an explicitly dereferenced call, use the subprogram
|
||||
-- type generated for the dereference.
|
||||
|
||||
elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
|
||||
Function_Id := Etype (Name (Exp_Node));
|
||||
|
||||
-- This may be a call to a protected function.
|
||||
|
||||
elsif Nkind (Name (Exp_Node)) = N_Selected_Component then
|
||||
Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node))));
|
||||
|
||||
else
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
return Is_Build_In_Place_Function (Function_Id);
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Result : constant Boolean := Is_Build_In_Place_Function (Function_Id);
|
||||
begin
|
||||
return Result;
|
||||
end;
|
||||
end Is_Build_In_Place_Function_Call;
|
||||
|
||||
-----------------------
|
||||
|
@ -7693,16 +7713,9 @@ package body Exp_Ch6 is
|
|||
Func_Call := Expression (Func_Call);
|
||||
end if;
|
||||
|
||||
-- If the call has already been processed to add build-in-place actuals
|
||||
-- then return. This should not normally occur in an allocator context,
|
||||
-- but we add the protection as a defensive measure.
|
||||
|
||||
if Is_Expanded_Build_In_Place_Call (Func_Call) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Mark the call as processed as a build-in-place call
|
||||
|
||||
pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
|
||||
Set_Is_Expanded_Build_In_Place_Call (Func_Call);
|
||||
|
||||
Loc := Sloc (Function_Call);
|
||||
|
@ -7727,6 +7740,8 @@ package body Exp_Ch6 is
|
|||
|
||||
Return_Obj_Access := Make_Temporary (Loc, 'R');
|
||||
Set_Etype (Return_Obj_Access, Acc_Type);
|
||||
Set_Can_Never_Be_Null (Acc_Type, False);
|
||||
-- It gets initialized to null, so we can't have that.
|
||||
|
||||
-- When the result subtype is constrained, the return object is
|
||||
-- allocated on the caller side, and access to it is passed to the
|
||||
|
@ -7738,7 +7753,6 @@ package body Exp_Ch6 is
|
|||
-- the characteristics of the full view.
|
||||
|
||||
if Is_Constrained (Underlying_Type (Result_Subt)) then
|
||||
|
||||
-- Replace the initialized allocator of form "new T'(Func (...))"
|
||||
-- with an uninitialized allocator of form "new T", where T is the
|
||||
-- result subtype of the called function. The call to the function
|
||||
|
@ -8051,7 +8065,7 @@ package body Exp_Ch6 is
|
|||
Lhs : constant Node_Id := Name (Assign);
|
||||
Func_Call : constant Node_Id := Unqual_Conv (Function_Call);
|
||||
Func_Id : Entity_Id;
|
||||
Loc : Source_Ptr;
|
||||
Loc : constant Source_Ptr := Sloc (Function_Call);
|
||||
Obj_Decl : Node_Id;
|
||||
Obj_Id : Entity_Id;
|
||||
Ptr_Typ : Entity_Id;
|
||||
|
@ -8060,20 +8074,11 @@ package body Exp_Ch6 is
|
|||
Result_Subt : Entity_Id;
|
||||
|
||||
begin
|
||||
-- If the call has already been processed to add build-in-place actuals
|
||||
-- then return. This should not normally occur in an assignment context,
|
||||
-- but we add the protection as a defensive measure.
|
||||
|
||||
if Is_Expanded_Build_In_Place_Call (Func_Call) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Mark the call as processed as a build-in-place call
|
||||
|
||||
pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
|
||||
Set_Is_Expanded_Build_In_Place_Call (Func_Call);
|
||||
|
||||
Loc := Sloc (Function_Call);
|
||||
|
||||
if Is_Entity_Name (Name (Func_Call)) then
|
||||
Func_Id := Entity (Name (Func_Call));
|
||||
|
||||
|
@ -8131,6 +8136,13 @@ package body Exp_Ch6 is
|
|||
|
||||
New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
|
||||
|
||||
-- Add a conversion if it's the wrong type
|
||||
|
||||
if Etype (New_Expr) /= Ptr_Typ then
|
||||
New_Expr := Make_Unchecked_Type_Conversion (Loc,
|
||||
New_Occurrence_Of (Ptr_Typ, Loc), New_Expr);
|
||||
end if;
|
||||
|
||||
Obj_Id := Make_Temporary (Loc, 'R', New_Expr);
|
||||
Set_Etype (Obj_Id, Ptr_Typ);
|
||||
Set_Is_Known_Non_Null (Obj_Id);
|
||||
|
@ -8165,6 +8177,7 @@ package body Exp_Ch6 is
|
|||
Func_Call : constant Node_Id := Unqual_Conv (Function_Call);
|
||||
Function_Id : Entity_Id;
|
||||
Pool_Actual : Node_Id;
|
||||
Designated_Type : Entity_Id;
|
||||
Ptr_Typ : Entity_Id;
|
||||
Ptr_Typ_Decl : Node_Id;
|
||||
Pass_Caller_Acc : Boolean := False;
|
||||
|
@ -8172,16 +8185,9 @@ package body Exp_Ch6 is
|
|||
Result_Subt : Entity_Id;
|
||||
|
||||
begin
|
||||
-- If the call has already been processed to add build-in-place actuals
|
||||
-- then return. This should not normally occur in an object declaration,
|
||||
-- but we add the protection as a defensive measure.
|
||||
|
||||
if Is_Expanded_Build_In_Place_Call (Func_Call) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Mark the call as processed as a build-in-place call
|
||||
|
||||
pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
|
||||
Set_Is_Expanded_Build_In_Place_Call (Func_Call);
|
||||
|
||||
if Is_Entity_Name (Name (Func_Call)) then
|
||||
|
@ -8208,6 +8214,15 @@ package body Exp_Ch6 is
|
|||
-- access type must be declared before we establish a transient
|
||||
-- scope, so that it receives the proper accessibility level.
|
||||
|
||||
if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl)))
|
||||
and then not Is_Interface (Etype (Defining_Identifier (Obj_Decl)))
|
||||
and then not Is_Class_Wide_Type (Etype (Function_Call))
|
||||
then
|
||||
Designated_Type := Etype (Defining_Identifier (Obj_Decl));
|
||||
else
|
||||
Designated_Type := Etype (Function_Call);
|
||||
end if;
|
||||
|
||||
Ptr_Typ := Make_Temporary (Loc, 'A');
|
||||
Ptr_Typ_Decl :=
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
|
@ -8216,7 +8231,7 @@ package body Exp_Ch6 is
|
|||
Make_Access_To_Object_Definition (Loc,
|
||||
All_Present => True,
|
||||
Subtype_Indication =>
|
||||
New_Occurrence_Of (Etype (Function_Call), Loc)));
|
||||
New_Occurrence_Of (Designated_Type, Loc)));
|
||||
|
||||
-- The access type and its accompanying object must be inserted after
|
||||
-- the object declaration in the constrained case, so that the
|
||||
|
@ -8238,15 +8253,10 @@ package body Exp_Ch6 is
|
|||
|
||||
-- Force immediate freezing of Ptr_Typ because Res_Decl will be
|
||||
-- elaborated in an inner (transient) scope and thus won't cause
|
||||
-- freezing by itself.
|
||||
-- freezing by itself. It's not an itype, but it needs to be frozen
|
||||
-- inside the current subprogram (see Freeze_Outside in freeze.adb).
|
||||
|
||||
declare
|
||||
Ptr_Typ_Freeze_Ref : constant Node_Id :=
|
||||
New_Occurrence_Of (Ptr_Typ, Loc);
|
||||
begin
|
||||
Set_Parent (Ptr_Typ_Freeze_Ref, Ptr_Typ_Decl);
|
||||
Freeze_Expression (Ptr_Typ_Freeze_Ref);
|
||||
end;
|
||||
Freeze_Itype (Ptr_Typ, Ptr_Typ_Decl);
|
||||
|
||||
-- If the object is a return object of an enclosing build-in-place
|
||||
-- function, then the implicit build-in-place parameters of the
|
||||
|
@ -8424,13 +8434,25 @@ package body Exp_Ch6 is
|
|||
Set_Etype (Def_Id, Ptr_Typ);
|
||||
Set_Is_Known_Non_Null (Def_Id);
|
||||
|
||||
Res_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Def_Id,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc),
|
||||
Expression =>
|
||||
Make_Reference (Loc, Relocate_Node (Func_Call)));
|
||||
if Nkind (Function_Call) = N_Type_Conversion then
|
||||
Res_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Def_Id,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc),
|
||||
Expression =>
|
||||
Make_Unchecked_Type_Conversion (Loc,
|
||||
New_Occurrence_Of (Ptr_Typ, Loc),
|
||||
Make_Reference (Loc, Relocate_Node (Func_Call))));
|
||||
else
|
||||
Res_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Def_Id,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc),
|
||||
Expression =>
|
||||
Make_Reference (Loc, Relocate_Node (Func_Call)));
|
||||
end if;
|
||||
|
||||
Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
|
||||
|
||||
|
@ -8475,7 +8497,8 @@ package body Exp_Ch6 is
|
|||
Rewrite (Obj_Decl,
|
||||
Make_Object_Renaming_Declaration (Obj_Loc,
|
||||
Defining_Identifier => Make_Temporary (Obj_Loc, 'D'),
|
||||
Subtype_Mark => New_Occurrence_Of (Result_Subt, Obj_Loc),
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Designated_Type, Obj_Loc),
|
||||
Name => Call_Deref));
|
||||
|
||||
Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
|
||||
|
@ -8495,18 +8518,6 @@ package body Exp_Ch6 is
|
|||
(Obj_Decl, Original_Node (Obj_Decl));
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- If the object entity has a class-wide Etype, then we need to change
|
||||
-- it to the result subtype of the function call, because otherwise the
|
||||
-- object will be class-wide without an explicit initialization and
|
||||
-- won't be allocated properly by the back end. It seems unclean to make
|
||||
-- such a revision to the type at this point, and we should try to
|
||||
-- improve this treatment when build-in-place functions with class-wide
|
||||
-- results are implemented. ???
|
||||
|
||||
if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then
|
||||
Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt);
|
||||
end if;
|
||||
end Make_Build_In_Place_Call_In_Object_Declaration;
|
||||
|
||||
-------------------------------------------------
|
||||
|
@ -9225,6 +9236,11 @@ package body Exp_Ch6 is
|
|||
-- Start of processing for Unqual_BIP_Iface_Function_Call
|
||||
|
||||
begin
|
||||
if Nkind (Expr) = N_Identifier and then No (Entity (Expr)) then
|
||||
-- Can happen for X'Elab_Spec in the binder-generated file.
|
||||
return Empty;
|
||||
end if;
|
||||
|
||||
return Unqual_BIP_Function_Call (Expr);
|
||||
end Unqual_BIP_Iface_Function_Call;
|
||||
|
||||
|
|
|
@ -117,25 +117,30 @@ package Exp_Ch6 is
|
|||
-- The returned node is the root of the procedure body which will replace
|
||||
-- the original function body, which is not needed for the C program.
|
||||
|
||||
function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean;
|
||||
-- Ada 2005 (AI-318-02): Returns True if functions returning the type use
|
||||
-- build-in-place protocols. For inherently limited types, this must be
|
||||
-- True in >= Ada 2005, and must be False in Ada 95. For other types, it
|
||||
-- can be True or False, and the decision should be based on efficiency,
|
||||
-- and should be the same for all language versions, so that mixed-dialect
|
||||
-- programs will work.
|
||||
--
|
||||
-- For inherently limited types in Ada 2005, True means that calls will
|
||||
-- actually be build-in-place in all cases. For other types, build-in-place
|
||||
-- will be used when possible, but we need to make a copy at the call site
|
||||
-- in some cases, notably assignment statements.
|
||||
|
||||
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
|
||||
-- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
|
||||
-- function, or access-to-function type whose result must be built in
|
||||
-- place; otherwise returns False. For Ada 2005, this is currently
|
||||
-- restricted to the set of functions whose result subtype is an inherently
|
||||
-- limited type. In Ada 95, this must be False for inherently limited
|
||||
-- result types (but currently returns False for all Ada 95 functions).
|
||||
-- Eventually we plan to support build-in-place for nonlimited types.
|
||||
-- Build-in-place is usually more efficient for large things, and less
|
||||
-- efficient for small things. However, we never use build-in-place if the
|
||||
-- convention is other than Ada, because that would disturb mixed-language
|
||||
-- programs. Note that for the non-inherently-limited cases, we must make
|
||||
-- the same decision for Ada 95 and 2005, so that mixed-dialect programs
|
||||
-- will work.
|
||||
-- function, or access-to-function type for which
|
||||
-- Is_Build_In_Place_Result_Type is True. However, we never use
|
||||
-- build-in-place if the convention is other than Ada, because that would
|
||||
-- disturb mixed-language programs.
|
||||
|
||||
function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean;
|
||||
-- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function
|
||||
-- that requires handling as a build-in-place call or is a qualified
|
||||
-- expression applied to such a call; otherwise returns False.
|
||||
-- that requires handling as a build-in-place call (possibly qualified or
|
||||
-- converted).
|
||||
|
||||
function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
|
||||
-- Predicate to recognize stubbed procedures and null procedures, which
|
||||
|
@ -212,7 +217,7 @@ package Exp_Ch6 is
|
|||
(Obj_Decl : Node_Id;
|
||||
Function_Call : Node_Id);
|
||||
-- Ada 2005 (AI-318-02): Handle a call to a build-in-place function that
|
||||
-- occurs as the expression initializing an object declaration by passsing
|
||||
-- occurs as the expression initializing an object declaration by passing
|
||||
-- access to the declared object as an additional parameter of the function
|
||||
-- call. Function_Call must denote an expression containing a BIP function
|
||||
-- call and an enclosing call to Ada.Tags.Displace to displace the pointer
|
||||
|
|
|
@ -4057,7 +4057,7 @@ package body Exp_Ch7 is
|
|||
|
||||
-- This procedure is called each time a transient block has to be inserted
|
||||
-- that is to say for each call to a function with unconstrained or tagged
|
||||
-- result. It creates a new scope on the stack scope in order to enclose
|
||||
-- result. It creates a new scope on the scope stack in order to enclose
|
||||
-- all transient variables generated.
|
||||
|
||||
procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is
|
||||
|
|
|
@ -176,23 +176,16 @@ package body Exp_Ch8 is
|
|||
|
||||
-- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
|
||||
-- place function, then a temporary return object needs to be created
|
||||
-- and access to it must be passed to the function. Currently we limit
|
||||
-- such functions to those with inherently limited result subtypes, but
|
||||
-- eventually we plan to expand the functions that are treated as
|
||||
-- build-in-place to include other composite result types.
|
||||
-- and access to it must be passed to the function.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Nam)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Nam) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
|
||||
|
||||
-- Ada 2005 (AI-318-02): Specialization of previous case for renaming
|
||||
-- containing build-in-place function calls whose returned object covers
|
||||
-- interface types.
|
||||
|
||||
elsif Ada_Version >= Ada_2005
|
||||
and then Present (Unqual_BIP_Iface_Function_Call (Nam))
|
||||
then
|
||||
elsif Present (Unqual_BIP_Iface_Function_Call (Nam)) then
|
||||
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Nam);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -1640,9 +1640,7 @@ package body Exp_Disp is
|
|||
-- interface conversion, so if this is a BIP call then we need
|
||||
-- to handle it now.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Is_Build_In_Place_Function_Call (Actual)
|
||||
then
|
||||
if Is_Build_In_Place_Function_Call (Actual) then
|
||||
Make_Build_In_Place_Call_In_Anonymous_Context (Actual);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -649,7 +649,11 @@ package body Exp_Util is
|
|||
-- Do not process allocations on / deallocations from the secondary
|
||||
-- stack.
|
||||
|
||||
elsif Is_RTE (Pool_Id, RE_SS_Pool) then
|
||||
elsif Is_RTE (Pool_Id, RE_SS_Pool)
|
||||
or else
|
||||
(Nkind (Expr) = N_Allocator
|
||||
and then Is_RTE (Storage_Pool (Expr), RE_SS_Pool))
|
||||
then
|
||||
return;
|
||||
|
||||
-- Optimize the case where we are using the default Global_Pool_Object,
|
||||
|
@ -7857,6 +7861,8 @@ package body Exp_Util is
|
|||
Call := Prefix (Call);
|
||||
end if;
|
||||
|
||||
Call := Unqual_Conv (Call);
|
||||
|
||||
if Is_Build_In_Place_Function_Call (Call) then
|
||||
declare
|
||||
Access_Nam : Name_Id := No_Name;
|
||||
|
@ -8679,9 +8685,7 @@ package body Exp_Util is
|
|||
|
||||
Param := First (Parameter_Associations (Call));
|
||||
while Present (Param) loop
|
||||
if Nkind (Param) = N_Parameter_Association
|
||||
and then Nkind (Selector_Name (Param)) = N_Identifier
|
||||
then
|
||||
if Nkind (Param) = N_Parameter_Association then
|
||||
Formal := Selector_Name (Param);
|
||||
Actual := Explicit_Actual_Parameter (Param);
|
||||
|
||||
|
|
|
@ -1372,9 +1372,9 @@ package Sinfo is
|
|||
-- up. For nested aggregates the expansion is delayed until the enclosing
|
||||
-- aggregate itself is expanded, e.g. in the context of a declaration. To
|
||||
-- delay it we set this flag. This is done to avoid creating a temporary
|
||||
-- for each level of a nested aggregates, and also to prevent the
|
||||
-- for each level of a nested aggregate, and also to prevent the
|
||||
-- premature generation of constraint checks. This is also a requirement
|
||||
-- if we want to generate the proper attachment to the internal
|
||||
-- if we want to generate the proper attachment to the internal????
|
||||
-- finalization lists (for record with controlled components). Top down
|
||||
-- expansion of aggregates is also used for in-place array aggregate
|
||||
-- assignment or initialization. When the full context is known, the
|
||||
|
@ -2917,7 +2917,7 @@ package Sinfo is
|
|||
-- case the front end must generate an extra temporary and initialize
|
||||
-- this temporary as required (the temporary itself is not atomic).
|
||||
|
||||
-- Note: there is not node kind for object definition. Instead, the
|
||||
-- Note: there is no node kind for object definition. Instead, the
|
||||
-- corresponding field holds a subtype indication, an array type
|
||||
-- definition, or (Ada 2005, AI-406) an access definition.
|
||||
|
||||
|
|
|
@ -328,7 +328,7 @@ package Snames is
|
|||
|
||||
-- Operator Symbol entries. The actual names have an upper case O at the
|
||||
-- start in place of the Op_ prefix (e.g. the actual name that corresponds
|
||||
-- to Name_Op_Abs is "Oabs".
|
||||
-- to Name_Op_Abs is "Oabs").
|
||||
|
||||
First_Operator_Name : constant Name_Id := N + $;
|
||||
Name_Op_Abs : constant Name_Id := N + $; -- "abs"
|
||||
|
|
Loading…
Reference in New Issue