exp_aggr.adb (Aggr_Size_OK): An array with no components can always be expanded in place.
2005-06-14 Ed Schonberg <schonberg@adacore.com> * exp_aggr.adb (Aggr_Size_OK): An array with no components can always be expanded in place. The size computation does not require a subtraction, which would raise an exception on a compiler built with assertions when the upper bound is Integer'first. (Flatten): For an array of composite components, take into account the size of the components to determine whether it is safe to expand the array into a purely positional representation. From-SVN: r101031
This commit is contained in:
parent
2aab5fd53b
commit
643a083902
|
@ -158,6 +158,13 @@ package body Exp_Aggr is
|
||||||
-- Local Subprograms for Array Aggregate Expansion --
|
-- Local Subprograms for Array Aggregate Expansion --
|
||||||
-----------------------------------------------------
|
-----------------------------------------------------
|
||||||
|
|
||||||
|
function Aggr_Size_OK (Typ : Entity_Id) return Boolean;
|
||||||
|
-- Very large static aggregates present problems to the back-end, and
|
||||||
|
-- are transformed into assignments and loops. This function verifies
|
||||||
|
-- that the total number of components of an aggregate is acceptable
|
||||||
|
-- for transformation into a purely positional static form. It is called
|
||||||
|
-- prior to calling Flatten.
|
||||||
|
|
||||||
procedure Convert_Array_Aggr_In_Allocator
|
procedure Convert_Array_Aggr_In_Allocator
|
||||||
(Decl : Node_Id;
|
(Decl : Node_Id;
|
||||||
Aggr : Node_Id;
|
Aggr : Node_Id;
|
||||||
|
@ -269,6 +276,152 @@ package body Exp_Aggr is
|
||||||
-- the assignment can be done in place even if bounds are not static,
|
-- the assignment can be done in place even if bounds are not static,
|
||||||
-- by converting it into a loop over the discrete range of the slice.
|
-- by converting it into a loop over the discrete range of the slice.
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- Aggr_Size_OK --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
function Aggr_Size_OK (Typ : Entity_Id) return Boolean is
|
||||||
|
Lo : Node_Id;
|
||||||
|
Hi : Node_Id;
|
||||||
|
Indx : Node_Id;
|
||||||
|
Siz : Int;
|
||||||
|
Lov : Uint;
|
||||||
|
Hiv : Uint;
|
||||||
|
|
||||||
|
-- The following constant determines the maximum size of an
|
||||||
|
-- aggregate produced by converting named to positional
|
||||||
|
-- notation (e.g. from others clauses). This avoids running
|
||||||
|
-- away with attempts to convert huge aggregates, which hit
|
||||||
|
-- memory limits in the backend.
|
||||||
|
|
||||||
|
-- The normal limit is 5000, but we increase this limit to
|
||||||
|
-- 2**24 (about 16 million) if Restrictions (No_Elaboration_Code)
|
||||||
|
-- or Restrictions (No_Implicit_Loops) is specified, since in
|
||||||
|
-- either case, we are at risk of declaring the program illegal
|
||||||
|
-- because of this limit.
|
||||||
|
|
||||||
|
Max_Aggr_Size : constant Nat :=
|
||||||
|
5000 + (2 ** 24 - 5000) *
|
||||||
|
Boolean'Pos
|
||||||
|
(Restriction_Active (No_Elaboration_Code)
|
||||||
|
or else
|
||||||
|
Restriction_Active (No_Implicit_Loops));
|
||||||
|
|
||||||
|
function Component_Count (T : Entity_Id) return Int;
|
||||||
|
-- The limit is applied to the total number of components that the
|
||||||
|
-- aggregate will have, which is the number of static expressions
|
||||||
|
-- that will appear in the flattened array. This requires a recursive
|
||||||
|
-- computation of the the number of scalar components of the structure.
|
||||||
|
|
||||||
|
---------------------
|
||||||
|
-- Component_Count --
|
||||||
|
---------------------
|
||||||
|
|
||||||
|
function Component_Count (T : Entity_Id) return Int is
|
||||||
|
Res : Int := 0;
|
||||||
|
Comp : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Is_Scalar_Type (T) then
|
||||||
|
return 1;
|
||||||
|
|
||||||
|
elsif Is_Record_Type (T) then
|
||||||
|
Comp := First_Component (T);
|
||||||
|
while Present (Comp) loop
|
||||||
|
Res := Res + Component_Count (Etype (Comp));
|
||||||
|
Next_Component (Comp);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
return Res;
|
||||||
|
|
||||||
|
elsif Is_Array_Type (T) then
|
||||||
|
declare
|
||||||
|
Lo : constant Node_Id :=
|
||||||
|
Type_Low_Bound (Etype (First_Index (T)));
|
||||||
|
Hi : constant Node_Id :=
|
||||||
|
Type_High_Bound (Etype (First_Index (T)));
|
||||||
|
|
||||||
|
Siz : constant Int := Component_Count (Component_Type (T));
|
||||||
|
|
||||||
|
begin
|
||||||
|
if not Compile_Time_Known_Value (Lo)
|
||||||
|
or else not Compile_Time_Known_Value (Hi)
|
||||||
|
then
|
||||||
|
return 0;
|
||||||
|
else
|
||||||
|
return
|
||||||
|
Siz * UI_To_Int (Expr_Value (Hi) - Expr_Value (Lo) + 1);
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
-- Can only be a null for an access type
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
end if;
|
||||||
|
end Component_Count;
|
||||||
|
|
||||||
|
-- Start of processing for Aggr_Size_OK
|
||||||
|
|
||||||
|
begin
|
||||||
|
Siz := Component_Count (Component_Type (Typ));
|
||||||
|
Indx := First_Index (Typ);
|
||||||
|
|
||||||
|
while Present (Indx) loop
|
||||||
|
Lo := Type_Low_Bound (Etype (Indx));
|
||||||
|
Hi := Type_High_Bound (Etype (Indx));
|
||||||
|
|
||||||
|
-- Bounds need to be known at compile time
|
||||||
|
|
||||||
|
if not Compile_Time_Known_Value (Lo)
|
||||||
|
or else not Compile_Time_Known_Value (Hi)
|
||||||
|
then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Lov := Expr_Value (Lo);
|
||||||
|
Hiv := Expr_Value (Hi);
|
||||||
|
|
||||||
|
-- A flat array is always safe
|
||||||
|
|
||||||
|
if Hiv < Lov then
|
||||||
|
return True;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
declare
|
||||||
|
Rng : constant Uint := Hiv - Lov + 1;
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Check if size is too large
|
||||||
|
|
||||||
|
if not UI_Is_In_Int_Range (Rng) then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Siz := Siz * UI_To_Int (Rng);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Siz <= 0
|
||||||
|
or else Siz > Max_Aggr_Size
|
||||||
|
then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Bounds must be in integer range, for later array construction
|
||||||
|
|
||||||
|
if not UI_Is_In_Int_Range (Lov)
|
||||||
|
or else
|
||||||
|
not UI_Is_In_Int_Range (Hiv)
|
||||||
|
then
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Next_Index (Indx);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
return True;
|
||||||
|
end Aggr_Size_OK;
|
||||||
|
|
||||||
---------------------------------
|
---------------------------------
|
||||||
-- Backend_Processing_Possible --
|
-- Backend_Processing_Possible --
|
||||||
---------------------------------
|
---------------------------------
|
||||||
|
@ -2680,7 +2833,9 @@ package body Exp_Aggr is
|
||||||
(N : Node_Id;
|
(N : Node_Id;
|
||||||
Ix : Node_Id;
|
Ix : Node_Id;
|
||||||
Ixb : Node_Id) return Boolean;
|
Ixb : Node_Id) return Boolean;
|
||||||
-- Convert the aggregate into a purely positional form if possible
|
-- 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;
|
function Is_Flat (N : Node_Id; Dims : Int) return Boolean;
|
||||||
-- Return True iff the array N is flat (which is not rivial
|
-- Return True iff the array N is flat (which is not rivial
|
||||||
|
@ -2702,39 +2857,12 @@ package body Exp_Aggr is
|
||||||
Lov : Uint;
|
Lov : Uint;
|
||||||
Hiv : Uint;
|
Hiv : Uint;
|
||||||
|
|
||||||
-- The following constant determines the maximum size of an
|
|
||||||
-- aggregate produced by converting named to positional
|
|
||||||
-- notation (e.g. from others clauses). This avoids running
|
|
||||||
-- away with attempts to convert huge aggregates.
|
|
||||||
|
|
||||||
-- The normal limit is 5000, but we increase this limit to
|
|
||||||
-- 2**24 (about 16 million) if Restrictions (No_Elaboration_Code)
|
|
||||||
-- or Restrictions (No_Implicit_Loops) is specified, since in
|
|
||||||
-- either case, we are at risk of declaring the program illegal
|
|
||||||
-- because of this limit.
|
|
||||||
|
|
||||||
Max_Aggr_Size : constant Nat :=
|
|
||||||
5000 + (2 ** 24 - 5000) *
|
|
||||||
Boolean'Pos
|
|
||||||
(Restriction_Active (No_Elaboration_Code)
|
|
||||||
or else
|
|
||||||
Restriction_Active (No_Implicit_Loops));
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (Original_Node (N)) = N_String_Literal then
|
if Nkind (Original_Node (N)) = N_String_Literal then
|
||||||
return True;
|
return True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Bounds need to be known at compile time
|
-- Only handle bounds starting at the base type low bound
|
||||||
|
|
||||||
if not Compile_Time_Known_Value (Lo)
|
|
||||||
or else not Compile_Time_Known_Value (Hi)
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Get bounds and check reasonable size (positive, not too large)
|
|
||||||
-- Also only handle bounds starting at the base type low bound
|
|
||||||
-- for now since the compiler isn't able to handle different low
|
-- for now since the compiler isn't able to handle different low
|
||||||
-- bounds yet. Case such as new String'(3..5 => ' ') will get
|
-- bounds yet. Case such as new String'(3..5 => ' ') will get
|
||||||
-- the wrong bounds, though it seems that the aggregate should
|
-- the wrong bounds, though it seems that the aggregate should
|
||||||
|
@ -2744,22 +2872,12 @@ package body Exp_Aggr is
|
||||||
Hiv := Expr_Value (Hi);
|
Hiv := Expr_Value (Hi);
|
||||||
|
|
||||||
if Hiv < Lov
|
if Hiv < Lov
|
||||||
or else (Hiv - Lov > Max_Aggr_Size)
|
|
||||||
or else not Compile_Time_Known_Value (Blo)
|
or else not Compile_Time_Known_Value (Blo)
|
||||||
or else (Lov /= Expr_Value (Blo))
|
or else (Lov /= Expr_Value (Blo))
|
||||||
then
|
then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Bounds must be in integer range (for array Vals below)
|
|
||||||
|
|
||||||
if not UI_Is_In_Int_Range (Lov)
|
|
||||||
or else
|
|
||||||
not UI_Is_In_Int_Range (Hiv)
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Determine if set of alternatives is suitable for conversion
|
-- Determine if set of alternatives is suitable for conversion
|
||||||
-- and build an array containing the values in sequence.
|
-- and build an array containing the values in sequence.
|
||||||
|
|
||||||
|
@ -2987,7 +3105,10 @@ package body Exp_Aggr is
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ))) then
|
if Aggr_Size_OK (Typ)
|
||||||
|
and then
|
||||||
|
Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ)))
|
||||||
|
then
|
||||||
Analyze_And_Resolve (N, Typ);
|
Analyze_And_Resolve (N, Typ);
|
||||||
end if;
|
end if;
|
||||||
end Convert_To_Positional;
|
end Convert_To_Positional;
|
||||||
|
|
Loading…
Reference in New Issue