This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] In-place initialization for Initialize_Scalars
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Hristian Kirtchev <kirtchev at adacore dot com>
- Date: Tue, 22 May 2018 09:46:13 -0400
- Subject: [Ada] In-place initialization for Initialize_Scalars
This patch cleans up the implementation of routine Get_Simple_Init_Val. It also
eliminates potentially large and unnecessary tree replications in the context
of object default initialization.
No change in behavior, no test needed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-22 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* exp_ch3.adb (Build_Array_Init_Proc): Update the call to
Needs_Simple_Initialization.
(Build_Init_Statements): Update the call to Get_Simple_Init_Val.
(Check_Subtype_Bounds): Renamed to Extract_Subtype_Bounds. Update the
profile and comment on usage.
(Default_Initialize_Object): Do not use New_Copy_Tree to set the proper
Sloc of a value obtained from aspect Default_Value because this could
potentially replicate large trees. The proper Sloc is now set in
Get_Simple_Init_Val.
(Get_Simple_Init_Val): Reorganized by breaking the various cases into
separate routines. Eliminate the use of global variables.
(Init_Component): Update the call to Get_Simple_Init_Val.
(Needs_Simple_Initialization): Update the parameter profile and all
uses of T.
(Simple_Init_Defaulted_Type): Copy the value of aspect Default_Value
and set the proper Sloc.
* exp_ch3.ads (Get_Simple_Init_Val): Update the parameter profile and
comment on usage.
(Needs_Simple_Initialization): Update the parameter profile.
--- gcc/ada/exp_ch3.adb
+++ gcc/ada/exp_ch3.adb
@@ -520,7 +520,7 @@ package body Exp_Ch3 is
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Comp_Simple_Init : constant Boolean :=
Needs_Simple_Initialization
- (T => Comp_Type,
+ (Typ => Comp_Type,
Consider_IS =>
not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
-- True if the component needs simple initialization, based on its type,
@@ -576,13 +576,17 @@ package body Exp_Ch3 is
Name => Comp,
Expression =>
Get_Simple_Init_Val
- (Comp_Type, Nod, Component_Size (A_Type))));
+ (Typ => Comp_Type,
+ N => Nod,
+ Size => Component_Size (A_Type))));
else
Clean_Task_Names (Comp_Type, Proc_Id);
return
Build_Initialization_Call
- (Loc, Comp, Comp_Type,
+ (Loc => Loc,
+ Id_Ref => Comp,
+ Typ => Comp_Type,
In_Init_Proc => True,
Enclos_Type => A_Type);
end if;
@@ -3106,7 +3110,12 @@ package body Exp_Ch3 is
elsif Component_Needs_Simple_Initialization (Typ) then
Actions :=
Build_Assignment
- (Id, Get_Simple_Init_Val (Typ, N, Esize (Id)));
+ (Id => Id,
+ Default =>
+ Get_Simple_Init_Val
+ (Typ => Typ,
+ N => N,
+ Size => Esize (Id)));
-- Nothing needed for this case
@@ -3277,7 +3286,12 @@ package body Exp_Ch3 is
elsif Component_Needs_Simple_Initialization (Typ) then
Append_List_To (Stmts,
Build_Assignment
- (Id, Get_Simple_Init_Val (Typ, N, Esize (Id))));
+ (Id => Id,
+ Default =>
+ Get_Simple_Init_Val
+ (Typ => Typ,
+ N => N,
+ Size => Esize (Id))));
end if;
end if;
@@ -6004,9 +6018,9 @@ package body Exp_Ch3 is
and then not Initialization_Suppressed (Typ)
then
-- Do not initialize the components if No_Default_Initialization
- -- applies as the actual restriction check will occur later
- -- when the object is frozen as it is not known yet whether the
- -- object is imported or not.
+ -- applies as the actual restriction check will occur later when
+ -- the object is frozen as it is not known yet whether the object
+ -- is imported or not.
if not Restriction_Active (No_Default_Initialization) then
@@ -6016,8 +6030,8 @@ package body Exp_Ch3 is
Aggr_Init := Static_Initialization (Base_Init_Proc (Typ));
if Present (Aggr_Init) then
- Set_Expression
- (N, New_Copy_Tree (Aggr_Init, New_Scope => Current_Scope));
+ Set_Expression (N,
+ New_Copy_Tree (Aggr_Init, New_Scope => Current_Scope));
-- If type has discriminants, try to build an equivalent
-- aggregate using discriminant values from the declaration.
@@ -6053,9 +6067,10 @@ package body Exp_Ch3 is
then
Set_No_Initialization (N, False);
Set_Expression (N,
- New_Copy_Tree
- (Source => Get_Simple_Init_Val (Typ, N, Esize (Def_Id)),
- New_Sloc => Sloc (Obj_Def)));
+ Get_Simple_Init_Val
+ (Typ => Typ,
+ N => Obj_Def,
+ Size => Esize (Def_Id)));
Analyze_And_Resolve (Expression (N), Typ);
end if;
@@ -7916,47 +7931,66 @@ package body Exp_Ch3 is
-------------------------
function Get_Simple_Init_Val
- (T : Entity_Id;
+ (Typ : Entity_Id;
N : Node_Id;
Size : Uint := No_Uint) return Node_Id
is
- Loc : constant Source_Ptr := Sloc (N);
- Val : Node_Id;
- Result : Node_Id;
- Val_RE : RE_Id;
-
- Size_To_Use : Uint;
- -- This is the size to be used for computation of the appropriate
- -- initial value for the Normalize_Scalars and Initialize_Scalars case.
-
IV_Attribute : constant Boolean :=
Nkind (N) = N_Attribute_Reference
and then Attribute_Name (N) = Name_Invalid_Value;
- Lo_Bound : Uint;
- Hi_Bound : Uint;
- -- These are the values computed by the procedure Check_Subtype_Bounds
+ Loc : constant Source_Ptr := Sloc (N);
+
+ procedure Extract_Subtype_Bounds
+ (Lo_Bound : out Uint;
+ Hi_Bound : out Uint);
+ -- Inspect subtype Typ as well its ancestor subtypes and derived types
+ -- to determine the best known information about the bounds of the type.
+ -- The output parameters are set as follows:
+ --
+ -- * Lo_Bound - Set to No_Unit when there is no information available,
+ -- or to the known low bound.
+ --
+ -- * Hi_Bound - Set to No_Unit when there is no information available,
+ -- or to the known high bound.
+
+ function Simple_Init_Defaulted_Type return Node_Id;
+ -- Build an expression to initialize type Typ which is subject to
+ -- aspect Default_Value.
- procedure Check_Subtype_Bounds;
- -- This procedure examines the subtype T, and its ancestor subtypes and
- -- derived types to determine the best known information about the
- -- bounds of the subtype. After the call Lo_Bound is set either to
- -- No_Uint if no information can be determined, or to a value which
- -- represents a known low bound, i.e. a valid value of the subtype can
- -- not be less than this value. Hi_Bound is similarly set to a known
- -- high bound (valid value cannot be greater than this).
+ function Simple_Init_Initialize_Scalars_Type
+ (Size_To_Use : Uint) return Node_Id;
+ -- Build an expression to initialize scalar type Typ which is subject to
+ -- pragma Initialize_Scalars. Size_To_Use is the size of the object.
- --------------------------
- -- Check_Subtype_Bounds --
- --------------------------
+ function Simple_Init_Normalize_Scalars_Type
+ (Size_To_Use : Uint) return Node_Id;
+ -- Build an expression to initialize scalar type Typ which is subject to
+ -- pragma Normalize_Scalars. Size_To_Use is the size of the object.
- procedure Check_Subtype_Bounds is
- ST1 : Entity_Id;
- ST2 : Entity_Id;
- Lo : Node_Id;
- Hi : Node_Id;
- Loval : Uint;
- Hival : Uint;
+ function Simple_Init_Private_Type return Node_Id;
+ -- Build an expression to initialize private type Typ
+
+ function Simple_Init_Scalar_Type return Node_Id;
+ -- Build an expression to initialize scalar type Typ
+
+ function Simple_Init_String_Type return Node_Id;
+ -- Build an expression to initialize string type Typ
+
+ ----------------------------
+ -- Extract_Subtype_Bounds --
+ ----------------------------
+
+ procedure Extract_Subtype_Bounds
+ (Lo_Bound : out Uint;
+ Hi_Bound : out Uint)
+ is
+ ST1 : Entity_Id;
+ ST2 : Entity_Id;
+ Lo : Node_Id;
+ Hi : Node_Id;
+ Lo_Val : Uint;
+ Hi_Val : Uint;
begin
Lo_Bound := No_Uint;
@@ -7964,7 +7998,7 @@ package body Exp_Ch3 is
-- Loop to climb ancestor subtypes and derived types
- ST1 := T;
+ ST1 := Typ;
loop
if not Is_Discrete_Type (ST1) then
return;
@@ -7974,18 +8008,18 @@ package body Exp_Ch3 is
Hi := Type_High_Bound (ST1);
if Compile_Time_Known_Value (Lo) then
- Loval := Expr_Value (Lo);
+ Lo_Val := Expr_Value (Lo);
- if Lo_Bound = No_Uint or else Lo_Bound < Loval then
- Lo_Bound := Loval;
+ if Lo_Bound = No_Uint or else Lo_Bound < Lo_Val then
+ Lo_Bound := Lo_Val;
end if;
end if;
if Compile_Time_Known_Value (Hi) then
- Hival := Expr_Value (Hi);
+ Hi_Val := Expr_Value (Hi);
- if Hi_Bound = No_Uint or else Hi_Bound > Hival then
- Hi_Bound := Hival;
+ if Hi_Bound = No_Uint or else Hi_Bound > Hi_Val then
+ Hi_Bound := Hi_Val;
end if;
end if;
@@ -7998,206 +8032,262 @@ package body Exp_Ch3 is
exit when ST1 = ST2;
ST1 := ST2;
end loop;
- end Check_Subtype_Bounds;
+ end Extract_Subtype_Bounds;
- -- Start of processing for Get_Simple_Init_Val
+ --------------------------------
+ -- Simple_Init_Defaulted_Type --
+ --------------------------------
- begin
- -- For a private type, we should always have an underlying type (because
- -- this was already checked in Needs_Simple_Initialization). What we do
- -- is to get the value for the underlying type and then do an unchecked
- -- conversion to the private type.
+ function Simple_Init_Defaulted_Type return Node_Id is
+ Subtyp : constant Entity_Id := First_Subtype (Typ);
- if Is_Private_Type (T) then
- Val := Get_Simple_Init_Val (Underlying_Type (T), N, Size);
+ begin
+ -- Use the Sloc of the context node when constructing the initial
+ -- value because the expression of Default_Value may come from a
+ -- different unit. Updating the Sloc will result in accurate error
+ -- diagnostics.
- -- A special case, if the underlying value is null, then qualify it
- -- with the underlying type, so that the null is properly typed.
- -- Similarly, if it is an aggregate it must be qualified, because an
- -- unchecked conversion does not provide a context for it.
+ -- When the first subtype is private, retrieve the expression of the
+ -- Default_Value from the underlying type.
- if Nkind_In (Val, N_Null, N_Aggregate) then
- Val :=
- Make_Qualified_Expression (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Underlying_Type (T), Loc),
- Expression => Val);
+ if Is_Private_Type (Subtyp) then
+ return
+ Unchecked_Convert_To
+ (Typ => Typ,
+ Expr =>
+ New_Copy_Tree
+ (Source => Default_Aspect_Value (Full_View (Subtyp)),
+ New_Sloc => Loc));
+
+ else
+ return
+ Convert_To
+ (Typ => Typ,
+ Expr =>
+ New_Copy_Tree
+ (Source => Default_Aspect_Value (Subtyp),
+ New_Sloc => Loc));
end if;
+ end Simple_Init_Defaulted_Type;
- Result := Unchecked_Convert_To (T, Val);
+ -----------------------------------------
+ -- Simple_Init_Initialize_Scalars_Type --
+ -----------------------------------------
- -- Don't truncate result (important for Initialize/Normalize_Scalars)
+ function Simple_Init_Initialize_Scalars_Type
+ (Size_To_Use : Uint) return Node_Id
+ is
+ Float_Typ : Entity_Id;
+ Hi_Bound : Uint;
+ Lo_Bound : Uint;
+ Val_RE : RE_Id;
- if Nkind (Result) = N_Unchecked_Type_Conversion
- and then Is_Scalar_Type (Underlying_Type (T))
- then
- Set_No_Truncation (Result);
- end if;
+ begin
+ Extract_Subtype_Bounds (Lo_Bound, Hi_Bound);
- return Result;
+ -- For float types, use float values from System.Scalar_Values
- -- Scalars with Default_Value aspect. The first subtype may now be
- -- private, so retrieve value from underlying type.
+ if Is_Floating_Point_Type (Typ) then
+ Float_Typ := Root_Type (Typ);
- elsif Is_Scalar_Type (T) and then Has_Default_Aspect (T) then
- if Is_Private_Type (First_Subtype (T)) then
- return Unchecked_Convert_To (T,
- Default_Aspect_Value (Full_View (First_Subtype (T))));
- else
- return
- Convert_To (T, Default_Aspect_Value (First_Subtype (T)));
- end if;
+ if Float_Typ = Standard_Short_Float then
+ Val_RE := RE_IS_Isf;
+ elsif Float_Typ = Standard_Float then
+ Val_RE := RE_IS_Ifl;
+ elsif Float_Typ = Standard_Long_Float then
+ Val_RE := RE_IS_Ilf;
+ else pragma Assert (Float_Typ = Standard_Long_Long_Float);
+ Val_RE := RE_IS_Ill;
+ end if;
- -- Otherwise, for scalars, we must have normalize/initialize scalars
- -- case, or if the node N is an 'Invalid_Value attribute node.
+ -- If zero is invalid, use zero values from System.Scalar_Values
- elsif Is_Scalar_Type (T) then
- pragma Assert (Init_Or_Norm_Scalars or IV_Attribute);
+ elsif Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then
+ if Size_To_Use <= 8 then
+ Val_RE := RE_IS_Iz1;
+ elsif Size_To_Use <= 16 then
+ Val_RE := RE_IS_Iz2;
+ elsif Size_To_Use <= 32 then
+ Val_RE := RE_IS_Iz4;
+ else
+ Val_RE := RE_IS_Iz8;
+ end if;
- -- Compute size of object. If it is given by the caller, we can use
- -- it directly, otherwise we use Esize (T) as an estimate. As far as
- -- we know this covers all cases correctly.
+ -- For unsigned, use unsigned values from System.Scalar_Values
+
+ elsif Is_Unsigned_Type (Typ) then
+ if Size_To_Use <= 8 then
+ Val_RE := RE_IS_Iu1;
+ elsif Size_To_Use <= 16 then
+ Val_RE := RE_IS_Iu2;
+ elsif Size_To_Use <= 32 then
+ Val_RE := RE_IS_Iu4;
+ else
+ Val_RE := RE_IS_Iu8;
+ end if;
+
+ -- For signed, use signed values from System.Scalar_Values
- if Size = No_Uint or else Size <= Uint_0 then
- Size_To_Use := UI_Max (Uint_1, Esize (T));
else
- Size_To_Use := Size;
+ if Size_To_Use <= 8 then
+ Val_RE := RE_IS_Is1;
+ elsif Size_To_Use <= 16 then
+ Val_RE := RE_IS_Is2;
+ elsif Size_To_Use <= 32 then
+ Val_RE := RE_IS_Is4;
+ else
+ Val_RE := RE_IS_Is8;
+ end if;
end if;
- -- Maximum size to use is 64 bits, since we will create values of
- -- type Unsigned_64 and the range must fit this type.
+ return New_Occurrence_Of (RTE (Val_RE), Loc);
+ end Simple_Init_Initialize_Scalars_Type;
- if Size_To_Use /= No_Uint and then Size_To_Use > Uint_64 then
- Size_To_Use := Uint_64;
- end if;
+ ----------------------------------------
+ -- Simple_Init_Normalize_Scalars_Type --
+ ----------------------------------------
- -- Check known bounds of subtype
+ function Simple_Init_Normalize_Scalars_Type
+ (Size_To_Use : Uint) return Node_Id
+ is
+ Signed_Size : constant Uint := UI_Min (Uint_63, Size_To_Use - 1);
- Check_Subtype_Bounds;
+ Expr : Node_Id;
+ Hi_Bound : Uint;
+ Lo_Bound : Uint;
- -- Processing for Normalize_Scalars case
+ begin
+ Extract_Subtype_Bounds (Lo_Bound, Hi_Bound);
- if Normalize_Scalars and then not IV_Attribute then
+ -- If zero is invalid, it is a convenient value to use that is for
+ -- sure an appropriate invalid value in all situations.
- -- If zero is invalid, it is a convenient value to use that is
- -- for sure an appropriate invalid value in all situations.
+ if Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then
+ Expr := Make_Integer_Literal (Loc, 0);
- if Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then
- Val := Make_Integer_Literal (Loc, 0);
+ -- Cases where all one bits is the appropriate invalid value
- -- Cases where all one bits is the appropriate invalid value
+ -- For modular types, all 1 bits is either invalid or valid. If it
+ -- is valid, then there is nothing that can be done since there are
+ -- no invalid values (we ruled out zero already).
- -- For modular types, all 1 bits is either invalid or valid. If
- -- it is valid, then there is nothing that can be done since there
- -- are no invalid values (we ruled out zero already).
+ -- For signed integer types that have no negative values, either
+ -- there is room for negative values, or there is not. If there
+ -- is, then all 1-bits may be interpreted as minus one, which is
+ -- certainly invalid. Alternatively it is treated as the largest
+ -- positive value, in which case the observation for modular types
+ -- still applies.
- -- For signed integer types that have no negative values, either
- -- there is room for negative values, or there is not. If there
- -- is, then all 1-bits may be interpreted as minus one, which is
- -- certainly invalid. Alternatively it is treated as the largest
- -- positive value, in which case the observation for modular types
- -- still applies.
+ -- For float types, all 1-bits is a NaN (not a number), which is
+ -- certainly an appropriately invalid value.
- -- For float types, all 1-bits is a NaN (not a number), which is
- -- certainly an appropriately invalid value.
+ elsif Is_Enumeration_Type (Typ)
+ or else Is_Floating_Point_Type (Typ)
+ or else Is_Unsigned_Type (Typ)
+ then
+ Expr := Make_Integer_Literal (Loc, 2 ** Size_To_Use - 1);
- elsif Is_Unsigned_Type (T)
- or else Is_Floating_Point_Type (T)
- or else Is_Enumeration_Type (T)
- then
- Val := Make_Integer_Literal (Loc, 2 ** Size_To_Use - 1);
+ -- Resolve as Unsigned_64, because the largest number we can
+ -- generate is out of range of universal integer.
- -- Resolve as Unsigned_64, because the largest number we can
- -- generate is out of range of universal integer.
+ Analyze_And_Resolve (Expr, RTE (RE_Unsigned_64));
- Analyze_And_Resolve (Val, RTE (RE_Unsigned_64));
+ -- Case of signed types
+
+ else
+ -- Normally we like to use the most negative number. The one
+ -- exception is when this number is in the known subtype range and
+ -- the largest positive number is not in the known subtype range.
+
+ -- For this exceptional case, use largest positive value
+
+ if Lo_Bound /= No_Uint and then Hi_Bound /= No_Uint
+ and then Lo_Bound <= (-(2 ** Signed_Size))
+ and then Hi_Bound < 2 ** Signed_Size
+ then
+ Expr := Make_Integer_Literal (Loc, 2 ** Signed_Size - 1);
- -- Case of signed types
+ -- Normal case of largest negative value
else
- declare
- Signed_Size : constant Uint :=
- UI_Min (Uint_63, Size_To_Use - 1);
+ Expr := Make_Integer_Literal (Loc, -(2 ** Signed_Size));
+ end if;
+ end if;
- begin
- -- Normally we like to use the most negative number. The one
- -- exception is when this number is in the known subtype
- -- range and the largest positive number is not in the known
- -- subtype range.
+ return Expr;
+ end Simple_Init_Normalize_Scalars_Type;
- -- For this exceptional case, use largest positive value
+ ------------------------------
+ -- Simple_Init_Private_Type --
+ ------------------------------
- if Lo_Bound /= No_Uint and then Hi_Bound /= No_Uint
- and then Lo_Bound <= (-(2 ** Signed_Size))
- and then Hi_Bound < 2 ** Signed_Size
- then
- Val := Make_Integer_Literal (Loc, 2 ** Signed_Size - 1);
+ function Simple_Init_Private_Type return Node_Id is
+ Under_Typ : constant Entity_Id := Underlying_Type (Typ);
+ Expr : Node_Id;
- -- Normal case of largest negative value
+ begin
+ -- The availability of the underlying view must be checked by routine
+ -- Needs_Simple_Initialization.
- else
- Val := Make_Integer_Literal (Loc, -(2 ** Signed_Size));
- end if;
- end;
- end if;
+ pragma Assert (Present (Under_Typ));
- -- Here for Initialize_Scalars case (or Invalid_Value attribute used)
+ Expr := Get_Simple_Init_Val (Under_Typ, N, Size);
- else
- -- For float types, use float values from System.Scalar_Values
-
- if Is_Floating_Point_Type (T) then
- if Root_Type (T) = Standard_Short_Float then
- Val_RE := RE_IS_Isf;
- elsif Root_Type (T) = Standard_Float then
- Val_RE := RE_IS_Ifl;
- elsif Root_Type (T) = Standard_Long_Float then
- Val_RE := RE_IS_Ilf;
- else pragma Assert (Root_Type (T) = Standard_Long_Long_Float);
- Val_RE := RE_IS_Ill;
- end if;
+ -- If the initial value is null or an aggregate, qualify it with the
+ -- underlying type in order to provide a proper context.
+
+ if Nkind_In (Expr, N_Aggregate, N_Null) then
+ Expr :=
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Under_Typ, Loc),
+ Expression => Expr);
+ end if;
- -- If zero is invalid, use zero values from System.Scalar_Values
+ Expr := Unchecked_Convert_To (Typ, Expr);
- elsif Lo_Bound /= No_Uint and then Lo_Bound > Uint_0 then
- if Size_To_Use <= 8 then
- Val_RE := RE_IS_Iz1;
- elsif Size_To_Use <= 16 then
- Val_RE := RE_IS_Iz2;
- elsif Size_To_Use <= 32 then
- Val_RE := RE_IS_Iz4;
- else
- Val_RE := RE_IS_Iz8;
- end if;
+ -- Do not truncate the result when scalar types are involved and
+ -- Initialize/Normalize_Scalars is in effect.
- -- For unsigned, use unsigned values from System.Scalar_Values
+ if Nkind (Expr) = N_Unchecked_Type_Conversion
+ and then Is_Scalar_Type (Under_Typ)
+ then
+ Set_No_Truncation (Expr);
+ end if;
- elsif Is_Unsigned_Type (T) then
- if Size_To_Use <= 8 then
- Val_RE := RE_IS_Iu1;
- elsif Size_To_Use <= 16 then
- Val_RE := RE_IS_Iu2;
- elsif Size_To_Use <= 32 then
- Val_RE := RE_IS_Iu4;
- else
- Val_RE := RE_IS_Iu8;
- end if;
+ return Expr;
+ end Simple_Init_Private_Type;
- -- For signed, use signed values from System.Scalar_Values
+ -----------------------------
+ -- Simple_Init_Scalar_Type --
+ -----------------------------
- else
- if Size_To_Use <= 8 then
- Val_RE := RE_IS_Is1;
- elsif Size_To_Use <= 16 then
- Val_RE := RE_IS_Is2;
- elsif Size_To_Use <= 32 then
- Val_RE := RE_IS_Is4;
- else
- Val_RE := RE_IS_Is8;
- end if;
- end if;
+ function Simple_Init_Scalar_Type return Node_Id is
+ Expr : Node_Id;
+ Size_To_Use : Uint;
+
+ begin
+ pragma Assert (Init_Or_Norm_Scalars or IV_Attribute);
- Val := New_Occurrence_Of (RTE (Val_RE), Loc);
+ -- Determine the size of the object. This is either the size provided
+ -- by the caller, or the Esize of the scalar type.
+
+ if Size = No_Uint or else Size <= Uint_0 then
+ Size_To_Use := UI_Max (Uint_1, Esize (Typ));
+ else
+ Size_To_Use := Size;
+ end if;
+
+ -- The maximum size to use is 64 bits. This will create values of
+ -- type Unsigned_64 and the range must fit this type.
+
+ if Size_To_Use /= No_Uint and then Size_To_Use > Uint_64 then
+ Size_To_Use := Uint_64;
+ end if;
+
+ if Normalize_Scalars and then not IV_Attribute then
+ Expr := Simple_Init_Normalize_Scalars_Type (Size_To_Use);
+ else
+ Expr := Simple_Init_Initialize_Scalars_Type (Size_To_Use);
end if;
-- The final expression is obtained by doing an unchecked conversion
@@ -8205,36 +8295,64 @@ package body Exp_Ch3 is
-- base type to prevent the unchecked conversion from chopping bits,
-- and then we set Kill_Range_Check to preserve the "bad" value.
- Result := Unchecked_Convert_To (Base_Type (T), Val);
+ Expr := Unchecked_Convert_To (Base_Type (Typ), Expr);
- -- Ensure result is not truncated, since we want the "bad" bits, and
- -- also kill range check on result.
+ -- Ensure that the expression is not truncated since the "bad" bits
+ -- are desired, and also kill the range checks.
- if Nkind (Result) = N_Unchecked_Type_Conversion then
- Set_No_Truncation (Result);
- Set_Kill_Range_Check (Result, True);
+ if Nkind (Expr) = N_Unchecked_Type_Conversion then
+ Set_Kill_Range_Check (Expr);
+ Set_No_Truncation (Expr);
end if;
- return Result;
+ return Expr;
+ end Simple_Init_Scalar_Type;
- -- String or Wide_[Wide]_String (must have Initialize_Scalars set)
+ -----------------------------
+ -- Simple_Init_String_Type --
+ -----------------------------
- elsif Is_Standard_String_Type (T) then
- pragma Assert (Init_Or_Norm_Scalars);
+ function Simple_Init_String_Type return Node_Id is
+ Comp_Typ : constant Entity_Id := Component_Type (Typ);
+
+ begin
+ -- Generate:
+ -- (others => Get_Simple_Init_Value)
return
Make_Aggregate (Loc,
Component_Associations => New_List (
Make_Component_Association (Loc,
- Choices => New_List (
- Make_Others_Choice (Loc)),
+ Choices => New_List (Make_Others_Choice (Loc)),
Expression =>
Get_Simple_Init_Val
- (Component_Type (T), N, Esize (Root_Type (T))))));
+ (Typ => Comp_Typ,
+ N => N,
+ Size => Esize (Comp_Typ)))));
+ end Simple_Init_String_Type;
+
+ -- Start of processing for Get_Simple_Init_Val
+
+ begin
+ if Is_Private_Type (Typ) then
+ return Simple_Init_Private_Type;
+
+ elsif Is_Scalar_Type (Typ) then
+ if Has_Default_Aspect (Typ) then
+ return Simple_Init_Defaulted_Type;
+ else
+ return Simple_Init_Scalar_Type;
+ end if;
+
+ -- [[Wide_]Wide_]String with Initialize or Normalize_Scalars
+
+ elsif Is_Standard_String_Type (Typ) then
+ pragma Assert (Init_Or_Norm_Scalars);
+ return Simple_Init_String_Type;
-- Access type is initialized to null
- elsif Is_Access_Type (T) then
+ elsif Is_Access_Type (Typ) then
return Make_Null (Loc);
-- No other possibilities should arise, since we should only be calling
@@ -9889,7 +10007,7 @@ package body Exp_Ch3 is
---------------------------------
function Needs_Simple_Initialization
- (T : Entity_Id;
+ (Typ : Entity_Id;
Consider_IS : Boolean := True) return Boolean
is
Consider_IS_NS : constant Boolean :=
@@ -9898,16 +10016,16 @@ package body Exp_Ch3 is
begin
-- Never need initialization if it is suppressed
- if Initialization_Suppressed (T) then
+ if Initialization_Suppressed (Typ) then
return False;
end if;
-- Check for private type, in which case test applies to the underlying
-- type of the private type.
- if Is_Private_Type (T) then
+ if Is_Private_Type (Typ) then
declare
- RT : constant Entity_Id := Underlying_Type (T);
+ RT : constant Entity_Id := Underlying_Type (Typ);
begin
if Present (RT) then
return Needs_Simple_Initialization (RT);
@@ -9918,15 +10036,15 @@ package body Exp_Ch3 is
-- Scalar type with Default_Value aspect requires initialization
- elsif Is_Scalar_Type (T) and then Has_Default_Aspect (T) then
+ elsif Is_Scalar_Type (Typ) and then Has_Default_Aspect (Typ) then
return True;
-- Cases needing simple initialization are access types, and, if pragma
-- Normalize_Scalars or Initialize_Scalars is in effect, then all scalar
-- types.
- elsif Is_Access_Type (T)
- or else (Consider_IS_NS and then (Is_Scalar_Type (T)))
+ elsif Is_Access_Type (Typ)
+ or else (Consider_IS_NS and then (Is_Scalar_Type (Typ)))
then
return True;
@@ -9936,10 +10054,10 @@ package body Exp_Ch3 is
-- filled with appropriate initializing values before they are used).
elsif Consider_IS_NS
- and then Is_Standard_String_Type (T)
+ and then Is_Standard_String_Type (Typ)
and then
- (not Is_Itype (T)
- or else Nkind (Associated_Node_For_Itype (T)) /= N_Aggregate)
+ (not Is_Itype (Typ)
+ or else Nkind (Associated_Node_For_Itype (Typ)) /= N_Aggregate)
then
return True;
--- gcc/ada/exp_ch3.ads
+++ gcc/ada/exp_ch3.ads
@@ -91,6 +91,26 @@ package Exp_Ch3 is
-- want Gigi to see the node. This function can't delete the node itself
-- since it would confuse any remaining processing of the freeze node.
+ function Get_Simple_Init_Val
+ (Typ : Entity_Id;
+ N : Node_Id;
+ Size : Uint := No_Uint) return Node_Id;
+ -- Build an expression which represents the required initial value of type
+ -- Typ for which predicate Needs_Simple_Initialization is True. N is a node
+ -- whose source location used in the construction of the expression. Size
+ -- is utilized as follows:
+ --
+ -- * If the size of the object to be initialized it is known, it should
+ -- be passed to the routine.
+ --
+ -- * If the size is unknown or is zero, then the Esize of Typ is used as
+ -- an estimate of the size.
+ --
+ -- The object size is needed to prepare a known invalid value for use by
+ -- Normalize_Scalars. A call to this routine where Typ denotes a scalar
+ -- type is only valid when Normalize_Scalars or Initialize_Scalars is
+ -- active, or if N is the node for a 'Invalid_Value attribute node.
+
procedure Init_Secondary_Tags
(Typ : Entity_Id;
Target : Node_Id;
@@ -115,7 +135,7 @@ package Exp_Ch3 is
-- see Check_Address_Clause.
function Needs_Simple_Initialization
- (T : Entity_Id;
+ (Typ : Entity_Id;
Consider_IS : Boolean := True) return Boolean;
-- Certain types need initialization even though there is no specific
-- initialization routine:
@@ -127,20 +147,4 @@ package Exp_Ch3 is
-- set to False, but if Consider_IS is set to True, then the cases above
-- mentioning Normalize_Scalars also apply for Initialize_Scalars mode.
- function Get_Simple_Init_Val
- (T : Entity_Id;
- N : Node_Id;
- Size : Uint := No_Uint) return Node_Id;
- -- For a type which Needs_Simple_Initialization (see above), prepares the
- -- tree for an expression representing the required initial value. N is a
- -- node whose source location used in constructing this tree which is
- -- returned as the result of the call. The Size parameter indicates the
- -- target size of the object if it is known (indicated by a value that is
- -- not No_Uint and is greater than zero). If Size is not given (Size set to
- -- No_Uint, or non-positive), then the Esize of T is used as an estimate of
- -- the Size. The object size is needed to prepare a known invalid value for
- -- use by Normalize_Scalars. A call to this routine where T is a scalar
- -- type is only valid if we are in Normalize_Scalars or Initialize_Scalars
- -- mode, or if N is the node for a 'Invalid_Value attribute node.
-
end Exp_Ch3;