From b748c3d1b7223cc1dd83a6965d51914968dd0d60 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 29 May 2020 16:30:54 +0200 Subject: [PATCH] [Ada] Further improve the expansion of array aggregates gcc/ada/ * exp_aggr.adb (Convert_To_Positional): Add Dims local variable and pass it in calls to Is_Flat and Flatten. (Check_Static_Components): Pass Dims in call to Is_Static_Element. (Nonflattenable_Next_Aggr): New predicate. (Flatten): Add Dims parameter and Expr local variable. Call Nonflattenable_Next_Aggr in a couple of places. In the case when an Others choice is present, check that the element is either static or a nested aggregate that can be flattened, before disregarding the replication limit for elaboration purposes. Check that a nested array is flattenable in the case of a multidimensional array in any position. Remove redundant check in the Others case and pass Dims in call to Is_Static_Element. Use Expr variable. (Is_Flat): Change type of Dims parameter from Int to Nat. (Is_Static_Element): Add Dims parameter. Replace tests on literals with call to Compile_Time_Known_Value. If everything else failed and the dimension is 1, preanalyze the expression before calling again Compile_Time_Known_Value on it. Return true for null. (Late_Expansion): Do not expand further if the assignment to the target can be done directly by the back end. --- gcc/ada/exp_aggr.adb | 198 +++++++++++++++++++++++++++---------------- 1 file changed, 125 insertions(+), 73 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 8c5881b07f1..47a080814f5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4954,6 +4954,7 @@ package body Exp_Aggr is Handle_Bit_Packed : Boolean := False) is Typ : constant Entity_Id := Etype (N); + Dims : constant Nat := Number_Dimensions (Typ); Max_Others_Replicate : constant Nat := Max_Aggregate_Size (Typ); Static_Components : Boolean := True; @@ -4964,18 +4965,19 @@ package body Exp_Aggr is -- expansion. function Flatten - (N : Node_Id; - Ix : Node_Id; - Ixb : Node_Id) return Boolean; + (N : Node_Id; + Dims : Nat; + Ix : Node_Id; + Ixb : Node_Id) return Boolean; -- Convert the aggregate into a purely positional form if possible. On -- entry the bounds of all dimensions are known to be static, and the -- total number of components is safe enough to expand. - function Is_Flat (N : Node_Id; Dims : Int) return Boolean; - -- Return True iff the array N is flat (which is not trivial in the case - -- of multidimensional aggregates). + function Is_Flat (N : Node_Id; Dims : Nat) return Boolean; + -- Return True if the aggregate N is flat (which is not trivial in the + -- case of multidimensional aggregates). - function Is_Static_Element (N : Node_Id) return Boolean; + function Is_Static_Element (N : Node_Id; Dims : Nat) return Boolean; -- Return True if N, an element of a component association list, i.e. -- N_Component_Association or N_Iterated_Component_Association, has a -- compile-time known value and can be passed as is to the back-end @@ -5019,7 +5021,7 @@ package body Exp_Aggr is then Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if not Is_Static_Element (Assoc) then + if not Is_Static_Element (Assoc, Dims) then Static_Components := False; exit; end if; @@ -5034,18 +5036,39 @@ package body Exp_Aggr is ------------- function Flatten - (N : Node_Id; - Ix : Node_Id; - Ixb : Node_Id) return Boolean + (N : Node_Id; + Dims : Nat; + Ix : Node_Id; + Ixb : Node_Id) return Boolean is Loc : constant Source_Ptr := Sloc (N); Blo : constant Node_Id := Type_Low_Bound (Etype (Ixb)); Lo : constant Node_Id := Type_Low_Bound (Etype (Ix)); Hi : constant Node_Id := Type_High_Bound (Etype (Ix)); - Lov : Uint; - Hiv : Uint; - Others_Present : Boolean := False; + function Cannot_Flatten_Next_Aggr (Expr : Node_Id) return Boolean; + -- Return true if Expr is an aggregate for the next dimension that + -- cannot be recursively flattened. + + ------------------------------ + -- Cannot_Flatten_Next_Aggr -- + ------------------------------ + + function Cannot_Flatten_Next_Aggr (Expr : Node_Id) return Boolean is + begin + return Nkind (Expr) = N_Aggregate + and then Present (Next_Index (Ix)) + and then not + Flatten (Expr, Dims - 1, Next_Index (Ix), Next_Index (Ixb)); + end Cannot_Flatten_Next_Aggr; + + -- Local variables + + Lov : Uint; + Hiv : Uint; + Others_Present : Boolean; + + -- Start of processing for Flatten begin if Nkind (Original_Node (N)) = N_String_Literal then @@ -5063,6 +5086,8 @@ package body Exp_Aggr is -- Check if there is an others choice + Others_Present := False; + if Present (Component_Associations (N)) then declare Assoc : Node_Id; @@ -5123,6 +5148,7 @@ package body Exp_Aggr is -- Used to validate Max_Others_Replicate limit Elmt : Node_Id; + Expr : Node_Id; Num : Int := UI_To_Int (Lov); Choice_Index : Int; Choice : Node_Id; @@ -5132,11 +5158,10 @@ package body Exp_Aggr is if Present (Expressions (N)) then Elmt := First (Expressions (N)); while Present (Elmt) loop - if Nkind (Elmt) = N_Aggregate - and then Present (Next_Index (Ix)) - and then - not Flatten (Elmt, Next_Index (Ix), Next_Index (Ixb)) - then + -- In the case of a multidimensional array, check that the + -- aggregate can be recursively flattened. + + if Cannot_Flatten_Next_Aggr (Elmt) then return False; end if; @@ -5155,17 +5180,16 @@ package body Exp_Aggr is Elmt := First (Component_Associations (N)); - if Nkind (Expression (Elmt)) = N_Aggregate then - if Present (Next_Index (Ix)) - and then - not Flatten - (Expression (Elmt), Next_Index (Ix), Next_Index (Ixb)) - then + Component_Loop : while Present (Elmt) loop + Expr := Expression (Elmt); + + -- In the case of a multidimensional array, check that the + -- aggregate can be recursively flattened. + + if Cannot_Flatten_Next_Aggr (Expr) then return False; end if; - end if; - Component_Loop : while Present (Elmt) loop Choice := First (Choice_List (Elmt)); Choice_Loop : while Present (Choice) loop @@ -5179,19 +5203,18 @@ package body Exp_Aggr is -- a loop, we must generate individual assignments and -- no flattening is possible. - if Nkind (Expression (Elmt)) = N_Quantified_Expression - then + if Nkind (Expr) = N_Quantified_Expression then return False; end if; for J in Vals'Range loop if No (Vals (J)) then - Vals (J) := New_Copy_Tree (Expression (Elmt)); + Vals (J) := New_Copy_Tree (Expr); Rep_Count := Rep_Count + 1; -- Check for maximum others replication. Note that -- we skip this test if either of the restrictions - -- No_Elaboration_Code or No_Implicit_Loops is + -- No_Implicit_Loops or No_Elaboration_Code is -- active, if this is a preelaborable unit or -- a predefined unit, or if the unit must be -- placed in data memory. This also ensures that @@ -5207,37 +5230,39 @@ package body Exp_Aggr is -- Check if duplication is always OK and, if so, -- continue processing. - if Restriction_Active (No_Elaboration_Code) - or else Restriction_Active (No_Implicit_Loops) + if Restriction_Active (No_Implicit_Loops) then + null; + + -- If duplication is not always OK, continue + -- only if either the element is static or is + -- an aggregate (we already know it is OK). + + elsif not Is_Static_Element (Elmt, Dims) + and then Nkind (Expr) /= N_Aggregate + then + return False; + + -- Check if duplication is OK for elaboration + -- purposes and, if so, continue processing. + + elsif Restriction_Active (No_Elaboration_Code) or else (Ekind (Current_Scope) = E_Package - and then Static_Elaboration_Desired - (Current_Scope)) + and then + Static_Elaboration_Desired (Current_Scope)) or else Is_Preelaborated (P) or else (Ekind (P) = E_Package_Body and then - Is_Preelaborated (Spec_Entity (P))) + Is_Preelaborated (Spec_Entity (P))) or else Is_Predefined_Unit (Get_Source_Unit (P)) then null; - -- If duplication is not always OK, continue - -- only if either the element is static or is - -- an aggregate which can itself be flattened, - -- and the replication count is not too high. - - elsif (Is_Static_Element (Elmt) - or else - (Nkind (Expression (Elmt)) = N_Aggregate - and then Present (Next_Index (Ix)))) - and then Rep_Count <= Max_Others_Replicate - then - null; - - -- Return False in all the other cases + -- Otherwise, check that the replication count + -- is not too high. - else + elsif Rep_Count > Max_Others_Replicate then return False; end if; end; @@ -5282,8 +5307,7 @@ package body Exp_Aggr is Choice_Index := UI_To_Int (Expr_Value (Choice)); if Choice_Index in Vals'Range then - Vals (Choice_Index) := - New_Copy_Tree (Expression (Elmt)); + Vals (Choice_Index) := New_Copy_Tree (Expr); goto Continue; -- Choice is statically out-of-range, will be @@ -5307,7 +5331,7 @@ package body Exp_Aggr is for J in UI_To_Int (Expr_Value (Lo)) .. UI_To_Int (Expr_Value (Hi)) loop - Vals (J) := New_Copy_Tree (Expression (Elmt)); + Vals (J) := New_Copy_Tree (Expr); end loop; end if; @@ -5335,7 +5359,7 @@ package body Exp_Aggr is -- Is_Flat -- ------------- - function Is_Flat (N : Node_Id; Dims : Int) return Boolean is + function Is_Flat (N : Node_Id; Dims : Nat) return Boolean is Elmt : Node_Id; begin @@ -5367,17 +5391,13 @@ package body Exp_Aggr is -- Is_Static_Element -- ------------------------- - function Is_Static_Element (N : Node_Id) return Boolean is + function Is_Static_Element (N : Node_Id; Dims : Nat) return Boolean is Expr : constant Node_Id := Expression (N); begin - if Nkind_In (Expr, N_Integer_Literal, N_Real_Literal) then - return True; + -- In most cases the interesting expressions are unambiguously static - elsif Is_Entity_Name (Expr) - and then Present (Entity (Expr)) - and then Ekind (Entity (Expr)) = E_Enumeration_Literal - then + if Compile_Time_Known_Value (Expr) then return True; elsif Nkind (N) = N_Iterated_Component_Association then @@ -5389,6 +5409,14 @@ package body Exp_Aggr is then return True; + -- However, one may write static expressions that are syntactically + -- ambiguous, so preanalyze the expression before checking it again, + -- but only at the innermost level for a multidimensional array. + + elsif Dims = 1 then + Preanalyze_And_Resolve (Expr, Component_Type (Typ)); + return Compile_Time_Known_Value (Expr); + else return False; end if; @@ -5418,7 +5446,7 @@ package body Exp_Aggr is -- elaboration code, so that the aggregate can be used as the -- initial value of a thread-local variable. - if Is_Flat (N, Number_Dimensions (Typ)) then + if Is_Flat (N, Dims) then if Static_Array_Aggregate (N) then Set_Compile_Time_Known_Aggregate (N); end if; @@ -5453,7 +5481,8 @@ package body Exp_Aggr is -- it will eventually be able to treat such aggregates statically??? if Aggr_Size_OK (N, Typ) - and then Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ))) + and then + Flatten (N, Dims, First_Index (Typ), First_Index (Base_Type (Typ))) then if Static_Components then Set_Compile_Time_Known_Aggregate (N); @@ -8112,17 +8141,40 @@ package body Exp_Aggr is Target : Node_Id) return List_Id is Aggr_Code : List_Id; + New_Aggr : Node_Id; begin - if Is_Array_Type (Etype (N)) then - Aggr_Code := - Build_Array_Aggr_Code - (N => N, - Ctype => Component_Type (Etype (N)), - Index => First_Index (Typ), - Into => Target, - Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)), - Indexes => No_List); + if Is_Array_Type (Typ) then + -- If the assignment can be done directly by the back end, then + -- reset Set_Expansion_Delayed and do not expand further. + + if not CodePeer_Mode + and then not Modify_Tree_For_C + and then not Possible_Bit_Aligned_Component (Target) + and then not Is_Possibly_Unaligned_Slice (Target) + and then Aggr_Assignment_OK_For_Backend (N) + then + New_Aggr := New_Copy_Tree (N); + Set_Expansion_Delayed (New_Aggr, False); + + Aggr_Code := + New_List ( + Make_OK_Assignment_Statement (Sloc (New_Aggr), + Name => Target, + Expression => New_Aggr)); + + -- Or else, generate component assignments to it + + else + Aggr_Code := + Build_Array_Aggr_Code + (N => N, + Ctype => Component_Type (Typ), + Index => First_Index (Typ), + Into => Target, + Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)), + Indexes => No_List); + end if; -- Directly or indirectly (e.g. access protected procedure) a record -- 2.30.2