First, this change extends the memset optimization to the case of array
aggregates nested in other aggregates, when the outer aggregates are
expanded component-wise; second, it prevents the compiler from
duplicating allocators and other nonstatic constructs present in an
Others choice of array aggregates, even in a preelaborate context.
In addition, if the expression given in an Others choice of an aggregate
is not obviously static, this causes the compiler to preanalyze it in
order to resolve syntactic ambiguities in static expressions, for
example conversions; this also makes the Flatten function treat all
nested aggregates alike in the case of a multidimensional array by
checking if they can recursively be flattened in any position in the
outer aggregate, i.e. not just in the first and the last positions.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- 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
