OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Bob Duff 2017-09-29 13:48:57 +00:00 committed by Pierre-Marie de Rodat
parent 52c6ab7443
commit d4dfb00562
15 changed files with 360 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
gcc/ada/ChangeLog
View File

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

5
gcc/ada/debug.adb
View File

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

146
gcc/ada/exp_aggr.adb
View File

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

13
gcc/ada/exp_attr.adb
View File

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

32
gcc/ada/exp_ch3.adb
View File

@ -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 ???

46
gcc/ada/exp_ch4.adb
View File

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

12
gcc/ada/exp_ch5.adb
View File

@ -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)

248
gcc/ada/exp_ch6.adb
View File

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

35
gcc/ada/exp_ch6.ads
View File

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

2
gcc/ada/exp_ch7.adb
View File

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

13
gcc/ada/exp_ch8.adb
View File

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

4
gcc/ada/exp_disp.adb
View File

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

12
gcc/ada/exp_util.adb
View File

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

6
gcc/ada/sinfo.ads
View File

@ -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.

2
gcc/ada/snames.ads-tmpl
View File

@ -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"