diff options
author | Bob Duff <duff@adacore.com> | 2021-05-19 11:37:47 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-07-07 16:23:15 +0000 |
commit | a547eea2669af282dfca4f3c38362f109b285308 (patch) | |
tree | 5cc8c1078625afb15eaebc43737cdb63f4c7bfee | |
parent | 2d71668e64c4b20aec823dbe5a1feb6338d527a2 (diff) | |
download | gcc-a547eea2669af282dfca4f3c38362f109b285308.zip gcc-a547eea2669af282dfca4f3c38362f109b285308.tar.gz gcc-a547eea2669af282dfca4f3c38362f109b285308.tar.bz2 |
[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.
-rw-r--r-- | gcc/ada/einfo-utils.adb | 17 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 23 | ||||
-rw-r--r-- | gcc/ada/layout.adb | 10 | ||||
-rw-r--r-- | gcc/ada/layout.ads | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 208 | ||||
-rw-r--r-- | 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 6e8a772..22143d6 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 2feef7a..6a8d493 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 5bafbcc..6dc4d7f 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 32caee0..89ee5bd 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 cdc0083..92d5249 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 7579812..3b21484 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; |