public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2117] [Ada] Fix bugs in Value_Size clauses and refactor
@ 2021-07-07 16:25 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-07-07 16:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a547eea2669af282dfca4f3c38362f109b285308
commit r12-2117-ga547eea2669af282dfca4f3c38362f109b285308
Author: Bob Duff <duff@adacore.com>
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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-07-07 16:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-07 16:25 [gcc r12-2117] [Ada] Fix bugs in Value_Size clauses and refactor Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).