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;
-- 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
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;
-------------
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
-- Check if there is an others choice
+ Others_Present := False;
+
if Present (Component_Associations (N)) then
declare
Assoc : Node_Id;
-- 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;
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;
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
-- 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
-- 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;
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
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;
-- 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
-- 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
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;
-- 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;
-- 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);
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
projects / gcc.git / commitdiff