From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 764A0396DC34; Wed, 7 Jul 2021 16:25:50 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 764A0396DC34 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2117] [Ada] Fix bugs in Value_Size clauses and refactor X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/heads/master X-Git-Oldrev: 2d71668e64c4b20aec823dbe5a1feb6338d527a2 X-Git-Newrev: a547eea2669af282dfca4f3c38362f109b285308 Message-Id: <20210707162550.764A0396DC34@sourceware.org> Date: Wed, 7 Jul 2021 16:25:50 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 07 Jul 2021 16:25:50 -0000 https://gcc.gnu.org/g:a547eea2669af282dfca4f3c38362f109b285308 commit r12-2117-ga547eea2669af282dfca4f3c38362f109b285308 Author: Bob Duff Date: Wed May 19 11:37:47 2021 -0400 [Ada] Fix bugs in Value_Size clauses and refactor gcc/ada/ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Combine processing of Size and Value_Size clauses. Ensure that Value_Size is treated the same as Size, in the cases where both are allowed (i.e. the prefix denotes a first subtype). Misc cleanup. * einfo-utils.adb (Init_Size): Add assertions. (Size_Clause): Return a Value_Size clause if present, instead of just looking for a Size clause. * einfo.ads (Has_Size_Clause, Size_Clause): Change documentation to include Value_Size. * sem_ch13.ads, layout.ads, layout.adb: Comment modifications. Diff: --- gcc/ada/einfo-utils.adb | 17 +++- gcc/ada/einfo.ads | 23 +++--- gcc/ada/layout.adb | 10 +-- gcc/ada/layout.ads | 7 +- gcc/ada/sem_ch13.adb | 208 +++++++++++++++++++++++------------------------- gcc/ada/sem_ch13.ads | 22 ++--- 6 files changed, 145 insertions(+), 142 deletions(-) diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 6e8a77208b9..22143d62aaa 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -481,7 +481,13 @@ package body Einfo.Utils is procedure Init_Size (Id : E; V : Int) is begin - pragma Assert (not Is_Object (Id)); + pragma Assert (Is_Type (Id)); + pragma Assert + (not Known_Esize (Id) or else Esize (Id) = V); + pragma Assert + (RM_Size (Id) = No_Uint + or else RM_Size (Id) = Uint_0 + or else RM_Size (Id) = V); Set_Esize (Id, UI_From_Int (V)); Set_RM_Size (Id, UI_From_Int (V)); end Init_Size; @@ -492,7 +498,7 @@ package body Einfo.Utils is procedure Init_Size_Align (Id : E) is begin - pragma Assert (not Is_Object (Id)); + pragma Assert (Ekind (Id) in Type_Kind | E_Void); Set_Esize (Id, Uint_0); Set_RM_Size (Id, Uint_0); Set_Alignment (Id, Uint_0); @@ -2927,8 +2933,13 @@ package body Einfo.Utils is ----------------- function Size_Clause (Id : E) return N is + Result : N := Get_Attribute_Definition_Clause (Id, Attribute_Size); begin - return Get_Attribute_Definition_Clause (Id, Attribute_Size); + if No (Result) then + Result := Get_Attribute_Definition_Clause (Id, Attribute_Value_Size); + end if; + + return Result; end Size_Clause; ------------------------ diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 2feef7a0bf7..6a8d49352b8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2015,11 +2015,11 @@ package Einfo is -- which at least one of the shift operators is defined. -- Has_Size_Clause --- Defined in entities for types and objects. Set if a size clause is --- defined for the entity. Used to prevent multiple Size clauses for a --- given entity. Note that it is always initially cleared for a derived --- type, even though the Size for such a type is inherited from a Size --- clause given for the parent type. +-- Defined in entities for types and objects. Set if a size or value size +-- clause is defined for the entity. Used to prevent multiple clauses +-- for a given entity. Note that it is always initially cleared for a +-- derived type, even though the Size or Value_Size clause for such a +-- type might be inherited from an ancestor type. -- Has_Small_Clause -- Defined in ordinary fixed point types (but not subtypes). Indicates @@ -4321,13 +4321,12 @@ package Einfo is -- suppress this code if a subsequent address clause is encountered. -- Size_Clause (synthesized) --- Applies to all entities. If a size clause is present in the rep --- item chain for an entity then the attribute definition clause node --- for the size clause is returned. Otherwise Size_Clause returns Empty --- if no item is present. Usually this is only meaningful if the flag --- Has_Size_Clause is set. This is because when the representation item --- chain is copied for a derived type, it can inherit a size clause that --- is not applicable to the entity. +-- Applies to all entities. If a size or value size clause is present in +-- the rep item chain for an entity then that attribute definition clause +-- is returned. Otherwise Size_Clause returns Empty. Usually this is only +-- meaningful if the flag Has_Size_Clause is set. This is because when +-- the representation item chain is copied for a derived type, it can +-- inherit a size clause that is not applicable to the entity. -- Size_Depends_On_Discriminant -- Defined in all entities for types and subtypes. Indicates that the diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 5bafbcc5539..6dc4d7fb699 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -270,15 +270,15 @@ package body Layout is Desig_Type := Non_Limited_View (Designated_Type (E)); end if; - -- If Esize already set (e.g. by a size clause), then nothing further - -- to be done here. + -- If Esize already set (e.g. by a size or value size clause), then + -- nothing further to be done here. if Known_Esize (E) then null; - -- Access to subprogram is a strange beast, and we let the backend - -- figure out what is needed (it may be some kind of fat pointer, - -- including the static link for example. + -- Access to protected subprogram is a strange beast, and we let the + -- backend figure out what is needed (it may be some kind of fat + -- pointer, including the static link for example). elsif Is_Access_Protected_Subprogram_Type (E) then null; diff --git a/gcc/ada/layout.ads b/gcc/ada/layout.ads index 32caee0b1bf..89ee5bde714 100644 --- a/gcc/ada/layout.ads +++ b/gcc/ada/layout.ads @@ -32,10 +32,9 @@ with Types; use Types; package Layout is - -- The following procedures are called from Freeze, so all entities - -- for types and objects that get frozen (which should be all such - -- entities which are seen by the back end) will get laid out by one - -- of these two procedures. + -- The following procedures are called from Freeze, so all entities for + -- types and objects that get frozen (i.e. all types and objects seen by + -- the back end) will get laid out by one of these two procedures. procedure Layout_Type (E : Entity_Id); -- This procedure may set or adjust the fields Esize, RM_Size and diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index cdc00832e93..92d52494e49 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7180,109 +7180,136 @@ package body Sem_Ch13 is Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False); end if; - ---------- - -- Size -- - ---------- + ------------------------ + -- Size or Value_Size -- + ------------------------ - -- Size attribute definition clause + -- Size or Value_Size attribute definition clause. These are treated + -- the same, except that Size is allowed on objects, and Value_Size + -- is allowed on nonfirst subtypes. First subtypes allow both Size + -- and Value_Size; the treatment is the same for both. - when Attribute_Size => Size : declare + when Attribute_Size | Attribute_Value_Size => Size : declare Size : constant Uint := Static_Integer (Expr); - Etyp : Entity_Id; - Biased : Boolean; + + Attr_Name : constant String := + (if Id = Attribute_Size then "size" + elsif Id = Attribute_Value_Size then "value size" + else ""); -- can't happen + -- Name of the attribute for printing in messages + + OK_Prefix : constant Boolean := + (if Id = Attribute_Size then + Ekind (U_Ent) in Type_Kind | Constant_Or_Variable_Kind + elsif Id = Attribute_Value_Size then + Ekind (U_Ent) in Type_Kind + else False); -- can't happen + -- For X'Size, X can be a type or object; for X'Value_Size, + -- X can be a type. Note that we already checked that 'Size + -- can be specified only for a first subytype. begin FOnly := True; - if Duplicate_Clause then - null; + if not OK_Prefix then + Error_Msg_N (Attr_Name & " cannot be given for &", Nam); - elsif not Is_Type (U_Ent) - and then Ekind (U_Ent) /= E_Variable - and then Ekind (U_Ent) /= E_Constant - then - Error_Msg_N ("size cannot be given for &", Nam); + elsif Duplicate_Clause then + null; elsif Is_Array_Type (U_Ent) and then not Is_Constrained (U_Ent) then Error_Msg_N - ("size cannot be given for unconstrained array", Nam); + (Attr_Name & " cannot be given for unconstrained array", Nam); elsif Size /= No_Uint then - if Is_Type (U_Ent) then - Etyp := U_Ent; - else - Etyp := Etype (U_Ent); - end if; + declare + Etyp : constant Entity_Id := + (if Is_Type (U_Ent) then U_Ent else Etype (U_Ent)); - -- Check size, note that Gigi is in charge of checking that the - -- size of an array or record type is OK. Also we do not check - -- the size in the ordinary fixed-point case, since it is too - -- early to do so (there may be subsequent small clause that - -- affects the size). We can check the size if a small clause - -- has already been given. + begin + -- Check size, note that Gigi is in charge of checking that + -- the size of an array or record type is OK. Also we do not + -- check the size in the ordinary fixed-point case, since + -- it is too early to do so (there may be subsequent small + -- clause that affects the size). We can check the size if + -- a small clause has already been given. + + if not Is_Ordinary_Fixed_Point_Type (U_Ent) + or else Has_Small_Clause (U_Ent) + then + declare + Biased : Boolean; + begin + Check_Size (Expr, Etyp, Size, Biased); + Set_Biased (U_Ent, N, Attr_Name & " clause", Biased); + end; + end if; - if not Is_Ordinary_Fixed_Point_Type (U_Ent) - or else Has_Small_Clause (U_Ent) - then - Check_Size (Expr, Etyp, Size, Biased); - Set_Biased (U_Ent, N, "size clause", Biased); - end if; + -- For types, set RM_Size and Esize if appropriate - -- For types set RM_Size and Esize if possible + if Is_Type (U_Ent) then + Set_RM_Size (U_Ent, Size); - if Is_Type (U_Ent) then - Set_RM_Size (U_Ent, Size); + -- If we are specifying the Size or Value_Size of a + -- first subtype, then for elementary types, increase + -- Object_Size to power of 2, but not less than a storage + -- unit in any case (normally this means it will be byte + -- addressable). - -- For elementary types, increase Object_Size to power of 2, - -- but not less than a storage unit in any case (normally - -- this means it will be byte addressable). + -- For all other types, nothing else to do, we leave + -- Esize (object size) unset; the back end will set it + -- from the size and alignment in an appropriate manner. - -- For all other types, nothing else to do, we leave Esize - -- (object size) unset, the back end will set it from the - -- size and alignment in an appropriate manner. + -- In both cases, we check whether the alignment must be + -- reset in the wake of the size change. - -- In both cases, we check whether the alignment must be - -- reset in the wake of the size change. + -- For nonfirst subtypes ('Value_Size only), we do + -- nothing here. - if Is_Elementary_Type (U_Ent) then - if Size <= System_Storage_Unit then - Init_Esize (U_Ent, System_Storage_Unit); - elsif Size <= 16 then - Init_Esize (U_Ent, 16); - elsif Size <= 32 then - Init_Esize (U_Ent, 32); - else - Set_Esize (U_Ent, (Size + 63) / 64 * 64); + if Is_First_Subtype (U_Ent) then + if Is_Elementary_Type (U_Ent) then + if Size <= System_Storage_Unit then + Init_Esize (U_Ent, System_Storage_Unit); + elsif Size <= 16 then + Init_Esize (U_Ent, 16); + elsif Size <= 32 then + Init_Esize (U_Ent, 32); + else + Set_Esize (U_Ent, (Size + 63) / 64 * 64); + end if; + + Alignment_Check_For_Size_Change + (U_Ent, Esize (U_Ent)); + else + Alignment_Check_For_Size_Change (U_Ent, Size); + end if; end if; - Alignment_Check_For_Size_Change (U_Ent, Esize (U_Ent)); - else - Alignment_Check_For_Size_Change (U_Ent, Size); - end if; + -- For Object'Size, set Esize only - -- For objects, set Esize only + else + if Is_Elementary_Type (Etyp) + and then Size /= System_Storage_Unit + and then Size /= 16 + and then Size /= 32 + and then Size /= 64 + and then Size /= System_Max_Integer_Size + then + Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); + Error_Msg_Uint_2 := + UI_From_Int (System_Max_Integer_Size); + Error_Msg_N + ("size for primitive object must be a power of 2 in " + & "the range ^-^", N); + end if; - else - if Is_Elementary_Type (Etyp) - and then Size /= System_Storage_Unit - and then Size /= 16 - and then Size /= 32 - and then Size /= 64 - and then Size /= System_Max_Integer_Size - then - Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); - Error_Msg_Uint_2 := UI_From_Int (System_Max_Integer_Size); - Error_Msg_N - ("size for primitive object must be a power of 2 in " - & "the range ^-^", N); + Set_Esize (U_Ent, Size); end if; - Set_Esize (U_Ent, Size); - end if; - - Set_Has_Size_Clause (U_Ent); + Set_Has_Size_Clause (U_Ent); + end; end if; end Size; @@ -7744,39 +7771,6 @@ package body Sem_Ch13 is end if; end Stream_Size; - ---------------- - -- Value_Size -- - ---------------- - - -- Value_Size attribute definition clause - - when Attribute_Value_Size => Value_Size : declare - Size : constant Uint := Static_Integer (Expr); - Biased : Boolean; - - begin - if not Is_Type (U_Ent) then - Error_Msg_N ("Value_Size cannot be given for &", Nam); - - elsif Duplicate_Clause then - null; - - elsif Is_Array_Type (U_Ent) - and then not Is_Constrained (U_Ent) - then - Error_Msg_N - ("Value_Size cannot be given for unconstrained array", Nam); - - else - if Is_Elementary_Type (U_Ent) then - Check_Size (Expr, U_Ent, Size, Biased); - Set_Biased (U_Ent, N, "value size clause", Biased); - end if; - - Set_RM_Size (U_Ent, Size); - end if; - end Value_Size; - ----------------------- -- Variable_Indexing -- ----------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 757981273dc..3b21484c37a 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -115,17 +115,17 @@ package Sem_Ch13 is Siz : Uint; Biased : out Boolean); -- Called when size Siz is specified for subtype T. This subprogram checks - -- that the size is appropriate, posting errors on node N as required. - -- This check is effective for elementary types and bit-packed arrays. - -- For other non-elementary types, a check is only made if an explicit - -- size has been given for the type (and the specified size must match). - -- The parameter Biased is set False if the size specified did not require - -- the use of biased representation, and True if biased representation - -- was required to meet the size requirement. Note that Biased is only - -- set if the type is not currently biased, but biasing it is the only - -- way to meet the requirement. If the type is currently biased, then - -- this biased size is used in the initial check, and Biased is False. - -- For a Component_Size clause, T is the component type. + -- that the size is appropriate, posting errors on node N as required. This + -- check is effective for elementary types and bit-packed arrays. For + -- composite types, a check is only made if an explicit size has been given + -- for the type (and the specified size must match). The parameter Biased + -- is set False if the size specified did not require the use of biased + -- representation, and True if biased representation was required to meet + -- the size requirement. Note that Biased is only set if the type is not + -- currently biased, but biasing it is the only way to meet the + -- requirement. If the type is currently biased, then this biased size is + -- used in the initial check, and Biased is False. For a Component_Size + -- clause, T is the component type. function Has_Compatible_Representation (Target_Type, Operand_Type : Entity_Id) return Boolean;