and then Is_Return_Object (Defining_Entity (Par)));
end Is_Expression_Of_Func_Return;
+ ---------------------------
+ -- Is_Finalizable_Access --
+ ---------------------------
+
+ function Is_Finalizable_Access (Decl : Node_Id) return Boolean is
+ Obj : constant Entity_Id := Defining_Identifier (Decl);
+ Typ : constant Entity_Id := Base_Type (Etype (Obj));
+ Desig : constant Entity_Id := Available_View (Designated_Type (Typ));
+ Expr : constant Node_Id := Expression (Decl);
+
+ Secondary_Stack_Val : constant Uint :=
+ UI_From_Int (BIP_Allocation_Form'Pos (Secondary_Stack));
+
+ Actual : Node_Id;
+ Call : Node_Id;
+ Formal : Node_Id;
+ Param : Node_Id;
+
+ begin
+ -- The prerequisite is a reference to a controlled object
+
+ if No (Expr)
+ or else Nkind (Expr) /= N_Reference
+ or else not Needs_Finalization (Desig)
+ then
+ return False;
+ end if;
+
+ Call := Unqual_Conv (Prefix (Expr));
+
+ -- For a BIP function call, the only case where the return object needs
+ -- to be finalized through Obj is when it is allocated on the secondary
+ -- stack; when it is allocated in the caller, it is finalized directly,
+ -- and when it is allocated on the global heap or in a storage pool, it
+ -- is finalized through another mechanism.
+
+ -- Obj : Access_Typ :=
+ -- BIP_Function_Call (BIPalloc => Secondary_Stack, ...)'reference;
+
+ if Is_Build_In_Place_Function_Call (Call) then
+
+ -- Examine all parameter associations of the function call
+
+ Param := First (Parameter_Associations (Call));
+ while Present (Param) loop
+ if Nkind (Param) = N_Parameter_Association then
+ Formal := Selector_Name (Param);
+ Actual := Explicit_Actual_Parameter (Param);
+
+ -- A match for BIPalloc => Secondary_Stack has been found
+
+ if Is_Build_In_Place_Entity (Formal)
+ and then BIP_Suffix_Kind (Formal) = BIP_Alloc_Form
+ and then Nkind (Actual) = N_Integer_Literal
+ and then Intval (Actual) = Secondary_Stack_Val
+ then
+ return True;
+ end if;
+ end if;
+
+ Next (Param);
+ end loop;
+
+ -- For a non-BIP function call, the only case where the return object
+ -- need not be finalized is when it itself is going to be returned.
+
+ -- Obj : Typ := Non_BIP_Function_Call'reference;
+
+ elsif Nkind (Call) = N_Function_Call
+ and then not Is_Related_To_Func_Return (Obj)
+ then
+ return True;
+ end if;
+
+ return False;
+ end Is_Finalizable_Access;
+
------------------------------
-- Is_Finalizable_Transient --
------------------------------
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
- function Initialized_By_Aliased_BIP_Func_Call
- (Trans_Id : Entity_Id) return Boolean;
- -- Determine whether transient object Trans_Id is initialized by a
- -- build-in-place function call where the BIPalloc parameter either
- -- does not exist or is Caller_Allocation, and BIPaccess is not null.
- -- This case creates an aliasing between the returned value and the
- -- value denoted by BIPaccess.
-
- function Initialized_By_Reference (Trans_Id : Entity_Id) return Boolean;
- -- Determine whether transient object Trans_Id is initialized by a
- -- reference to another object. This is the only case where we can
- -- possibly finalize a transient object through an access value.
-
function Is_Aliased
(Trans_Id : Entity_Id;
First_Stmt : Node_Id) return Boolean;
-- Return True if N is directly part of a build-in-place return
-- statement.
- ------------------------------------------
- -- Initialized_By_Aliased_BIP_Func_Call --
- ------------------------------------------
-
- function Initialized_By_Aliased_BIP_Func_Call
- (Trans_Id : Entity_Id) return Boolean
- is
- Call : Node_Id := Expression (Parent (Trans_Id));
-
- begin
- -- Build-in-place calls usually appear in 'reference format
-
- if Nkind (Call) = N_Reference then
- Call := Prefix (Call);
- end if;
-
- Call := Unqual_Conv (Call);
-
- -- We search for a formal with a matching suffix. We can't search
- -- for the full name, because of the code at the end of Sem_Ch6.-
- -- Create_Extra_Formals, which copies the Extra_Formals over to
- -- the Alias of an instance, which will cause the formals to have
- -- "incorrect" names. See also Exp_Ch6.Build_In_Place_Formal.
-
- if Is_Build_In_Place_Function_Call (Call) then
- declare
- Caller_Allocation_Val : constant Uint :=
- UI_From_Int (BIP_Allocation_Form'Pos (Caller_Allocation));
- Access_Suffix : constant String :=
- BIP_Formal_Suffix (BIP_Object_Access);
- Alloc_Suffix : constant String :=
- BIP_Formal_Suffix (BIP_Alloc_Form);
-
- function Has_Suffix (Name, Suffix : String) return Boolean;
- -- Return True if Name has suffix Suffix
-
- ----------------
- -- Has_Suffix --
- ----------------
-
- function Has_Suffix (Name, Suffix : String) return Boolean is
- Len : constant Natural := Suffix'Length;
-
- begin
- return Name'Length > Len
- and then Name (Name'Last - Len + 1 .. Name'Last) = Suffix;
- end Has_Suffix;
-
- Access_OK : Boolean := False;
- Alloc_OK : Boolean := True;
- Param : Node_Id;
-
- begin
- -- Examine all parameter associations of the function call
-
- Param := First (Parameter_Associations (Call));
-
- while Present (Param) loop
- if Nkind (Param) = N_Parameter_Association
- and then Nkind (Selector_Name (Param)) = N_Identifier
- then
- declare
- Actual : constant Node_Id :=
- Explicit_Actual_Parameter (Param);
- Formal : constant Node_Id :=
- Selector_Name (Param);
- Name : constant String :=
- Get_Name_String (Chars (Formal));
-
- begin
- -- A nonnull BIPaccess has been found
-
- if Has_Suffix (Name, Access_Suffix)
- and then Nkind (Actual) /= N_Null
- then
- Access_OK := True;
-
- -- A BIPalloc has been found
-
- elsif Has_Suffix (Name, Alloc_Suffix)
- and then Nkind (Actual) = N_Integer_Literal
- then
- Alloc_OK := Intval (Actual) = Caller_Allocation_Val;
- end if;
- end;
- end if;
-
- Next (Param);
- end loop;
-
- return Access_OK and Alloc_OK;
- end;
- end if;
-
- return False;
- end Initialized_By_Aliased_BIP_Func_Call;
-
- ------------------------------
- -- Initialized_By_Reference --
- ------------------------------
-
- function Initialized_By_Reference (Trans_Id : Entity_Id) return Boolean
- is
- Expr : constant Node_Id := Expression (Parent (Trans_Id));
-
- begin
- return Present (Expr) and then Nkind (Expr) = N_Reference;
- end Initialized_By_Reference;
-
----------------
-- Is_Aliased --
----------------
Stmt := First_Stmt;
while Present (Stmt) loop
- -- Transient objects initialized by a reference are finalized
- -- (see Initialized_By_Reference above), so we must make sure
- -- not to finalize the referenced object twice. And we cannot
- -- finalize it at all if it is referenced by the nontransient
- -- object serviced by the transient scope.
-
- if Nkind (Stmt) = N_Object_Declaration then
+ -- (Transient) objects initialized by a reference to another named
+ -- object are never finalized (see Is_Finalizable_Access), so we
+ -- need not worry about finalizing (transient) referenced objects
+ -- twice. Therefore, we only need to look at the nontransient
+ -- object serviced by the transient scope, if it exists and is
+ -- declared as a reference to another named object.
+
+ if Nkind (Stmt) = N_Object_Declaration
+ and then Stmt = N
+ then
Expr := Expression (Stmt);
-- Aliasing of the form:
return True;
end if;
- -- (Transient) renamings are never finalized so we need not bother
- -- about finalizing transient renamed objects twice. Therefore, we
+ -- (Transient) renamings are never finalized so we need not worry
+ -- about finalizing (transient) renamed objects twice. Therefore,
-- we only need to look at the nontransient object serviced by the
-- transient scope, if it exists and is declared as a renaming.
function Is_Part_Of_BIP_Return_Statement (N : Node_Id) return Boolean is
Subp : constant Entity_Id := Current_Subprogram;
Context : Node_Id;
+
begin
-- First check if N is part of a BIP function
- if No (Subp)
- or else not Is_Build_In_Place_Function (Subp)
- then
+ if No (Subp) or else not Is_Build_In_Place_Function (Subp) then
return False;
end if;
-- Start of processing for Is_Finalizable_Transient
begin
+ -- If the node serviced by the transient context is a return statement,
+ -- then the finalization needs to be deferred to the generic machinery.
+
+ if Nkind (N) = N_Simple_Return_Statement
+ or else Is_Part_Of_BIP_Return_Statement (N)
+ then
+ return False;
+ end if;
+
-- Handle access types
if Is_Access_Type (Desig) then
return
Ekind (Obj_Id) in E_Constant | E_Variable
and then Needs_Finalization (Desig)
- and then Nkind (N) /= N_Simple_Return_Statement
- and then not Is_Part_Of_BIP_Return_Statement (N)
-- Do not consider a transient object that was already processed
and then not Is_Finalized_Transient (Obj_Id)
- -- Do not consider renamed or 'reference-d transient objects because
- -- the act of renaming extends the object's lifetime.
+ -- Do not consider iterators because those are treated as normal
+ -- controlled objects and are processed by the usual finalization
+ -- machinery. This avoids the double finalization of an iterator.
- and then not Is_Aliased (Obj_Id, Decl)
+ and then not Is_Iterator (Desig)
- -- If the transient object is of an access type, check that it is
- -- initialized by a reference to another object.
+ -- If the transient object is of an access type, check that it must
+ -- be finalized.
and then (not Is_Access_Type (Obj_Typ)
- or else Initialized_By_Reference (Obj_Id))
-
- -- Do not consider transient objects which act as indirect aliases
- -- of build-in-place function results.
+ or else Is_Finalizable_Access (Decl))
- and then not Initialized_By_Aliased_BIP_Func_Call (Obj_Id)
-
- -- Do not consider iterators because those are treated as normal
- -- controlled objects and are processed by the usual finalization
- -- machinery. This avoids the double finalization of an iterator.
+ -- Do not consider renamed transient objects because the act of
+ -- renaming extends the object's lifetime.
- and then not Is_Iterator (Desig)
+ and then not Is_Aliased (Obj_Id, Decl)
-- Do not consider containers in the context of iterator loops. Such
-- transient objects must exist for as long as the loop is around,
and then Present (LSP_Subprogram (E));
end Is_LSP_Wrapper;
- --------------------------
- -- Is_Non_BIP_Func_Call --
- --------------------------
-
- function Is_Non_BIP_Func_Call (Expr : Node_Id) return Boolean is
- begin
- -- The expected call is of the format
- --
- -- Func_Call'reference
-
- return
- Nkind (Expr) = N_Reference
- and then Nkind (Prefix (Expr)) = N_Function_Call
- and then not Is_Build_In_Place_Function_Call (Prefix (Expr));
- end Is_Non_BIP_Func_Call;
-
----------------------------------
-- Is_Possibly_Unaligned_Object --
----------------------------------
end if;
end Is_Renamed_Object;
- --------------------------------------
- -- Is_Secondary_Stack_BIP_Func_Call --
- --------------------------------------
-
- function Is_Secondary_Stack_BIP_Func_Call (Expr : Node_Id) return Boolean is
- Actual : Node_Id;
- Call : Node_Id := Expr;
- Formal : Node_Id;
- Param : Node_Id;
-
- begin
- -- Build-in-place calls usually appear in 'reference format. Note that
- -- the accessibility check machinery may add an extra 'reference due to
- -- side-effect removal.
-
- while Nkind (Call) = N_Reference loop
- Call := Prefix (Call);
- end loop;
-
- Call := Unqual_Conv (Call);
-
- if Is_Build_In_Place_Function_Call (Call) then
-
- -- Examine all parameter associations of the function call
-
- Param := First (Parameter_Associations (Call));
- while Present (Param) loop
- if Nkind (Param) = N_Parameter_Association then
- Formal := Selector_Name (Param);
- Actual := Explicit_Actual_Parameter (Param);
-
- -- A match for BIPalloc => 2 has been found
-
- if Is_Build_In_Place_Entity (Formal)
- and then BIP_Suffix_Kind (Formal) = BIP_Alloc_Form
- and then Nkind (Actual) = N_Integer_Literal
- and then Intval (Actual) = Uint_2
- then
- return True;
- end if;
- end if;
-
- Next (Param);
- end loop;
- end if;
-
- return False;
- end Is_Secondary_Stack_BIP_Func_Call;
-
------------------------------
-- Is_Secondary_Stack_Thunk --
------------------------------
Nested_Constructs : Boolean) return Boolean
is
Decl : Node_Id;
- Expr : Node_Id;
Obj_Id : Entity_Id;
Obj_Typ : Entity_Id;
Pack_Id : Entity_Id;
elsif Nkind (Decl) = N_Object_Declaration then
Obj_Id := Defining_Identifier (Decl);
Obj_Typ := Base_Type (Etype (Obj_Id));
- Expr := Expression (Decl);
-- Bypass any form of processing for objects which have their
-- finalization disabled. This applies only to objects at the
then
return True;
- -- The object is of the form:
- -- Obj : Access_Typ := Non_BIP_Function_Call'reference;
- --
- -- Obj : Access_Typ :=
- -- BIP_Function_Call (BIPalloc => 2, ...)'reference;
+ -- The object is an access-to-controlled that must be finalized
elsif Is_Access_Type (Obj_Typ)
- and then Needs_Finalization
- (Available_View (Designated_Type (Obj_Typ)))
- and then Present (Expr)
- and then
- (Is_Secondary_Stack_BIP_Func_Call (Expr)
- or else
- (Is_Non_BIP_Func_Call (Expr)
- and then not Is_Related_To_Func_Return (Obj_Id)))
+ and then Is_Finalizable_Access (Decl)
then
return True;
when N_Aggregate =>
return Compile_Time_Known_Aggregate (N);
+ -- A reference is side-effect-free
+
+ when N_Reference =>
+ return True;
+
-- We consider that anything else has side effects. This is a bit
-- crude, but we are pretty close for most common cases, and we
-- are certainly correct (i.e. we never return True when the
projects / thirdparty / gcc.git / commitdiff
