From b23cdc01588b60f52a8c70c8f4465a068b49d317 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 2 Jul 2021 11:41:28 -0400 Subject: [Ada] Clean up uses of Esize and RM_Size gcc/ada/ * einfo-utils.adb: Add support (currently disabled) for using "initial zero" instead of "Uint_0" to represent "unknown". Call Known_ functions, instead of evilly duplicating their code inline. * fe.h (No_Uint_To_0): New function to convert No_Uint to Uint_0, in order to preserve existing behavior. (Copy_Esize, Copy_RM_Size): New imports from Einfo.Utils. * cstand.adb: Set size fields of Standard_Debug_Renaming_Type and Standard_Exception_Type. * checks.adb, exp_attr.adb, exp_ch3.adb, exp_ch5.adb, exp_ch6.adb, exp_pakd.adb, exp_util.adb, freeze.adb, itypes.adb, layout.adb, repinfo.adb, sem_attr.adb, sem_ch12.adb, sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch7.adb, sem_util.adb: Protect calls with Known_..., use Copy_... Remove assumption that Uint_0 represents "unknown". * types.ads (Nonzero_Int): New subtype. * gcc-interface/decl.c, gcc-interface/trans.c: Protect calls with Known_... and use Copy_... as appropriate, to avoid blowing up in unknown cases. Similarly, call No_Uint_To_0 to preserve existing behavior. --- gcc/ada/checks.adb | 1 + gcc/ada/cstand.adb | 8 ++-- gcc/ada/einfo-utils.adb | 106 ++++++++++++++++++++++++++++-------------- gcc/ada/exp_attr.adb | 2 +- gcc/ada/exp_ch3.adb | 13 ++++-- gcc/ada/exp_ch5.adb | 4 +- gcc/ada/exp_ch6.adb | 2 + gcc/ada/exp_pakd.adb | 27 +++++++---- gcc/ada/exp_util.adb | 15 +++--- gcc/ada/fe.h | 15 ++++++ gcc/ada/freeze.adb | 27 ++++++----- gcc/ada/gcc-interface/decl.c | 39 +++++++++------- gcc/ada/gcc-interface/trans.c | 4 +- gcc/ada/itypes.adb | 3 +- gcc/ada/layout.adb | 10 ++-- gcc/ada/repinfo.adb | 17 +------ gcc/ada/sem_attr.adb | 14 +++--- gcc/ada/sem_ch12.adb | 4 +- gcc/ada/sem_ch13.adb | 27 +++++------ gcc/ada/sem_ch13.ads | 6 ++- gcc/ada/sem_ch3.adb | 28 +++++------ gcc/ada/sem_ch7.adb | 2 +- gcc/ada/sem_util.adb | 2 +- gcc/ada/types.ads | 2 + 24 files changed, 221 insertions(+), 157 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 292a620..8f5c0b0 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6892,6 +6892,7 @@ package body Checks is elsif Is_Known_Valid (Typ) then if Is_Entity_Name (Expr) and then Ekind (Entity (Expr)) = E_Variable + and then Known_Esize (Entity (Expr)) and then Esize (Entity (Expr)) > Esize (Typ) then return False; diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index e65751a..409944c 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -1159,10 +1159,8 @@ package body CStand is Mutate_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype); Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard); Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer)); - pragma Assert - (Field_Is_Initial_Zero (Standard_Debug_Renaming_Type, F_Esize)); - pragma Assert - (Field_Is_Initial_Zero (Standard_Debug_Renaming_Type, F_RM_Size)); + Set_Esize (Standard_Debug_Renaming_Type, Uint_0); + Set_RM_Size (Standard_Debug_Renaming_Type, Uint_0); Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type); Set_Integer_Bounds (Standard_Debug_Renaming_Type, Typ => Base_Type (Standard_Debug_Renaming_Type), @@ -1511,7 +1509,7 @@ package body CStand is Set_Scope (Standard_Exception_Type, Standard_Standard); Set_Stored_Constraint (Standard_Exception_Type, No_Elist); - Reinit_Size_Align (Standard_Exception_Type); + Set_RM_Size (Standard_Exception_Type, Uint_0); Set_Size_Known_At_Compile_Time (Standard_Exception_Type, True); diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index d805889..15bd9e8 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -362,10 +362,9 @@ package body Einfo.Utils is -- Type Representation Attribute Fields -- ------------------------------------------ - function Known_Alignment (E : Entity_Id) return B is - Result : constant B := not Field_Is_Initial_Zero (E, F_Alignment); + function Known_Alignment (E : Entity_Id) return B is begin - return Result; + return not Field_Is_Initial_Zero (E, F_Alignment); end Known_Alignment; procedure Reinit_Alignment (Id : E) is @@ -382,96 +381,133 @@ package body Einfo.Utils is end if; end Copy_Alignment; - function Known_Component_Bit_Offset (E : Entity_Id) return B is + function Known_Component_Bit_Offset (E : Entity_Id) return B is begin return Present (Component_Bit_Offset (E)); end Known_Component_Bit_Offset; - function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is + function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is begin return Present (Component_Bit_Offset (E)) and then Component_Bit_Offset (E) >= Uint_0; end Known_Static_Component_Bit_Offset; - function Known_Component_Size (E : Entity_Id) return B is + function Known_Component_Size (E : Entity_Id) return B is begin return Component_Size (E) /= Uint_0 and then Present (Component_Size (E)); end Known_Component_Size; - function Known_Static_Component_Size (E : Entity_Id) return B is + function Known_Static_Component_Size (E : Entity_Id) return B is begin return Component_Size (E) > Uint_0; end Known_Static_Component_Size; - function Known_Esize (E : Entity_Id) return B is + Use_New_Unknown_Rep : constant Boolean := False; + -- If False, we represent "unknown" as Uint_0, which is wrong. + -- We intend to make it True (and remove it), and represent + -- "unknown" as Field_Is_Initial_Zero. We also need to change + -- the type of Esize and RM_Size from Uint to Valid_Uint. + + function Known_Esize (E : Entity_Id) return B is begin - return Esize (E) /= Uint_0 - and then Present (Esize (E)); + if Use_New_Unknown_Rep then + return not Field_Is_Initial_Zero (E, F_Esize); + else + return Esize (E) /= Uint_0 + and then Present (Esize (E)); + end if; end Known_Esize; - function Known_Static_Esize (E : Entity_Id) return B is + function Known_Static_Esize (E : Entity_Id) return B is begin - return Esize (E) > Uint_0 + return Known_Esize (E) + and then Esize (E) >= Uint_0 and then not Is_Generic_Type (E); end Known_Static_Esize; procedure Reinit_Esize (Id : E) is begin - Set_Esize (Id, Uint_0); + if Use_New_Unknown_Rep then + Reinit_Field_To_Zero (Id, F_Esize); + else + Set_Esize (Id, Uint_0); + end if; end Reinit_Esize; procedure Copy_Esize (To, From : E) is begin - raise Program_Error with "Copy_Esize not yet implemented"; + if Known_Esize (From) then + Set_Esize (To, Esize (From)); + else + Reinit_Esize (To); + end if; end Copy_Esize; - function Known_Normalized_First_Bit (E : Entity_Id) return B is + function Known_Normalized_First_Bit (E : Entity_Id) return B is begin return Present (Normalized_First_Bit (E)); end Known_Normalized_First_Bit; - function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is + function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is begin return Present (Normalized_First_Bit (E)) and then Normalized_First_Bit (E) >= Uint_0; end Known_Static_Normalized_First_Bit; - function Known_Normalized_Position (E : Entity_Id) return B is + function Known_Normalized_Position (E : Entity_Id) return B is begin return Present (Normalized_Position (E)); end Known_Normalized_Position; - function Known_Static_Normalized_Position (E : Entity_Id) return B is + function Known_Static_Normalized_Position (E : Entity_Id) return B is begin return Present (Normalized_Position (E)) and then Normalized_Position (E) >= Uint_0; end Known_Static_Normalized_Position; - function Known_RM_Size (E : Entity_Id) return B is + function Known_RM_Size (E : Entity_Id) return B is begin - return Present (RM_Size (E)) - and then (RM_Size (E) /= Uint_0 - or else Is_Discrete_Type (E) - or else Is_Fixed_Point_Type (E)); + if Use_New_Unknown_Rep then + return not Field_Is_Initial_Zero (E, F_RM_Size); + else + return Present (RM_Size (E)) + and then (RM_Size (E) /= Uint_0 + or else Is_Discrete_Type (E) + or else Is_Fixed_Point_Type (E)); + end if; end Known_RM_Size; - function Known_Static_RM_Size (E : Entity_Id) return B is + function Known_Static_RM_Size (E : Entity_Id) return B is begin - return (RM_Size (E) > Uint_0 - or else Is_Discrete_Type (E) - or else Is_Fixed_Point_Type (E)) - and then not Is_Generic_Type (E); + if Use_New_Unknown_Rep then + return Known_RM_Size (E) + and then RM_Size (E) >= Uint_0 + and then not Is_Generic_Type (E); + else + return (RM_Size (E) > Uint_0 + or else Is_Discrete_Type (E) + or else Is_Fixed_Point_Type (E)) + and then not Is_Generic_Type (E); + end if; end Known_Static_RM_Size; procedure Reinit_RM_Size (Id : E) is begin - Set_RM_Size (Id, Uint_0); + if Use_New_Unknown_Rep then + Reinit_Field_To_Zero (Id, F_RM_Size); + else + Set_RM_Size (Id, Uint_0); + end if; end Reinit_RM_Size; procedure Copy_RM_Size (To, From : E) is begin - raise Program_Error with "Copy_RM_Size not yet implemented"; + if Known_RM_Size (From) then + Set_RM_Size (To, RM_Size (From)); + else + Reinit_RM_Size (To); + end if; end Copy_RM_Size; ------------------------------- @@ -503,12 +539,10 @@ package body Einfo.Utils is procedure Init_Size (Id : E; V : Int) is begin pragma Assert (Is_Type (Id)); - pragma Assert - (not Known_Esize (Id) or else Esize (Id) = V); - pragma Assert - (No (RM_Size (Id)) - or else RM_Size (Id) = Uint_0 - or else RM_Size (Id) = V); + pragma Assert (not Known_Esize (Id) or else Esize (Id) = V); + if Use_New_Unknown_Rep then + pragma Assert (not Known_RM_Size (Id) or else RM_Size (Id) = V); + end if; Set_Esize (Id, UI_From_Int (V)); Set_RM_Size (Id, UI_From_Int (V)); end Init_Size; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4af8cf4..c962c2a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -7354,7 +7354,7 @@ package body Exp_Attr is if Nkind (P) in N_Has_Entity and then Present (Entity (P)) and then Is_Object (Entity (P)) - and then Esize (Entity (P)) /= Uint_0 + and then Known_Esize (Entity (P)) then if Esize (Entity (P)) <= System_Max_Integer_Size then Size := Esize (Entity (P)); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 1588280..45d5baf 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -3421,7 +3421,8 @@ package body Exp_Ch3 is Clean_Task_Names (Typ, Proc_Id); - -- Simple initialization + -- Simple initialization. If the Esize is not yet set, we pass + -- Uint_0 as expected by Get_Simple_Init_Val. elsif Component_Needs_Simple_Initialization (Typ) then Actions := @@ -3431,7 +3432,9 @@ package body Exp_Ch3 is Get_Simple_Init_Val (Typ => Typ, N => N, - Size => Esize (Id))); + Size => + (if Known_Esize (Id) then Esize (Id) + else Uint_0))); -- Nothing needed for this case @@ -6507,7 +6510,8 @@ package body Exp_Ch3 is Get_Simple_Init_Val (Typ => Typ, N => Obj_Def, - Size => Esize (Def_Id))); + Size => (if Known_Esize (Def_Id) then Esize (Def_Id) + else Uint_0))); Analyze_And_Resolve (Expression (N), Typ, Suppress => All_Checks); @@ -6534,7 +6538,8 @@ package body Exp_Ch3 is Get_Simple_Init_Val (Typ => Typ, N => Obj_Def, - Size => Esize (Def_Id))); + Size => + (if Known_Esize (Def_Id) then Esize (Def_Id) else Uint_0))); Analyze_And_Resolve (Expression (N), Typ); end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 08ce562f..9827326 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1698,8 +1698,8 @@ package body Exp_Ch5 is (Etype (Left_Base_Index))) and then RTE_Available (RE_Fast_Copy_Bitfield) then - pragma Assert (Esize (L_Type) /= 0); - pragma Assert (Esize (R_Type) /= 0); + pragma Assert (Known_Esize (L_Type)); + pragma Assert (Known_Esize (R_Type)); return Expand_Assign_Array_Bitfield_Fast (N, Larray, Rarray); end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 59704a4..5055184 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4520,6 +4520,8 @@ package body Exp_Ch6 is or else (Is_Record_Type (Formal_Typ) and then Is_Record_Type (Parent_Typ))) + and then Known_Esize (Formal_Typ) + and then Known_Esize (Parent_Typ) and then (Esize (Formal_Typ) /= Esize (Parent_Typ) or else Has_Pragma_Pack (Formal_Typ) /= diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index e27d00b..9b11813 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -493,7 +493,7 @@ package body Exp_Pakd is Ancest : Entity_Id; PB_Type : Entity_Id; - PASize : Uint; + PASize : Uint := No_Uint; Decl : Node_Id; PAT : Entity_Id; Len_Expr : Node_Id; @@ -563,12 +563,14 @@ package body Exp_Pakd is -- Do not reset RM_Size if already set, as happens in the case of -- a modular type. - if not Known_Esize (PAT) then - Set_Esize (PAT, PASize); - end if; + if Present (PASize) then + if not Known_Esize (PAT) then + Set_Esize (PAT, PASize); + end if; - if not Known_RM_Size (PAT) then - Set_RM_Size (PAT, PASize); + if not Known_RM_Size (PAT) then + Set_RM_Size (PAT, PASize); + end if; end if; Adjust_Esize_Alignment (PAT); @@ -680,7 +682,9 @@ package body Exp_Pakd is -- type, since this size clearly belongs to the packed array type. The -- size of the conceptual unpacked type is always set to unknown. - PASize := RM_Size (Typ); + if Known_RM_Size (Typ) then + PASize := RM_Size (Typ); + end if; -- Case of an array where at least one index is of an enumeration -- type with a non-standard representation, but the component size @@ -943,7 +947,7 @@ package body Exp_Pakd is Make_Integer_Literal (Loc, 0), High_Bound => Lit)))); - if PASize = Uint_0 then + if Present (PASize) then PASize := Len_Bits; end if; @@ -1973,6 +1977,7 @@ package body Exp_Pakd is Rtyp : Entity_Id; PAT : Entity_Id; Lit : Node_Id; + Size : Unat; begin Convert_To_Actual_Subtype (Opnd); @@ -1994,9 +1999,11 @@ package body Exp_Pakd is -- where PAT is the packed array type, Mask is a mask of all 1 bits of -- length equal to the size of this packed type, and Rtyp is the actual - -- actual subtype of the operand. + -- actual subtype of the operand. Preserve old behavior in case size is + -- not set. - Lit := Make_Integer_Literal (Loc, 2 ** RM_Size (PAT) - 1); + Size := (if Known_RM_Size (PAT) then RM_Size (PAT) else Uint_0); + Lit := Make_Integer_Literal (Loc, 2 ** Size - 1); Set_Print_In_Hex (Lit); if not Is_Array_Type (PAT) then diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2802169..b438d0b 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -10994,26 +10994,25 @@ package body Exp_Util is -- At the current time, the only types that we return False for (i.e. where -- we decide we know they cannot generate large temps) are ones where we -- know the size is 256 bits or less at compile time, and we are still not - -- doing a thorough job on arrays and records ??? + -- doing a thorough job on arrays and records. function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean is begin if not Size_Known_At_Compile_Time (Typ) then return False; + end if; - elsif Esize (Typ) /= 0 and then Esize (Typ) <= 256 then + if Known_Esize (Typ) and then Esize (Typ) <= 256 then return False; + end if; - elsif Is_Array_Type (Typ) + if Is_Array_Type (Typ) and then Present (Packed_Array_Impl_Type (Typ)) then return May_Generate_Large_Temp (Packed_Array_Impl_Type (Typ)); - - -- We could do more here to find other small types ??? - - else - return True; end if; + + return True; end May_Generate_Large_Temp; -------------------------------------------- diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index d956327..488e811 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -69,6 +69,15 @@ extern Boolean Debug_Flag_NN; /* einfo: */ +/* Valid_Uint is used to preserve the old behavior of Esize and + friends, where Uint_0 was the default. All calls to this + are questionable. */ +INLINE Valid_Uint +No_Uint_To_0 (Uint X) +{ + return X == No_Uint ? Uint_0 : X; +} + #define Set_Alignment einfo__entities__set_alignment #define Set_Component_Bit_Offset einfo__entities__set_component_bit_offset #define Set_Component_Size einfo__entities__set_component_size @@ -618,6 +627,12 @@ B Known_RM_Size (Entity_Id E); #define Copy_Alignment einfo__utils__copy_alignment B Copy_Alignment(Entity_Id To, Entity_Id From); +#define Copy_Esize einfo__utils__copy_esize +B Copy_Esize(Entity_Id To, Entity_Id From); + +#define Copy_RM_Size einfo__utils__copy_rm_size +B Copy_RM_Size(Entity_Id To, Entity_Id From); + #define Is_Discrete_Or_Fixed_Point_Type einfo__utils__is_discrete_or_fixed_point_type B Is_Discrete_Or_Fixed_Point_Type (E Id); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 170f667..c3c4f53 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3640,8 +3640,8 @@ package body Freeze is (No (Ancestor_Subtype (Arr)) or else not Has_Size_Clause (Ancestor_Subtype (Arr))) then - Set_Esize (Arr, Esize (Packed_Array_Impl_Type (Arr))); - Set_RM_Size (Arr, RM_Size (Packed_Array_Impl_Type (Arr))); + Copy_Esize (To => Arr, From => Packed_Array_Impl_Type (Arr)); + Copy_RM_Size (To => Arr, From => Packed_Array_Impl_Type (Arr)); end if; if not Has_Alignment_Clause (Arr) then @@ -4173,6 +4173,7 @@ package body Freeze is -- active. if Is_Access_Type (F_Type) + and then Known_Esize (F_Type) and then Esize (F_Type) > Ttypes.System_Address_Size and then (not Unnest_Subprogram_Mode or else not Is_Access_Subprogram_Type (F_Type)) @@ -4313,6 +4314,7 @@ package body Freeze is -- Check suspicious return of fat C pointer if Is_Access_Type (R_Type) + and then Known_Esize (R_Type) and then Esize (R_Type) > Ttypes.System_Address_Size and then not Has_Warnings_Off (E) and then not Has_Warnings_Off (R_Type) @@ -6249,7 +6251,8 @@ package body Freeze is if Is_Array_Type (E) then declare Ctyp : constant Entity_Id := Component_Type (E); - Rsiz : constant Uint := RM_Size (Ctyp); + Rsiz : constant Uint := + (if Known_RM_Size (Ctyp) then RM_Size (Ctyp) else Uint_0); SZ : constant Node_Id := Size_Clause (E); Btyp : constant Entity_Id := Base_Type (E); @@ -6695,7 +6698,7 @@ package body Freeze is if Is_Type (Full_View (E)) then Set_Size_Info (E, Full_View (E)); - Set_RM_Size (E, RM_Size (Full_View (E))); + Copy_RM_Size (To => E, From => Full_View (E)); end if; goto Leave; @@ -8579,10 +8582,10 @@ package body Freeze is Orig_Hi : Ureal; -- Save original bounds (for shaving tests) - Actual_Size : Nat; + Actual_Size : Int; -- Actual size chosen - function Fsize (Lov, Hiv : Ureal) return Nat; + function Fsize (Lov, Hiv : Ureal) return Int; -- Returns size of type with given bounds. Also leaves these -- bounds set as the current bounds of the Typ. @@ -8596,7 +8599,7 @@ package body Freeze is -- Fsize -- ----------- - function Fsize (Lov, Hiv : Ureal) return Nat is + function Fsize (Lov, Hiv : Ureal) return Int is begin Set_Realval (Lo, Lov); Set_Realval (Hi, Hiv); @@ -8642,7 +8645,7 @@ package body Freeze is if Present (Atype) then Set_Esize (Typ, Esize (Atype)); else - Set_Esize (Typ, Esize (Btyp)); + Copy_Esize (To => Typ, From => Btyp); end if; end if; @@ -8705,8 +8708,8 @@ package body Freeze is Loval_Excl_EP : Ureal; Hival_Excl_EP : Ureal; - Size_Incl_EP : Nat; - Size_Excl_EP : Nat; + Size_Incl_EP : Int; + Size_Excl_EP : Int; Model_Num : Ureal; First_Subt : Entity_Id; @@ -9141,7 +9144,9 @@ package body Freeze is Minsiz : constant Uint := UI_From_Int (Minimum_Size (Typ)); begin - if RM_Size (Typ) /= Uint_0 then + if Known_RM_Size (Typ) + and then RM_Size (Typ) /= Uint_0 + then if RM_Size (Typ) < Minsiz then Error_Msg_Uint_1 := RM_Size (Typ); Error_Msg_Uint_2 := Minsiz; diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0120b21..884d1d8 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4303,7 +4303,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, VAR_DECL, false, false, size_s, type_s); - else + + /* ??? The test on Has_Size_Clause must be removed when "unknown" is + no longer represented as Uint_0 (i.e. Use_New_Unknown_Rep). */ + else if (Known_RM_Size (gnat_entity) + || Has_Size_Clause (gnat_entity)) gnu_size = validate_size (RM_Size (gnat_entity), gnu_type, gnat_entity, TYPE_DECL, false, Has_Size_Clause (gnat_entity), @@ -4386,7 +4390,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Now set the RM size of the type. We cannot do it before padding because we need to accept arbitrary RM sizes on integral types. */ - set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity); + if (Known_RM_Size (gnat_entity)) + set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity); /* Back-annotate the alignment of the type if not already set. */ if (!Known_Alignment (gnat_entity)) @@ -4417,16 +4422,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Likewise for the size, if any. */ if (!Known_Esize (gnat_entity) && TYPE_SIZE (gnu_type)) { - tree gnu_size = TYPE_SIZE (gnu_type); + tree size = TYPE_SIZE (gnu_type); /* If the size is self-referential, annotate the maximum value after saturating it, if need be, to avoid a No_Uint value. */ - if (CONTAINS_PLACEHOLDER_P (gnu_size)) + if (CONTAINS_PLACEHOLDER_P (size)) { const unsigned int align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT; - gnu_size - = maybe_saturate_size (max_size (gnu_size, true), align); + size = maybe_saturate_size (max_size (size, true), align); } /* If we are just annotating types and the type is tagged, the tag @@ -4464,12 +4468,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (TYPE_FIELDS (gnu_type)) offset = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type))); - gnu_size = size_binop (PLUS_EXPR, gnu_size, offset); + size = size_binop (PLUS_EXPR, size, offset); } - gnu_size - = maybe_saturate_size (round_up (gnu_size, align), align); - Set_Esize (gnat_entity, annotate_value (gnu_size)); + size = maybe_saturate_size (round_up (size, align), align); + Set_Esize (gnat_entity, annotate_value (size)); /* Tagged types are Strict_Alignment so RM_Size = Esize. */ if (!Known_RM_Size (gnat_entity)) @@ -4478,12 +4481,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Otherwise no adjustment is needed. */ else - Set_Esize (gnat_entity, annotate_value (gnu_size)); + Set_Esize (gnat_entity, No_Uint_To_0 (annotate_value (size))); } /* Likewise for the RM size, if any. */ if (!Known_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type)) - Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type))); + Set_RM_Size (gnat_entity, + No_Uint_To_0 (annotate_value (rm_size (gnu_type)))); /* If we are at global level, GCC applied variable_size to the size but this has done nothing. So, if it's not constant or self-referential, @@ -4758,9 +4762,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (!Known_Alignment (gnat_entity)) Copy_Alignment (gnat_entity, gnat_annotate_type); if (!Known_Esize (gnat_entity)) - Set_Esize (gnat_entity, Esize (gnat_annotate_type)); + Copy_Esize (gnat_entity, gnat_annotate_type); if (!Known_RM_Size (gnat_entity)) - Set_RM_Size (gnat_entity, RM_Size (gnat_annotate_type)); + Copy_RM_Size (gnat_entity, gnat_annotate_type); } /* If we haven't already, associate the ..._DECL node that we just made with @@ -8774,7 +8778,7 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) size = TYPE_SIZE (gnu_type); if (size) - Set_Esize (gnat_entity, annotate_value (size)); + Set_Esize (gnat_entity, No_Uint_To_0 (annotate_value (size))); } if (!Known_Alignment (gnat_entity)) @@ -8880,8 +8884,9 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) (gnat_field, annotate_value (bit_from_pos (offset, bit_offset))); - Set_Esize (gnat_field, - annotate_value (DECL_SIZE (TREE_PURPOSE (t)))); + Set_Esize + (gnat_field, + No_Uint_To_0 (annotate_value (DECL_SIZE (TREE_PURPOSE (t))))); } else if (is_extension) { diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3df56aa..d3c421d 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -9279,10 +9279,10 @@ process_freeze_entity (Node_Id gnat_node) Copy_Alignment (gnat_entity, full_view); if (!Known_Esize (gnat_entity)) - Set_Esize (gnat_entity, Esize (full_view)); + Copy_Esize (gnat_entity, full_view); if (!Known_RM_Size (gnat_entity)) - Set_RM_Size (gnat_entity, RM_Size (full_view)); + Copy_RM_Size (gnat_entity, full_view); /* The above call may have defined this entity (the simplest example of this is when we have a private enumeral type since the bounds diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb index 8cbc8d6..ffaa4fe 100644 --- a/gcc/ada/itypes.adb +++ b/gcc/ada/itypes.adb @@ -29,7 +29,6 @@ with Sinfo; use Sinfo; with Sinfo.Nodes; use Sinfo.Nodes; with Stand; use Stand; with Targparm; use Targparm; -with Uintp; use Uintp; package body Itypes is @@ -64,7 +63,7 @@ package body Itypes is -- Make sure Esize (Typ) was properly initialized, it should be since -- New_Internal_Entity/New_External_Entity call Reinit_Size_Align. - pragma Assert (Esize (Typ) = Uint_0); + pragma Assert (not Known_Esize (Typ)); Set_Etype (Typ, Any_Type); Set_Is_Itype (Typ); diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 700ae79..092f2f5 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -287,7 +287,7 @@ package body Layout is elsif Ekind (E) = E_Access_Subtype then Set_Size_Info (E, Base_Type (E)); - Set_RM_Size (E, RM_Size (Base_Type (E))); + Copy_RM_Size (To => E, From => Base_Type (E)); -- For other access types, we use either address size, or, if a fat -- pointer is used (pointer-to-unconstrained array case), twice the @@ -426,15 +426,15 @@ package body Layout is begin if not Known_Esize (E) then - Set_Esize (E, Esize (PAT)); + Copy_Esize (To => E, From => PAT); end if; if not Known_RM_Size (E) then - Set_RM_Size (E, RM_Size (PAT)); + Copy_RM_Size (To => E, From => PAT); end if; - if not Known_Alignment (E) and then Known_Alignment (PAT) then - Set_Alignment (E, Alignment (PAT)); + if not Known_Alignment (E) then + Copy_Alignment (To => E, From => PAT); end if; end; end if; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index ce42290..58e0161 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1189,13 +1189,7 @@ package body Repinfo is Write_Str (" .. "); end if; - -- Allowing Uint_0 here is an annoying special case. Really this - -- should be a fine Esize value but currently it means unknown, - -- except that we know after gigi has back annotated that a size - -- of zero is real, since otherwise gigi back annotates using - -- No_Uint as the value to indicate unknown. - - if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent)) + if Known_Static_Esize (Ent) and then Known_Static_Normalized_First_Bit (Ent) then Lbit := Sbit + Esiz - 1; @@ -1210,14 +1204,7 @@ package body Repinfo is UI_Write (Lbit, Decimal); end if; - -- The test for Esize (Ent) not Uint_0 here is an annoying special - -- case. Officially a value of zero for Esize means unknown, but - -- here we use the fact that we know that gigi annotates Esize with - -- No_Uint, not Uint_0. Really everyone should use No_Uint??? - - elsif List_Representation_Info < 3 - or else (Esize (Ent) /= Uint_0 and then not Known_Esize (Ent)) - then + elsif List_Representation_Info < 3 or else not Known_Esize (Ent) then Write_Unknown_Val; -- List_Representation >= 3 and Known_Esize (Ent) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 9540089..b44bbe3 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -8124,13 +8124,13 @@ package body Sem_Attr is end if; -- If we are asked to evaluate an attribute where the prefix is a - -- non-frozen generic actual type whose RM_Size is still set to zero, + -- non-frozen generic actual type whose RM_Size has not been set, -- then abandon the effort. if Is_Type (P_Entity) and then (not Is_Frozen (P_Entity) and then Is_Generic_Actual_Type (P_Entity) - and then RM_Size (P_Entity) = 0) + and then not Known_RM_Size (P_Entity)) -- However, the attribute Unconstrained_Array must be evaluated, -- since it is documented to be a static attribute (and can for @@ -9881,9 +9881,9 @@ package body Sem_Attr is P_TypeA : constant Entity_Id := Underlying_Type (P_Type); begin - if Is_Scalar_Type (P_TypeA) - or else RM_Size (P_TypeA) /= Uint_0 - then + pragma Assert + (if Is_Scalar_Type (P_TypeA) then Known_RM_Size (P_TypeA)); + if Known_RM_Size (P_TypeA) then -- VADS_Size case if Id = Attribute_VADS_Size or else Use_VADS_Size then @@ -10159,7 +10159,9 @@ package body Sem_Attr is P_TypeA : constant Entity_Id := Underlying_Type (P_Type); begin - if Is_Scalar_Type (P_TypeA) or else RM_Size (P_TypeA) /= Uint_0 then + pragma Assert + (if Is_Scalar_Type (P_TypeA) then Known_RM_Size (P_TypeA)); + if Known_RM_Size (P_TypeA) then Fold_Uint (N, RM_Size (P_TypeA), Static); end if; end Value_Size; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d816c07..eca2abf 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -7112,8 +7112,8 @@ package body Sem_Ch12 is Astype := First_Subtype (E); end if; - Set_Size_Info (E, (Astype)); - Set_RM_Size (E, RM_Size (Astype)); + Set_Size_Info (E, (Astype)); + Copy_RM_Size (To => E, From => Astype); Set_First_Rep_Item (E, First_Rep_Item (Astype)); if Is_Discrete_Or_Fixed_Point_Type (E) then diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e841dda..43dd5e1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -14010,7 +14010,7 @@ package body Sem_Ch13 is function Minimum_Size (T : Entity_Id; - Biased : Boolean := False) return Nat + Biased : Boolean := False) return Int is Lo : Uint := No_Uint; Hi : Uint := No_Uint; @@ -14024,17 +14024,17 @@ package body Sem_Ch13 is R_Typ : constant Entity_Id := Root_Type (T); begin - -- If bad type, return 0 + -- Bad type if T = Any_Type then - return 0; + return Unknown_Minimum_Size; - -- For generic types, just return zero. There cannot be any legitimate - -- need to know such a size, but this routine may be called with a - -- generic type as part of normal processing. + -- For generic types, just return unknown. There cannot be any + -- legitimate need to know such a size, but this routine may be + -- called with a generic type as part of normal processing. elsif Is_Generic_Type (R_Typ) or else R_Typ = Any_Type then - return 0; + return Unknown_Minimum_Size; -- Access types (cannot have size smaller than System.Address) @@ -14057,7 +14057,7 @@ package body Sem_Ch13 is Ancest := T; loop if Ancest = Any_Type or else Etype (Ancest) = Any_Type then - return 0; + return Unknown_Minimum_Size; end if; if not LoSet then @@ -14082,7 +14082,7 @@ package body Sem_Ch13 is Ancest := Base_Type (T); if Is_Generic_Type (Ancest) then - return 0; + return Unknown_Minimum_Size; end if; end if; end loop; @@ -14103,7 +14103,7 @@ package body Sem_Ch13 is Ancest := T; loop if Ancest = Any_Type or else Etype (Ancest) = Any_Type then - return 0; + return Unknown_Minimum_Size; end if; -- Note: In the following two tests for LoSet and HiSet, it may @@ -14143,7 +14143,7 @@ package body Sem_Ch13 is Ancest := Base_Type (T); if Is_Generic_Type (Ancest) then - return 0; + return Unknown_Minimum_Size; end if; end if; end loop; @@ -14173,7 +14173,7 @@ package body Sem_Ch13 is -- type case, since that's the odd case that came up. Probably we should -- also do this in the fixed-point case, but doing so causes peculiar -- gigi failures, and it is not worth worrying about this incredibly - -- marginal case (explicit null-range fixed-point type declarations)??? + -- marginal case (explicit null-range fixed-point type declarations). if Lo > Hi and then Is_Discrete_Type (T) then S := 0; @@ -16353,7 +16353,8 @@ package body Sem_Ch13 is if Present (ACCR.Y) then Y_Alignment := Alignment (ACCR.Y); - Y_Size := Esize (ACCR.Y); + Y_Size := + (if Known_Esize (ACCR.Y) then Esize (ACCR.Y) else Uint_0); end if; if ACCR.Off diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 3b21484..0d3b041 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -81,9 +81,11 @@ package Sem_Ch13 is -- the setting of the RM_Size field is not affected. This routine also -- initializes the alignment field to zero. + Unknown_Minimum_Size : constant Nonzero_Int := -1; + function Minimum_Size (T : Entity_Id; - Biased : Boolean := False) return Nat; + Biased : Boolean := False) return Int; -- Given an elementary type, determines the minimum number of bits required -- to represent all values of the type. This function may not be called -- with any other types. If the flag Biased is set True, then the minimum @@ -96,7 +98,7 @@ package Sem_Ch13 is -- the type is already biased, then Minimum_Size returns the biased size, -- regardless of the setting of Biased. Also, fixed-point types are never -- biased in the current implementation. If the size is not known at - -- compile time, this function returns 0. + -- compile time, this function returns Unknown_Minimum_Size. procedure Check_Constant_Address_Clause (Expr : Node_Id; U_Ent : Entity_Id); -- Expr is an expression for an address clause. This procedure checks diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b233c56..cc8a9b7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5508,7 +5508,7 @@ package body Sem_Ch3 is Set_Machine_Radix_10 (Id, Machine_Radix_10 (T)); Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Known_Valid (Id, Is_Known_Valid (T)); - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); when Enumeration_Kind => Mutate_Ekind (Id, E_Enumeration_Subtype); @@ -5517,7 +5517,7 @@ package body Sem_Ch3 is Set_Is_Character_Type (Id, Is_Character_Type (T)); Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Known_Valid (Id, Is_Known_Valid (T)); - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); when Ordinary_Fixed_Point_Kind => Mutate_Ekind (Id, E_Ordinary_Fixed_Point_Subtype); @@ -5526,7 +5526,7 @@ package body Sem_Ch3 is Set_Delta_Value (Id, Delta_Value (T)); Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Known_Valid (Id, Is_Known_Valid (T)); - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); when Float_Kind => Mutate_Ekind (Id, E_Floating_Point_Subtype); @@ -5542,14 +5542,14 @@ package body Sem_Ch3 is Set_Scalar_Range (Id, Scalar_Range (T)); Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Known_Valid (Id, Is_Known_Valid (T)); - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); when Modular_Integer_Kind => Mutate_Ekind (Id, E_Modular_Integer_Subtype); Set_Scalar_Range (Id, Scalar_Range (T)); Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Known_Valid (Id, Is_Known_Valid (T)); - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); when Class_Wide_Kind => Mutate_Ekind (Id, E_Class_Wide_Subtype); @@ -5576,7 +5576,7 @@ package body Sem_Ch3 is -- the type they rename. if Present (Generic_Parent_Type (N)) then - Set_RM_Size (Id, RM_Size (T)); + Copy_RM_Size (To => Id, From => T); end if; if Ekind (T) = E_Record_Subtype @@ -6855,8 +6855,8 @@ package body Sem_Ch3 is Set_Is_Constrained (Derived_Type, Is_Constrained (Subt)); Set_Is_Access_Constant (Derived_Type, Is_Access_Constant (Parent_Type)); - Set_Size_Info (Derived_Type, Parent_Type); - Set_RM_Size (Derived_Type, RM_Size (Parent_Type)); + Set_Size_Info (Derived_Type, Parent_Type); + Copy_RM_Size (To => Derived_Type, From => Parent_Type); Set_Depends_On_Private (Derived_Type, Has_Private_Component (Derived_Type)); Conditional_Delay (Derived_Type, Subt); @@ -9896,8 +9896,8 @@ package body Sem_Ch3 is Mutate_Ekind (Derived_Type, Ekind (Parent_Base)); Propagate_Concurrent_Flags (Derived_Type, Parent_Base); - Set_Size_Info (Derived_Type, Parent_Type); - Set_RM_Size (Derived_Type, RM_Size (Parent_Type)); + Set_Size_Info (Derived_Type, Parent_Type); + Copy_RM_Size (To => Derived_Type, From => Parent_Type); Set_Is_Controlled_Active (Derived_Type, Is_Controlled_Active (Parent_Type)); @@ -12768,7 +12768,7 @@ package body Sem_Ch3 is Set_Is_First_Subtype (Full, False); Set_Scope (Full, Scope (Priv)); Set_Size_Info (Full, Full_Base); - Set_RM_Size (Full, RM_Size (Full_Base)); + Copy_RM_Size (To => Full, From => Full_Base); Set_Is_Itype (Full); -- A subtype of a private-type-without-discriminants, whose full-view @@ -14595,7 +14595,7 @@ package body Sem_Ch3 is end if; Set_Size_Info (Def_Id, (T)); - Set_RM_Size (Def_Id, RM_Size (T)); + Copy_RM_Size (To => Def_Id, From => T); Set_First_Rep_Item (Def_Id, First_Rep_Item (T)); -- If this is a range for a fixed-lower-bound subtype, then set the @@ -15399,12 +15399,12 @@ package body Sem_Ch3 is Set_Fixed_Range (Implicit_Base, Loc, -Bound_Val, Bound_Val); - -- Note: We leave size as zero for now, size will be set at freeze + -- Note: We leave Esize unset for now, size will be set at freeze -- time. We have to do this for ordinary fixed-point, because the size -- depends on the specified small, and we might as well do the same for -- decimal fixed-point. - pragma Assert (Esize (Implicit_Base) = Uint_0); + pragma Assert (not Known_Esize (Implicit_Base)); -- If there are bounds given in the declaration use them as the -- bounds of the first named subtype. diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 5b38c7d..095bcda 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2733,7 +2733,7 @@ package body Sem_Ch7 is begin Set_Size_Info (Priv, Full); - Set_RM_Size (Priv, RM_Size (Full)); + Copy_RM_Size (To => Priv, From => Full); Set_Size_Known_At_Compile_Time (Priv, Size_Known_At_Compile_Time (Full)); Set_Is_Volatile (Priv, Is_Volatile (Full)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6d53007..5028c22 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -28449,7 +28449,7 @@ package body Sem_Util is -- We copy Esize, but not RM_Size, since in general RM_Size is -- subtype specific and does not get inherited by all subtypes. - Set_Esize (T1, Esize (T2)); + Copy_Esize (To => T1, From => T2); Set_Has_Biased_Representation (T1, Has_Biased_Representation (T2)); if Is_Discrete_Or_Fixed_Point_Type (T1) diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index a74bfb6..2caaf50 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -59,6 +59,8 @@ package Types is subtype Pos is Int range 1 .. Int'Last; -- Positive Int values + subtype Nonzero_Int is Int with Predicate => Nonzero_Int /= 0; + type Word is mod 2 ** 32; -- Unsigned 32-bit integer -- cgit v1.1