https://gcc.gnu.org/g:9c399e7ef2dfae46b6abb34842a8769376f623c9
commit r15-6133-g9c399e7ef2dfae46b6abb34842a8769376f623c9
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Thu Nov 14 20:33:34 2024 +0100
ada: Clean up and restrict usage of Initialization_Statements
This mechanism is the only producer of N_Compound_Statement in the expanded
code and parks the statements generated for the in-place initialization of
objects by an aggregate, so that they can be moved to the freeze point if
there is an address aspect/clause, or even cancelled if the aggregate has
been generated for Initialize_Scalars/Normalize_Scalars before a subsequent
pragma Import for the object is encountered.
The main condition for its triggering is that the object be not yet frozen,
but that's always the case when its declaration is being processed, so the
mechanism is triggered unnecessarily and the change restricts this but, on
the other hand, it also extends its usage to the in-place initialization by
a function call, which was implemented by means of a custom deferral.
There should be no functional changes.
gcc/ada/ChangeLog:
* einfo.ads (Initialization_Statements): Document usage precisely.
* exp_aggr.adb (Convert_Aggr_In_Object_Decl): Do not create a
compound statement in most cases, do it only if necessary.
* exp_ch3.adb (Expand_N_Object_Declaration): Remove a couple of
useless statements.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
Use the Initialization_Statements mechanism if necessary.
* exp_ch7.adb: Remove clauses for Aspects package.
(Insert_Actions_In_Scope_Around): Use the support code of Exp_Util
for the Initialization_Statements mechanism.
* exp_prag.adb (Undo_Initialization): Remove obsolete code.
* exp_util.ads (Move_To_Initialization_Statements): New procedure.
(Needs_Initialization_Statements): New function.
* exp_util.adb (Move_To_Initialization_Statements): New procedure.
(Needs_Initialization_Statements): New predicate.
Diff:
---
gcc/ada/einfo.ads | 12 ++++++---
gcc/ada/exp_aggr.adb | 56 ++++++++++++++------------------------
gcc/ada/exp_ch3.adb | 2 --
gcc/ada/exp_ch6.adb | 76 +++++++++-------------------------------------------
gcc/ada/exp_ch7.adb | 26 +++---------------
gcc/ada/exp_prag.adb | 21 ---------------
gcc/ada/exp_util.adb | 37 +++++++++++++++++++++++++
gcc/ada/exp_util.ads | 12 +++++++++
8 files changed, 94 insertions(+), 148 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8255ae956833..f929c26571d6 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2270,10 +2270,14 @@ package Einfo is
-- call wrapper if available.
-- Initialization_Statements
--- Defined in constants and variables. For a composite object initialized
--- with an aggregate that has been converted to a sequence of
--- assignments, points to a compound statement containing the
--- assignments.
+-- Defined in constants and variables. For a composite object coming from
+-- source and initialized with an aggregate or a call expanded in place,
+-- points to a compound statement containing the assignment(s). This is
+-- used for a couple of purposes: 1) to defer the initialization to the
+-- freeze point if an address aspect/clause is present for the object,
+-- 2) to cancel the initialization of imported objects generated by
+-- Initialize_Scalars or Normalize_Scalars before the pragma Import is
+-- encountered for the object.
-- Inner_Instances
-- Defined in generic units. Contains element list of units that are
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a82705dca3fc..9162e9694f9e 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3576,10 +3576,11 @@ package body Exp_Aggr is
---------------------------------
procedure Convert_Aggr_In_Object_Decl (N : Node_Id) is
- Obj : constant Entity_Id := Defining_Identifier (N);
- Aggr : constant Node_Id := Unqualify (Expression (N));
- Loc : constant Source_Ptr := Sloc (Aggr);
- Typ : constant Entity_Id := Etype (Aggr);
+ Obj : constant Entity_Id := Defining_Identifier (N);
+ Aggr : constant Node_Id := Unqualify (Expression (N));
+ Loc : constant Source_Ptr := Sloc (Aggr);
+ Typ : constant Entity_Id := Etype (Aggr);
+ Marker : constant Node_Id := Next (N);
function Discriminants_Ok return Boolean;
-- If the object's subtype is constrained, the discriminants in the
@@ -3651,11 +3652,10 @@ package body Exp_Aggr is
-- Local variables
- Has_Transient_Scope : Boolean;
- Occ : Node_Id;
- Param : Node_Id;
- Stmt : Node_Id;
- Stmts : List_Id;
+ Occ : Node_Id;
+ Param : Node_Id;
+ Stmt : Node_Id;
+ Stmts : List_Id;
-- Start of processing for Convert_Aggr_In_Object_Decl
@@ -3685,39 +3685,14 @@ 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, Manage_Sec_Stack => False);
- Has_Transient_Scope := True;
- else
- Has_Transient_Scope := False;
+ Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
Occ := New_Occurrence_Of (Obj, Loc);
Set_Assignment_OK (Occ);
Stmts := Late_Expansion (Aggr, Typ, Occ);
- -- If Obj is already frozen or if N is wrapped in a transient scope,
- -- Stmts do not need to be saved in Initialization_Statements since
- -- there is no freezing issue.
-
- if Is_Frozen (Obj) or else Has_Transient_Scope then
- Insert_Actions_After (N, Stmts);
-
- else
- Stmt := Make_Compound_Statement (Sloc (N), Actions => Stmts);
- Insert_Action_After (N, Stmt);
-
- -- Insert_Action_After may freeze Obj in which case we should
- -- remove the compound statement just created and simply insert
- -- Stmts after N.
-
- if Is_Frozen (Obj) then
- Remove (Stmt);
- Insert_Actions_After (N, Stmts);
-
- else
- Set_Initialization_Statements (Obj, Stmt);
- end if;
- end if;
+ Insert_Actions_After (N, Stmts);
-- If Typ has controlled components and a call to a Slice_Assign
-- procedure is part of the initialization statements, then we
@@ -3752,6 +3727,15 @@ package body Exp_Aggr is
Set_No_Initialization (N);
Initialize_Discriminants (N, Typ);
+
+ -- Park the generated statements if the declaration requires it and is
+ -- not the node that is wrapped in a transient scope.
+
+ if Needs_Initialization_Statements (N)
+ and then not (Scope_Is_Transient and then N = Node_To_Be_Wrapped)
+ then
+ Move_To_Initialization_Statements (N, Marker);
+ end if;
end Convert_Aggr_In_Object_Decl;
------------------------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e60a5f6ddafa..45ea858c9616 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7639,8 +7639,6 @@ package body Exp_Ch3 is
or else Has_Aspect (Def_Id, Aspect_Address)
then
Ensure_Freeze_Node (Def_Id);
- Set_Has_Delayed_Freeze (Def_Id);
- Set_Is_Frozen (Def_Id, False);
if not Partial_View_Has_Unknown_Discr (Typ) then
Append_Freeze_Action (Def_Id,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 7839b6716328..20ce7a5b2395 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -8764,6 +8764,7 @@ package body Exp_Ch6 is
Func_Call : constant Node_Id := Unqual_Conv (Function_Call);
Function_Id : constant Entity_Id := Get_Function_Id (Func_Call);
Loc : constant Source_Ptr := Sloc (Function_Call);
+ Marker : constant Node_Id := Next (Obj_Decl);
Obj_Loc : constant Source_Ptr := Sloc (Obj_Decl);
Obj_Def_Id : constant Entity_Id := Defining_Identifier (Obj_Decl);
Obj_Typ : constant Entity_Id := Etype (Obj_Def_Id);
@@ -8843,71 +8844,10 @@ package body Exp_Ch6 is
-- if the object declaration is for a return object, the access type and
-- object must be inserted before the object, since the object
-- declaration is rewritten to be a renaming of a dereference of the
- -- access object. Note: we need to freeze Ptr_Typ explicitly, because
- -- the result object is in a different (transient) scope, so won't cause
- -- freezing.
+ -- access object.
if Definite and then not Is_OK_Return_Object then
-
- -- The presence of an address clause complicates the build-in-place
- -- expansion because the indicated address must be processed before
- -- the indirect call is generated (including the definition of a
- -- local pointer to the object). The address clause may come from
- -- an aspect specification or from an explicit attribute
- -- specification appearing after the object declaration. These two
- -- cases require different processing.
-
- if Has_Aspect (Obj_Def_Id, Aspect_Address) then
-
- -- Skip non-delayed pragmas that correspond to other aspects, if
- -- any, to find proper insertion point for freeze node of object.
-
- declare
- D : Node_Id := Obj_Decl;
- N : Node_Id := Next (D);
-
- begin
- while Present (N)
- and then Nkind (N) in N_Attribute_Reference | N_Pragma
- loop
- Analyze (N);
- D := N;
- Next (N);
- end loop;
-
- Insert_After (D, Ptr_Typ_Decl);
-
- -- Freeze object before pointer declaration, to ensure that
- -- generated attribute for address is inserted at the proper
- -- place.
-
- Freeze_Before (Ptr_Typ_Decl, Obj_Def_Id);
- end;
-
- Analyze (Ptr_Typ_Decl);
-
- elsif Present (Following_Address_Clause (Obj_Decl)) then
-
- -- Locate explicit address clause, which may also follow pragmas
- -- generated by other aspect specifications.
-
- declare
- Addr : constant Node_Id := Following_Address_Clause (Obj_Decl);
- D : Node_Id := Next (Obj_Decl);
-
- begin
- while Present (D) loop
- Analyze (D);
- exit when D = Addr;
- Next (D);
- end loop;
-
- Insert_After_And_Analyze (Addr, Ptr_Typ_Decl);
- end;
-
- else
- Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl);
- end if;
+ Insert_Action_After (Obj_Decl, Ptr_Typ_Decl);
else
Insert_Action (Obj_Decl, Ptr_Typ_Decl);
end if;
@@ -9146,6 +9086,16 @@ package body Exp_Ch6 is
Set_Expression (Obj_Decl, Empty);
Set_No_Initialization (Obj_Decl);
+ -- Park the generated statements if the declaration requires it and
+ -- is not the node that is wrapped in a transient scope.
+
+ if Needs_Initialization_Statements (Obj_Decl)
+ and then not (Scope_Is_Transient
+ and then Obj_Decl = Node_To_Be_Wrapped)
+ then
+ Move_To_Initialization_Statements (Obj_Decl, Marker);
+ end if;
+
-- In case of an indefinite result subtype, or if the call is the
-- return expression of an enclosing BIP function, rewrite the object
-- declaration as an object renaming where the renamed object is a
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index aed6bcf356f1..d3cc6c70d974 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -27,7 +27,6 @@
-- - controlled types
-- - transient scopes
-with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
@@ -5470,31 +5469,14 @@ package body Exp_Ch7 is
Related_Node => Target);
end if;
- -- If the target is the declaration of an object with an address clause
- -- or aspect, move all the statements that have been inserted after it
- -- into its Initialization_Statements list, so they can be inserted into
- -- its freeze actions later.
+ -- If the target is the declaration of an object, park the generated
+ -- statements if need be.
if Nkind (Target) = N_Object_Declaration
- and then (Present (Following_Address_Clause (Target))
- or else
- Has_Aspect (Defining_Identifier (Target), Aspect_Address))
and then Next (Target) /= Marker
+ and then Needs_Initialization_Statements (Target)
then
- declare
- Obj_Id : constant Entity_Id := Defining_Identifier (Target);
- Stmts : constant List_Id := New_List;
-
- begin
- while Next (Target) /= Marker loop
- Append_To (Stmts, Remove_Next (Target));
- end loop;
-
- pragma Assert (No (Initialization_Statements (Obj_Id)));
-
- Set_Initialization_Statements
- (Obj_Id, Make_Compound_Statement (Loc, Actions => Stmts));
- end;
+ Move_To_Initialization_Statements (Target, Marker);
end if;
-- Reset the action lists
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 6c328ef36ce9..bb4978236adc 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -3369,27 +3369,6 @@ package body Exp_Prag is
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
-
- -- The object may not have any initialization, but in the presence of
- -- Initialize_Scalars code is inserted after then declaration, which
- -- must now be removed as well. The code carries the same source
- -- location as the declaration itself.
-
- if Initialize_Scalars and then Is_Array_Type (Etype (Def_Id)) then
- declare
- Init : Node_Id;
- Nxt : Node_Id;
- begin
- Init := Next (Parent (Def_Id));
- while not Comes_From_Source (Init)
- and then Sloc (Init) = Sloc (Def_Id)
- loop
- Nxt := Next (Init);
- Remove (Init);
- Init := Nxt;
- end loop;
- end;
- end if;
end Undo_Initialization;
end Exp_Prag;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 149be620b1b4..99aacc763a18 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11558,6 +11558,27 @@ package body Exp_Util is
return True;
end May_Generate_Large_Temp;
+ ---------------------------------------
+ -- Move_To_Initialization_Statements --
+ ---------------------------------------
+
+ procedure Move_To_Initialization_Statements (Decl, Stop : Node_Id) is
+ Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
+ Stmts : constant List_Id := New_List;
+ Stmt : constant Node_Id :=
+ Make_Compound_Statement (Sloc (Decl), Actions => Stmts);
+
+ begin
+ while Next (Decl) /= Stop loop
+ Append_To (Stmts, Remove_Next (Decl));
+ end loop;
+
+ pragma Assert (No (Initialization_Statements (Obj_Id)));
+
+ Insert_After (Decl, Stmt);
+ Set_Initialization_Statements (Obj_Id, Stmt);
+ end Move_To_Initialization_Statements;
+
--------------------------------
-- Name_Of_Controlled_Prim_Op --
--------------------------------
@@ -11663,6 +11684,22 @@ package body Exp_Util is
end if;
end Needs_Constant_Address;
+ -------------------------------------
+ -- Needs_Initialization_Statements --
+ -------------------------------------
+
+ function Needs_Initialization_Statements (Decl : Node_Id) return Boolean is
+ Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
+
+ begin
+ -- See the documentation of Initialization_Statements in Einfo
+
+ return Comes_From_Source (Decl)
+ and then (Has_Aspect (Obj_Id, Aspect_Address)
+ or else Present (Following_Address_Clause (Decl))
+ or else Init_Or_Norm_Scalars);
+ end Needs_Initialization_Statements;
+
----------------------------
-- New_Class_Wide_Subtype --
----------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 751fb5b31e08..b906dccaeb9b 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -1011,6 +1011,18 @@ package Exp_Util is
-- caller has to check whether stack checking is actually enabled in order
-- to guide the expansion (typically of a function call).
+ procedure Move_To_Initialization_Statements (Decl, Stop : Node_Id);
+ -- Decl is an N_Object_Declaration node and Stop is a node past Decl in
+ -- the same list. Move all the nodes on the list between Decl and Stop
+ -- (excluded) into a compound statement inserted between Decl and Stop
+ -- and attached to the object by means of Initialization_Statements.
+
+ function Needs_Initialization_Statements (Decl : Node_Id) return Boolean;
+ -- Decl is the N_Object_Declaration node of an object initialized with an
+ -- aggregate or a call expanded in place. Return True if the statements
+ -- created by expansion need to be moved to the Initialization_Statements
+ -- of the object.
+
function Name_Of_Controlled_Prim_Op
(Typ : Entity_Id;
Nam : Name_Id) return Name_Id
