From 3b26fe826601cd43b8a4e7b1b29114034bd3eabb Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 22 May 2018 13:26:11 +0000 Subject: [PATCH] [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. 2018-05-22 Hristian Kirtchev 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. From-SVN: r260526 --- gcc/ada/ChangeLog | 22 ++ gcc/ada/exp_ch3.adb | 568 ++++++++++++++++++++++++++------------------ gcc/ada/exp_ch3.ads | 38 +-- 3 files changed, 386 insertions(+), 242 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5a5905731fa..5a0cf049962 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2018-05-22 Hristian Kirtchev + + * 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. + 2018-05-22 Patrick Bernardi * sem_ch3.adb (Build_Discriminant_Constraints): Raise an error if the diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 9d7fda4767d..a43166b8881 100644 --- a/gcc/ada/exp_ch3.adb +++ b/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; diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index ecc9019f7f5..65faa3136df 100644 --- a/gcc/ada/exp_ch3.ads +++ b/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; -- 2.30.2