From 4ff5aa0c05b3a42a454d76275cf7e1f17cbb7412 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Jul 2019 08:05:31 +0000 Subject: [PATCH] [Ada] CCG: reduce generated temporaries 2019-07-04 Arnaud Charlet 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 --- gcc/ada/ChangeLog | 12 + gcc/ada/exp_aggr.adb | 573 +++++++++++++++++++++---------------------- 2 files changed, 296 insertions(+), 289 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ea1d75df7e0..46f30aa87fe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2019-07-04 Arnaud Charlet + + * 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 * opt.adb (Set_Config_Switches): Keep assertions policy as diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 80523e999d3..7099d93691c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/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; -- 2.30.2