function Safe_Component (Expr : Node_Id) return Boolean;
-- Verify that an expression cannot depend on the target being assigned
- -- to. Return true for compile-time known values, stand-alone objects,
- -- parameters passed by copy, calls to functions that return by copy,
+ -- (which is Target_Object if it is set), return true for compile-time
+ -- known values, stand-alone objects, formal parameters passed by copy,
-- selected components thereof only if the aggregate's type is an array,
-- indexed components and slices thereof only if the aggregate's type is
-- a record, and simple expressions involving only these as operands.
-- which is excluded by the above condition. Additionally, if the target
-- is statically known, return true for arbitrarily nested selections,
-- indexations or slicings, provided that their ultimate prefix is not
- -- the target itself.
+ -- the target itself, and calls to functions that take only these as
+ -- actual parameters provided that the target is not aliased.
--------------------
-- Safe_Aggregate --
return Check_Component (Prefix (C), T_OK);
when N_Function_Call =>
- if Nkind (Name (C)) = N_Explicit_Dereference then
- return not Returns_By_Ref (Etype (Name (C)));
- else
- return not Returns_By_Ref (Entity (Name (C)));
+ if No (Target_Object) or else Is_Aliased (Target_Object) then
+ return False;
end if;
+ if Present (Parameter_Associations (C)) then
+ declare
+ Actual : Node_Id;
+ begin
+ Actual := First_Actual (C);
+ while Present (Actual) loop
+ if not Check_Component (Actual, T_OK) then
+ return False;
+ end if;
+ Next_Actual (Actual);
+ end loop;
+ end;
+ end if;
+
+ return True;
+
when N_Indexed_Component | N_Slice =>
-- In a target record, these operations cannot determine
-- alone a component so we can recurse whatever the target.
-- excluding container aggregates as these are transformed into
-- subprogram calls later.
- (Nkind (Parent_Node) = N_Component_Association
- and then not Is_Container_Aggregate (Parent (Parent_Node)))
-
- or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate
- and then not Is_Container_Aggregate (Parent_Node))
+ Parent_Is_Regular_Aggregate (Parent_Node)
-- Allocator (see Convert_Aggr_In_Allocator)
if
-- Internal aggregates (transformed when expanding the parent),
-- excluding container aggregates as these are transformed into
- -- subprogram calls later. So far aggregates with self-references
- -- are not supported if they appear in a conditional expression.
-
- (Nkind (Parent_Node) = N_Component_Association
- and then not Is_Container_Aggregate (Parent (Parent_Node)))
+ -- subprogram calls later.
- or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate
- and then not Is_Container_Aggregate (Parent_Node))
+ Parent_Is_Regular_Aggregate (Parent_Node)
-- Allocator (see Convert_Aggr_In_Allocator). Sliding cannot be done
-- in place for the time being.
-- generated by Make_Tag_Ctrl_Assignment). But, in the case of an array
-- aggregate, controlled subaggregates are not considered because each
-- of their individual elements will receive an adjustment of its own.
+ -- Moreover, the result of a function call need not be adjusted if it
+ -- has already been adjusted in the called function.
if Finalization_OK
and then not Is_Inherently_Limited_Type (Comp_Typ)
and then Is_Array_Type (Comp_Typ)
and then Needs_Finalization (Component_Type (Comp_Typ))
and then Nkind (Unqualify (Init_Expr)) = N_Aggregate)
+ and then not (Back_End_Return_Slot
+ and then Nkind (Init_Expr) = N_Function_Call)
then
Set_No_Finalize_Actions (Init_Stmt);
return False;
end Must_Slide;
+ ---------------------------------
+ -- Parent_Is_Regular_Aggregate --
+ ---------------------------------
+
+ function Parent_Is_Regular_Aggregate (Par : Node_Id) return Boolean is
+ begin
+ case Nkind (Par) is
+ when N_Component_Association =>
+ return Parent_Is_Regular_Aggregate (Parent (Par));
+
+ when N_Extension_Aggregate | N_Aggregate =>
+ return not Is_Container_Aggregate (Par);
+
+ when others =>
+ return False;
+ end case;
+ end Parent_Is_Regular_Aggregate;
+
---------------------
-- Sort_Case_Table --
---------------------
-- This is the case if it consists only of iterated component associations
-- with iterator specifications, see RM 4.3.3(20.2/5).
+ function Parent_Is_Regular_Aggregate (Par : Node_Id) return Boolean;
+ -- Return True if Par is an aggregate that is not a container aggregate, or
+ -- a component association of such an aggregate.
+
function Static_Array_Aggregate (N : Node_Id) return Boolean;
-- N is an array aggregate that may have a component association with
-- an others clause and a range. If bounds are static and the expressions
Exp_Q := Unqualify (Exp);
- -- Adjust the component if controlled, except if it is an aggregate
- -- that will be expanded inline (but note that the case of container
- -- aggregates does require component adjustment), or a function call.
+ -- Adjust the component if controlled, except if the expression is an
+ -- aggregate that will be expanded inline (but note that the case of
+ -- container aggregates does require component adjustment), or else
+ -- a function call whose result is adjusted in the called function.
-- Note that, when we don't inhibit component adjustment, the tag
-- will be automatically inserted by Make_Tag_Ctrl_Assignment in the
-- tagged case. Otherwise, we have to generate a tag assignment here.
and then (Nkind (Exp_Q) not in N_Aggregate | N_Extension_Aggregate
or else Is_Container_Aggregate (Exp_Q))
and then not Is_Build_In_Place_Function_Call (Exp)
- and then Nkind (Exp) /= N_Function_Call
+ and then not (Back_End_Return_Slot
+ and then Nkind (Exp) = N_Function_Call)
then
Set_No_Finalize_Actions (First (Res));
-- skipped if the operation is done in Bignum mode but that's fine, since
-- the Bignum call takes care of everything.
+ function New_Assign_Copy (N : Node_Id; Expr : Node_Id) return Node_Id;
+ -- N is an assignment statement. Return a copy of N with the same name but
+ -- expression changed to Expr and perform a couple of adjustments.
+
procedure Narrow_Large_Operation (N : Node_Id);
-- Try to compute the result of a large operation in a narrower type than
-- its nominal type. This is mainly aimed at getting rid of operations done
-- adjust after the assignment but, in either case, we do not
-- finalize before since the target is newly allocated memory.
- if Nkind (Exp) = N_Function_Call then
+ if Back_End_Return_Slot and then Nkind (Exp) = N_Function_Call then
Set_No_Ctrl_Actions (Assign);
else
Set_No_Finalize_Actions (Assign);
-- as qualified expression must be rewritten into the form expected by
-- Expand_Container_Aggregate, resp. Two_Pass_Aggregate_Expansion.
- if Nkind (Exp) = N_Aggregate
- and then (Has_Aspect (T, Aspect_Aggregate)
- or else Is_Two_Pass_Aggregate (Exp))
- then
+ if Is_Container_Aggregate (Exp) or else Is_Two_Pass_Aggregate (Exp) then
Temp := Make_Temporary (Loc, 'P', N);
Set_Analyzed (Exp, False);
Insert_Action (N,
-- expansion until the (immediate) parent is rewritten as a return
-- statement (or is already the return statement). Likewise if it is
-- in the context of an object declaration that can be optimized.
+ -- Likewise if it is in the context of a regular agggregate and the
+ -- type should not be copied.
if not Expansion_Delayed (N) then
declare
begin
if Nkind (Uncond_Par) = N_Simple_Return_Statement
or else Is_Optimizable_Declaration (Uncond_Par)
+ or else (Parent_Is_Regular_Aggregate (Uncond_Par)
+ and then not Is_Copy_Type (Typ))
then
Delay_Conditional_Expressions_Between (N, Uncond_Par);
end if;
if Optimize_Assignment_Stmt then
-- We directly copy the parent node to preserve its flags
- Stmts := New_List (New_Copy (Par));
- Set_Sloc (First (Stmts), Alt_Loc);
- Set_Name (First (Stmts), New_Copy_Tree (Name (Par)));
- Set_Expression (First (Stmts), Alt_Expr);
-
- -- If the expression is itself a conditional expression whose
- -- expansion has been delayed, analyze it again and expand it.
-
- if Is_Delayed_Conditional_Expression (Alt_Expr) then
- Unanalyze_Delayed_Conditional_Expression (Alt_Expr);
- end if;
+ Stmts := New_List (New_Assign_Copy (Par, Alt_Expr));
-- Generate:
-- return AX;
-- expansion until the (immediate) parent is rewritten as a return
-- statement (or is already the return statement). Likewise if it is
-- in the context of an object declaration that can be optimized.
- -- Note that this deals with the case of the elsif part of the if
- -- expression, if it exists.
+ -- Likewise if it is in the context of a regular agggregate and the
+ -- type should not be copied. Note that this deals with the case of
+ -- the elsif part of the if expression, if it exists.
if not Expansion_Delayed (N) then
declare
begin
if Nkind (Uncond_Par) = N_Simple_Return_Statement
or else Is_Optimizable_Declaration (Uncond_Par)
+ or else (Parent_Is_Regular_Aggregate (Uncond_Par)
+ and then not Is_Copy_Type (Typ))
then
Delay_Conditional_Expressions_Between (N, Uncond_Par);
end if;
-- We directly copy the parent node to preserve its flags
- New_Then := New_Copy (Par);
- Set_Sloc (New_Then, Sloc (Thenx));
- Set_Name (New_Then, New_Copy_Tree (Name (Par)));
- Set_Expression (New_Then, Relocate_Node (Thenx));
-
- -- If the expression is itself a conditional expression whose
- -- expansion has been delayed, analyze it again and expand it.
-
- if Is_Delayed_Conditional_Expression (Expression (New_Then)) then
- Unanalyze_Delayed_Conditional_Expression (Expression (New_Then));
- end if;
-
- New_Else := New_Copy (Par);
- Set_Sloc (New_Else, Sloc (Elsex));
- Set_Name (New_Else, New_Copy_Tree (Name (Par)));
- Set_Expression (New_Else, Relocate_Node (Elsex));
-
- if Is_Delayed_Conditional_Expression (Expression (New_Else)) then
- Unanalyze_Delayed_Conditional_Expression (Expression (New_Else));
- end if;
+ New_Then := New_Assign_Copy (Par, Relocate_Node (Thenx));
+ New_Else := New_Assign_Copy (Par, Relocate_Node (Elsex));
If_Stmt :=
Make_Implicit_If_Statement (N,
end if;
end Narrow_Large_Operation;
+ ---------------------
+ -- New_Assign_Copy --
+ ---------------------
+
+ function New_Assign_Copy (N : Node_Id; Expr : Node_Id) return Node_Id is
+ New_N : constant Node_Id := New_Copy (N);
+
+ begin
+ Set_Sloc (New_N, Sloc (Expr));
+ Set_Name (New_N, New_Copy_Tree (Name (N)));
+ Set_Expression (New_N, Expr);
+
+ -- The result of a function call need not be adjusted if it has
+ -- already been adjusted in the called function.
+
+ if No_Finalize_Actions (New_N)
+ and then Back_End_Return_Slot
+ and then Nkind (Expr) = N_Function_Call
+ then
+ Set_No_Finalize_Actions (New_N, False);
+ Set_No_Ctrl_Actions (New_N);
+ end if;
+
+ -- If the expression is itself a conditional expression whose
+ -- expansion has been delayed, analyze it again and expand it.
+
+ if Is_Delayed_Conditional_Expression (Expr) then
+ Unanalyze_Delayed_Conditional_Expression (Expr);
+ end if;
+
+ return New_N;
+ end New_Assign_Copy;
+
--------------------------------
-- Optimize_Length_Comparison --
--------------------------------
-- denoted by the call needs finalization in the current subprogram, which
-- excludes return statements, and is not identified with another object
-- that will be finalized, which excludes (statically) declared objects,
- -- dynamically allocated objects, and targets of assignments that are done
- -- directly (without intermediate temporaries).
+ -- dynamically allocated objects, components of aggregates, and targets of
+ -- assignments that are done directly (without intermediate temporaries).
procedure Expand_Non_Function_Return (N : Node_Id);
-- Expand a simple return statement found in a procedure body, entry body,
-- to copy/readjust/finalize, we can just pass the value through (see
-- Expand_N_Simple_Return_Statement), and thus no attachment is needed.
-- Note that simple return statements are distributed into conditional
- -- expressions but we may be invoked before this distribution is done.
+ -- expressions, but we may be invoked before this distribution is done.
if Nkind (Uncond_Par) = N_Simple_Return_Statement then
return;
end if;
-- Note that object declarations are also distributed into conditional
- -- expressions but we may be invoked before this distribution is done.
+ -- expressions, but we may be invoked before this distribution is done.
elsif Nkind (Uncond_Par) = N_Object_Declaration then
return;
return;
end if;
+ -- Another optimization: if the returned value is used to initialize the
+ -- component of an aggregate, then no need to copy/readjust/finalize, we
+ -- can initialize it in place. Note that assignments for aggregates are
+ -- also distributed into conditional expressions, but we may be invoked
+ -- before this distribution is done.
+
+ if Parent_Is_Regular_Aggregate (Uncond_Par) then
+ return;
+ end if;
+
-- Avoid expansion to catch the error when the function call is on the
-- left-hand side of an assignment. Likewise if it is on the right-hand
-- side and no controlling actions will be performed for the assignment,
Append_Unique_Elmt (N, Identifiers_List);
end if;
+
+ -- Skip attribute references created by the compiler, typically
+ -- 'Constrained applied to one of the writable actuals, to avoid
+ -- spurious errors.
+
+ elsif Nkind (N) = N_Attribute_Reference
+ and then not Comes_From_Source (N)
+ then
+ return Skip;
end if;
return OK;
projects / thirdparty / gcc.git / commitdiff
