@@ -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;
------------------------
@@ -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 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 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
@@ -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;
@@ -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
@@ -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 --
-----------------------
@@ -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;