-- 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
---------------------------------
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
-- 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
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
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;
------------------------
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,
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);
-- 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;
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
-- - controlled types
-- - transient scopes
-with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
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
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;
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 --
--------------------------------
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 --
----------------------------
-- 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
projects / thirdparty / gcc.git / commitdiff
