Skip to content

R
riscv-gcc-1
Commit 4ff5aa0c by Arnaud Charlet Committed by Pierre-Marie de Rodat
Options

[Ada] CCG: reduce generated temporaries 

2019-07-04  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* exp_aggr.adb (In_Place_Assign_OK): Moved to top level and add
	support for record aggregates.
	(Component_Check): Use Is_CCG_Supported_Aggregate instead of a
	similar local predicate.
	(Convert_To_Assignments): Take advantage of In_Place_Assign_OK
	predicate when possible.
	(Is_CCG_Supported_Aggregate): Return False for records with
	representation clauses and fix the logic for dealing with nested
	aggregates.

From-SVN: r273049
parent d8be36d2
Showing with 296 additions and 289 deletions
gcc/ada/ChangeLog
2019-07-04 Arnaud Charlet <charlet@adacore.com>
* exp_aggr.adb (In_Place_Assign_OK): Moved to top level and add
support for record aggregates.
(Component_Check): Use Is_CCG_Supported_Aggregate instead of a
similar local predicate.
(Convert_To_Assignments): Take advantage of In_Place_Assign_OK
predicate when possible.
(Is_CCG_Supported_Aggregate): Return False for records with
representation clauses and fix the logic for dealing with nested
aggregates.
2019-07-04 Piotr Trojanek <trojanek@adacore.com>
* opt.adb (Set_Config_Switches): Keep assertions policy as
......
gcc/ada/exp_aggr.adb
......@@ -217,6 +217,11 @@ package body Exp_Aggr is
-- defaults. An aggregate for a type with mutable components must be
-- expanded into individual assignments.
function In_Place_Assign_OK (N : Node_Id) return Boolean;
-- Predicate to determine whether an aggregate assignment can be done in
-- place, because none of the new values can depend on the components of
-- the target of the assignment.
procedure Initialize_Discriminants (N : Node_Id; Typ : Entity_Id);
-- If the type of the aggregate is a type extension with renamed discrimi-
-- nants, we must initialize the hidden discriminants of the parent.
......@@ -646,24 +651,8 @@ package body Exp_Aggr is
-- Checks 11: The C code generator cannot handle aggregates that are
-- not part of an object declaration.
if Modify_Tree_For_C then
declare
Par : Node_Id := Parent (N);
begin
-- Skip enclosing nested aggregates and their qualified
-- expressions.
while Nkind (Par) = N_Aggregate
or else Nkind (Par) = N_Qualified_Expression
loop
Par := Parent (Par);
end loop;
if Nkind (Par) /= N_Object_Declaration then
return False;
end if;
end;
if Modify_Tree_For_C and then not Is_CCG_Supported_Aggregate (N) then
return False;
end if;
-- Checks on components
......@@ -4134,6 +4123,254 @@ package body Exp_Aggr is
Insert_Actions_After (Decl, Aggr_Code);
end Convert_Array_Aggr_In_Allocator;
------------------------
-- In_Place_Assign_OK --
------------------------
function In_Place_Assign_OK (N : Node_Id) return Boolean is
Is_Array : constant Boolean := Is_Array_Type (Etype (N));
Aggr_In : Node_Id;
Aggr_Lo : Node_Id;
Aggr_Hi : Node_Id;
Obj_In : Node_Id;
Obj_Lo : Node_Id;
Obj_Hi : Node_Id;
function Safe_Aggregate (Aggr : Node_Id) return Boolean;
-- Check recursively that each component of a (sub)aggregate does not
-- depend on the variable being assigned to.
function Safe_Component (Expr : Node_Id) return Boolean;
-- Verify that an expression cannot depend on the variable being
-- assigned to. Room for improvement here (but less than before).
--------------------
-- Safe_Aggregate --
--------------------
function Safe_Aggregate (Aggr : Node_Id) return Boolean is
Expr : Node_Id;
begin
if Nkind (Parent (Aggr)) = N_Iterated_Component_Association then
return False;
end if;
if Present (Expressions (Aggr)) then
Expr := First (Expressions (Aggr));
while Present (Expr) loop
if Nkind (Expr) = N_Aggregate then
if not Safe_Aggregate (Expr) then
return False;
end if;
elsif not Safe_Component (Expr) then
return False;
end if;
Next (Expr);
end loop;
end if;
if Present (Component_Associations (Aggr)) then
Expr := First (Component_Associations (Aggr));
while Present (Expr) loop
if Nkind (Expression (Expr)) = N_Aggregate then
if not Safe_Aggregate (Expression (Expr)) then
return False;
end if;
-- If association has a box, no way to determine yet
-- whether default can be assigned in place.
elsif Box_Present (Expr) then
return False;
elsif not Safe_Component (Expression (Expr)) then
return False;
end if;
Next (Expr);
end loop;
end if;
return True;
end Safe_Aggregate;
--------------------
-- Safe_Component --
--------------------
function Safe_Component (Expr : Node_Id) return Boolean is
Comp : Node_Id := Expr;
function Check_Component (Comp : Node_Id) return Boolean;
-- Do the recursive traversal, after copy
---------------------
-- Check_Component --
---------------------
function Check_Component (Comp : Node_Id) return Boolean is
begin
if Is_Overloaded (Comp) then
return False;
end if;
return Compile_Time_Known_Value (Comp)
or else (Is_Entity_Name (Comp)
and then Present (Entity (Comp))
and then Ekind (Entity (Comp)) not in Type_Kind
and then No (Renamed_Object (Entity (Comp))))
or else (Nkind (Comp) = N_Attribute_Reference
and then Check_Component (Prefix (Comp)))
or else (Nkind (Comp) in N_Binary_Op
and then Check_Component (Left_Opnd (Comp))
and then Check_Component (Right_Opnd (Comp)))
or else (Nkind (Comp) in N_Unary_Op
and then Check_Component (Right_Opnd (Comp)))
or else (Nkind (Comp) = N_Selected_Component
and then Is_Array
and then Check_Component (Prefix (Comp)))
or else (Nkind_In (Comp, N_Unchecked_Type_Conversion,
N_Type_Conversion)
and then Check_Component (Expression (Comp)));
end Check_Component;
-- Start of processing for Safe_Component
begin
-- If the component appears in an association that may correspond
-- to more than one element, it is not analyzed before expansion
-- into assignments, to avoid side effects. We analyze, but do not
-- resolve the copy, to obtain sufficient entity information for
-- the checks that follow. If component is overloaded we assume
-- an unsafe function call.
if not Analyzed (Comp) then
if Is_Overloaded (Expr) then
return False;
elsif Nkind (Expr) = N_Aggregate
and then not Is_Others_Aggregate (Expr)
then
return False;
elsif Nkind (Expr) = N_Allocator then
-- For now, too complex to analyze
return False;
elsif Nkind (Parent (Expr)) =
N_Iterated_Component_Association
then
-- Ditto for iterated component associations, which in
-- general require an enclosing loop and involve nonstatic
-- expressions.
return False;
end if;
Comp := New_Copy_Tree (Expr);
Set_Parent (Comp, Parent (Expr));
Analyze (Comp);
end if;
if Nkind (Comp) = N_Aggregate then
return Safe_Aggregate (Comp);
else
return Check_Component (Comp);
end if;
end Safe_Component;
-- Start of processing for In_Place_Assign_OK
begin
-- By-copy semantic cannot be guaranteed for controlled objects or
-- objects with discriminants.
if Needs_Finalization (Etype (N))
or else Has_Discriminants (Etype (N))
then
return False;
elsif Is_Array and then Present (Component_Associations (N)) then
-- On assignment, sliding can take place, so we cannot do the
-- assignment in place unless the bounds of the aggregate are
-- statically equal to those of the target.
-- If the aggregate is given by an others choice, the bounds are
-- derived from the left-hand side, and the assignment is safe if
-- the expression is.
if Is_Others_Aggregate (N) then
return
Safe_Component
(Expression (First (Component_Associations (N))));
end if;
Aggr_In := First_Index (Etype (N));
if Nkind (Parent (N)) = N_Assignment_Statement then
Obj_In := First_Index (Etype (Name (Parent (N))));
else
-- Context is an allocator. Check bounds of aggregate against
-- given type in qualified expression.
pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator);
Obj_In := First_Index (Etype (Entity (Subtype_Mark (Parent (N)))));
end if;
while Present (Aggr_In) loop
Get_Index_Bounds (Aggr_In, Aggr_Lo, Aggr_Hi);
Get_Index_Bounds (Obj_In, Obj_Lo, Obj_Hi);
if not Compile_Time_Known_Value (Aggr_Lo)
or else not Compile_Time_Known_Value (Obj_Lo)
or else not Compile_Time_Known_Value (Obj_Hi)
or else Expr_Value (Aggr_Lo) /= Expr_Value (Obj_Lo)
then
return False;
-- For an assignment statement we require static matching of
-- bounds. Ditto for an allocator whose qualified expression
-- is a constrained type. If the expression in the allocator
-- is an unconstrained array, we accept an upper bound that
-- is not static, to allow for nonstatic expressions of the
-- base type. Clearly there are further possibilities (with
-- diminishing returns) for safely building arrays in place
-- here.
elsif Nkind (Parent (N)) = N_Assignment_Statement
or else Is_Constrained (Etype (Parent (N)))
then
if not Compile_Time_Known_Value (Aggr_Hi)
or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
then
return False;
end if;
end if;
Next_Index (Aggr_In);
Next_Index (Obj_In);
end loop;
end if;
-- Now check the component values themselves
return Safe_Aggregate (N);
end In_Place_Assign_OK;
----------------------------
-- Convert_To_Assignments --
----------------------------
......@@ -4232,10 +4469,11 @@ package body Exp_Aggr is
Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
-- If the aggregate is nonlimited, create a temporary. If it is limited
-- and context is an assignment, this is a subaggregate for an enclosing
-- aggregate being expanded. It must be built in place, so use target of
-- the current assignment.
-- If the aggregate is nonlimited, create a temporary since aggregates
-- have "by copy" semantic. If it is limited and context is an
-- assignment, this is a subaggregate for an enclosing aggregate being
-- expanded. It must be built in place, so use target of the current
-- assignment.
if Is_Limited_Type (Typ)
and then Nkind (Parent (N)) = N_Assignment_Statement
......@@ -4245,16 +4483,14 @@ package body Exp_Aggr is
Build_Record_Aggr_Code (N, Typ, Target_Expr));
Rewrite (Parent (N), Make_Null_Statement (Loc));
-- Generating C, do not declare a temporary to initialize an aggregate
-- assigned to Out or In_Out parameters whose type has no discriminants.
-- This avoids stack overflow errors at run time.
-- Do not declare a temporary to initialize an aggregate assigned to an
-- identifier when in place assignment is possible preserving the
-- by-copy semantic of aggregates. This avoids large stack usage and
-- generates more efficient code.
elsif Modify_Tree_For_C
and then Nkind (Parent (N)) = N_Assignment_Statement
elsif Nkind (Parent (N)) = N_Assignment_Statement
and then Nkind (Name (Parent (N))) = N_Identifier
and then Ekind_In (Entity (Name (Parent (N))), E_Out_Parameter,
E_In_Out_Parameter)
and then not Has_Discriminants (Etype (Entity (Name (Parent (N)))))
and then In_Place_Assign_OK (N)
then
Target_Expr := New_Copy_Tree (Name (Parent (N)));
Insert_Actions (Parent (N),
......@@ -4945,11 +5181,6 @@ package body Exp_Aggr is
-- subaggregate we start the computation from. Dim is the dimension
-- corresponding to the subaggregate.
function In_Place_Assign_OK return Boolean;
-- Simple predicate to determine whether an aggregate assignment can
-- be done in place, because none of the new values can depend on the
-- components of the target of the assignment.
procedure Others_Check (Sub_Aggr : Node_Id; Dim : Pos);
-- Checks that if an others choice is present in any subaggregate, no
-- aggregate index is outside the bounds of the index constraint.
......@@ -5437,243 +5668,6 @@ package body Exp_Aggr is
end if;
end Compute_Others_Present;
------------------------
-- In_Place_Assign_OK --
------------------------
function In_Place_Assign_OK return Boolean is
Aggr_In : Node_Id;
Aggr_Lo : Node_Id;
Aggr_Hi : Node_Id;
Obj_In : Node_Id;
Obj_Lo : Node_Id;
Obj_Hi : Node_Id;
function Safe_Aggregate (Aggr : Node_Id) return Boolean;
-- Check recursively that each component of a (sub)aggregate does not
-- depend on the variable being assigned to.
function Safe_Component (Expr : Node_Id) return Boolean;
-- Verify that an expression cannot depend on the variable being
-- assigned to. Room for improvement here (but less than before).
--------------------
-- Safe_Aggregate --
--------------------
function Safe_Aggregate (Aggr : Node_Id) return Boolean is
Expr : Node_Id;
begin
if Nkind (Parent (Aggr)) = N_Iterated_Component_Association then
return False;
end if;
if Present (Expressions (Aggr)) then
Expr := First (Expressions (Aggr));
while Present (Expr) loop
if Nkind (Expr) = N_Aggregate then
if not Safe_Aggregate (Expr) then
return False;
end if;
elsif not Safe_Component (Expr) then
return False;
end if;
Next (Expr);
end loop;
end if;
if Present (Component_Associations (Aggr)) then
Expr := First (Component_Associations (Aggr));
while Present (Expr) loop
if Nkind (Expression (Expr)) = N_Aggregate then
if not Safe_Aggregate (Expression (Expr)) then
return False;
end if;
-- If association has a box, no way to determine yet
-- whether default can be assigned in place.
elsif Box_Present (Expr) then
return False;
elsif not Safe_Component (Expression (Expr)) then
return False;
end if;
Next (Expr);
end loop;
end if;
return True;
end Safe_Aggregate;
--------------------
-- Safe_Component --
--------------------
function Safe_Component (Expr : Node_Id) return Boolean is
Comp : Node_Id := Expr;
function Check_Component (Comp : Node_Id) return Boolean;
-- Do the recursive traversal, after copy
---------------------
-- Check_Component --
---------------------
function Check_Component (Comp : Node_Id) return Boolean is
begin
if Is_Overloaded (Comp) then
return False;
end if;
return Compile_Time_Known_Value (Comp)
or else (Is_Entity_Name (Comp)
and then Present (Entity (Comp))
and then No (Renamed_Object (Entity (Comp))))
or else (Nkind (Comp) = N_Attribute_Reference
and then Check_Component (Prefix (Comp)))
or else (Nkind (Comp) in N_Binary_Op
and then Check_Component (Left_Opnd (Comp))
and then Check_Component (Right_Opnd (Comp)))
or else (Nkind (Comp) in N_Unary_Op
and then Check_Component (Right_Opnd (Comp)))
or else (Nkind (Comp) = N_Selected_Component
and then Check_Component (Prefix (Comp)))
or else (Nkind_In (Comp, N_Unchecked_Type_Conversion,
N_Type_Conversion)
and then Check_Component (Expression (Comp)));
end Check_Component;
-- Start of processing for Safe_Component
begin
-- If the component appears in an association that may correspond
-- to more than one element, it is not analyzed before expansion
-- into assignments, to avoid side effects. We analyze, but do not
-- resolve the copy, to obtain sufficient entity information for
-- the checks that follow. If component is overloaded we assume
-- an unsafe function call.
if not Analyzed (Comp) then
if Is_Overloaded (Expr) then
return False;
elsif Nkind (Expr) = N_Aggregate
and then not Is_Others_Aggregate (Expr)
then
return False;
elsif Nkind (Expr) = N_Allocator then
-- For now, too complex to analyze
return False;
elsif Nkind (Parent (Expr)) =
N_Iterated_Component_Association
then
-- Ditto for iterated component associations, which in
-- general require an enclosing loop and involve nonstatic
-- expressions.
return False;
end if;
Comp := New_Copy_Tree (Expr);
Set_Parent (Comp, Parent (Expr));
Analyze (Comp);
end if;
if Nkind (Comp) = N_Aggregate then
return Safe_Aggregate (Comp);
else
return Check_Component (Comp);
end if;
end Safe_Component;
-- Start of processing for In_Place_Assign_OK
begin
if Present (Component_Associations (N)) then
-- On assignment, sliding can take place, so we cannot do the
-- assignment in place unless the bounds of the aggregate are
-- statically equal to those of the target.
-- If the aggregate is given by an others choice, the bounds are
-- derived from the left-hand side, and the assignment is safe if
-- the expression is.
if Is_Others_Aggregate (N) then
return
Safe_Component
(Expression (First (Component_Associations (N))));
end if;
Aggr_In := First_Index (Etype (N));
if Nkind (Parent (N)) = N_Assignment_Statement then
Obj_In := First_Index (Etype (Name (Parent (N))));
else
-- Context is an allocator. Check bounds of aggregate against
-- given type in qualified expression.
pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator);
Obj_In :=
First_Index (Etype (Entity (Subtype_Mark (Parent (N)))));
end if;
while Present (Aggr_In) loop
Get_Index_Bounds (Aggr_In, Aggr_Lo, Aggr_Hi);
Get_Index_Bounds (Obj_In, Obj_Lo, Obj_Hi);
if not Compile_Time_Known_Value (Aggr_Lo)
or else not Compile_Time_Known_Value (Obj_Lo)
or else not Compile_Time_Known_Value (Obj_Hi)
or else Expr_Value (Aggr_Lo) /= Expr_Value (Obj_Lo)
then
return False;
-- For an assignment statement we require static matching of
-- bounds. Ditto for an allocator whose qualified expression
-- is a constrained type. If the expression in the allocator
-- is an unconstrained array, we accept an upper bound that
-- is not static, to allow for nonstatic expressions of the
-- base type. Clearly there are further possibilities (with
-- diminishing returns) for safely building arrays in place
-- here.
elsif Nkind (Parent (N)) = N_Assignment_Statement
or else Is_Constrained (Etype (Parent (N)))
then
if not Compile_Time_Known_Value (Aggr_Hi)
or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
then
return False;
end if;
end if;
Next_Index (Aggr_In);
Next_Index (Obj_In);
end loop;
end if;
-- Now check the component values themselves
return Safe_Aggregate (N);
end In_Place_Assign_OK;
------------------
-- Others_Check --
------------------
......@@ -6256,11 +6250,11 @@ package body Exp_Aggr is
else
Maybe_In_Place_OK :=
(Nkind (Parent (N)) = N_Assignment_Statement
and then In_Place_Assign_OK)
and then In_Place_Assign_OK (N))
or else
(Nkind (Parent (Parent (N))) = N_Allocator
and then In_Place_Assign_OK);
and then In_Place_Assign_OK (N));
end if;
-- If this is an array of tasks, it will be expanded into build-in-place
......@@ -7686,30 +7680,31 @@ package body Exp_Aggr is
function Is_CCG_Supported_Aggregate
(N : Node_Id) return Boolean
is
In_Obj_Decl : Boolean := False;
P : Node_Id := Parent (N);
P : Node_Id := Parent (N);
begin
while Present (P) loop
if Nkind (P) = N_Object_Declaration then
In_Obj_Decl := True;
end if;
-- Aggregates are not supported for non standard rep clauses since
-- they may lead to extra padding fields in CCG.
if Ekind (Etype (N)) in Record_Kind
and then Has_Non_Standard_Rep (Etype (N))
then
return False;
end if;
while Present (P) and then Nkind (P) = N_Aggregate loop
P := Parent (P);
end loop;
-- Cases where aggregates are supported by the CCG backend
if In_Obj_Decl then
if Nkind (Parent (N)) = N_Object_Declaration then
return True;
if Nkind (P) = N_Object_Declaration then
return True;
elsif Nkind (Parent (N)) = N_Qualified_Expression
and then Nkind_In (Parent (Parent (N)), N_Allocator,
N_Object_Declaration)
then
return True;
end if;
elsif Nkind (P) = N_Qualified_Expression
and then Nkind_In (Parent (P), N_Allocator, N_Object_Declaration)
then
return True;
end if;
return False;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment