-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- are of an enumeration type (so that the subtraction cannot be
-- done directly) by applying the Pos operator to Hi/Lo first.
+ procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id);
+ -- Given an array type or an array subtype E, compute whether its size
+ -- depends on the value of one or more discriminants and set the flag
+ -- Size_Depends_On_Discriminant accordingly. This need not be called
+ -- in front end layout mode since it does the computation on its own.
+
function Expr_From_SO_Ref
(Loc : Source_Ptr;
D : SO_Ref;
Name => New_Occurrence_Of (Ent, Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
- Prefix => Make_Identifier (Loc, Chars => Vname),
+ Prefix => Make_Identifier (Loc, Vname),
Selector_Name => New_Occurrence_Of (Comp, Loc))));
else
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Ent, Loc),
Parameter_Associations => New_List (
- Make_Identifier (Loc, Chars => Vname)));
+ Make_Identifier (Loc, Vname)));
end if;
else
N :=
Make_Selected_Component (Loc,
- Prefix => Make_Identifier (Loc, Chars => Vname),
+ Prefix => Make_Identifier (Loc, Vname),
Selector_Name => New_Occurrence_Of (Entity (N), Loc));
-- Set the Etype attributes of the selected name and its prefix.
end;
end if;
- -- Now set the dynamic size (the Value_Size is always the same
- -- as the Object_Size for arrays whose length is dynamic).
+ -- Now set the dynamic size (the Value_Size is always the same as the
+ -- Object_Size for arrays whose length is dynamic).
-- ??? If Size.Status = Dynamic, Vtyp will not have been set.
-- The added initialization sets it to Empty now, but is this
end if;
end Layout_Array_Type;
+ ------------------------------------------
+ -- Compute_Size_Depends_On_Discriminant --
+ ------------------------------------------
+
+ procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is
+ Indx : Node_Id;
+ Ityp : Entity_Id;
+ Lo : Node_Id;
+ Hi : Node_Id;
+ Res : Boolean := False;
+
+ begin
+ -- Loop to process array indexes
+
+ Indx := First_Index (E);
+ while Present (Indx) loop
+ Ityp := Etype (Indx);
+
+ -- If an index of the array is a generic formal type then there is
+ -- no point in determining a size for the array type.
+
+ if Is_Generic_Type (Ityp) then
+ return;
+ end if;
+
+ Lo := Type_Low_Bound (Ityp);
+ Hi := Type_High_Bound (Ityp);
+
+ if (Nkind (Lo) = N_Identifier
+ and then Ekind (Entity (Lo)) = E_Discriminant)
+ or else
+ (Nkind (Hi) = N_Identifier
+ and then Ekind (Entity (Hi)) = E_Discriminant)
+ then
+ Res := True;
+ end if;
+
+ Next_Index (Indx);
+ end loop;
+
+ if Res then
+ Set_Size_Depends_On_Discriminant (E);
+ end if;
+ end Compute_Size_Depends_On_Discriminant;
+
-------------------
-- Layout_Object --
-------------------
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RMS_Ent, Loc),
Parameter_Associations => New_List (
- Make_Identifier (Loc, Chars => Vname)));
+ Make_Identifier (Loc, Vname)));
-- If the size is represented by a constant, then the
-- expression we want is a reference to this constant
Discrim :=
Make_Selected_Component (Loc,
Prefix =>
- Make_Identifier (Loc, Chars => Vname),
+ Make_Identifier (Loc, Vname),
Selector_Name =>
New_Occurrence_Of
(Entity (Name (Vpart)), Loc));
Append (
Make_Selected_Component (Loc,
Prefix =>
- Make_Identifier (Loc, Chars => Vname),
+ Make_Identifier (Loc, Vname),
Selector_Name =>
- New_Occurrence_Of
- (D_Entity, Loc)),
+ New_Occurrence_Of (D_Entity, Loc)),
D_List);
D_Entity := Next_Discriminant (D_Entity);
end;
end if;
- -- If RM_Size is known, set Esize if not known
-
- if Known_RM_Size (E) and then Unknown_Esize (E) then
-
- -- If the alignment is known, we bump the Esize up to the next
- -- alignment boundary if it is not already on one.
-
- if Known_Alignment (E) then
- declare
- A : constant Uint := Alignment_In_Bits (E);
- S : constant SO_Ref := RM_Size (E);
- begin
- Set_Esize (E, (S + A - 1) / A * A);
- end;
- end if;
-
-- If Esize is set, and RM_Size is not, RM_Size is copied from Esize.
-- At least for now this seems reasonable, and is in any case needed
-- for compatibility with old versions of gigi.
- elsif Known_Esize (E) and then Unknown_RM_Size (E) then
+ if Known_Esize (E) and then Unknown_RM_Size (E) then
Set_RM_Size (E, Esize (E));
end if;
Set_Alignment (E, Uint_1);
end if;
end if;
+
+ -- We need to know whether the size depends on the value of one
+ -- or more discriminants to select the return mechanism. Skip if
+ -- errors are present, to prevent cascaded messages.
+
+ if Serious_Errors_Detected = 0 then
+ Compute_Size_Depends_On_Discriminant (E);
+ end if;
+
end if;
end if;
end if;
-- Here we calculate the alignment as the largest power of two multiple
- -- of System.Storage_Unit that does not exceed either the actual size of
+ -- of System.Storage_Unit that does not exceed either the object size of
-- the type, or the maximum allowed alignment.
declare
A := 2 * A;
end loop;
- -- Now we think we should set the alignment to A, but we skip this if
- -- an alignment is already set to a value greater than A (happens for
- -- derived types).
+ -- If alignment is currently not set, then we can safetly set it to
+ -- this new calculated value.
- -- However, if the alignment is known and too small it must be
- -- increased, this happens in a case like:
+ if Unknown_Alignment (E) then
+ Init_Alignment (E, A);
+
+ -- Cases where we have inherited an alignment
+
+ -- For constructed types, always reset the alignment, these are
+ -- Generally invisible to the user anyway, and that way we are
+ -- sure that no constructed types have weird alignments.
+
+ elsif not Comes_From_Source (E) then
+ Init_Alignment (E, A);
+
+ -- If this inherited alignment is the same as the one we computed,
+ -- then obviously everything is fine, and we do not need to reset it.
- -- type R is new Character;
- -- for R'Size use 16;
+ elsif Alignment (E) = A then
+ null;
- -- Here the alignment inherited from Character is 1, but it must be
- -- increased to 2 to reflect the increased size.
+ -- Now we come to the difficult cases where we have inherited an
+ -- alignment and size, but overridden the size but not the alignment.
+
+ elsif Has_Size_Clause (E) or else Has_Object_Size_Clause (E) then
+
+ -- This is tricky, it might be thought that we should try to
+ -- inherit the alignment, since that's what the RM implies, but
+ -- that leads to complex rules and oddities. Consider for example:
+
+ -- type R is new Character;
+ -- for R'Size use 16;
+
+ -- It seems quite bogus in this case to inherit an alignment of 1
+ -- from the parent type Character. Furthermore, if that's what the
+ -- programmer really wanted for some odd reason, then they could
+ -- specify the alignment they wanted.
+
+ -- Furthermore we really don't want to inherit the alignment in
+ -- the case of a specified Object_Size for a subtype, since then
+ -- there would be no way of overriding to give a reasonable value
+ -- (we don't have an Object_Subtype attribute). Consider:
+
+ -- subtype R is new Character;
+ -- for R'Object_Size use 16;
+
+ -- If we inherit the alignment of 1, then we have an odd
+ -- inefficient alignment for the subtype, which cannot be fixed.
+
+ -- So we make the decision that if Size (or Object_Size) is given
+ -- (and, in the case of a first subtype, the alignment is not set
+ -- with a specific alignment clause). We reset the alignment to
+ -- the appropriate value for the specified size. This is a nice
+ -- simple rule to implement and document.
+
+ -- There is one slight glitch, which is that a confirming size
+ -- clause can now change the alignment, which, if we really think
+ -- that confirming rep clauses should have no effect, is a no-no.
+
+ -- type R is new Character;
+ -- for R'Alignment use 2;
+ -- type S is new R;
+ -- for S'Size use Character'Size;
+
+ -- Now the alignment of S is 1 instead of 2, as a result of
+ -- applying the above rule to the confirming rep clause for S. Not
+ -- clear this is worth worrying about. If we recorded whether a
+ -- size clause was confirming we could avoid this, but right now
+ -- we have no way of doing that or easily figuring it out, so we
+ -- don't bother.
+
+ -- Historical note. In versions of GNAT prior to Nov 6th, 2010, an
+ -- odd distinction was made between inherited alignments greater
+ -- than the computed alignment (where the larger alignment was
+ -- inherited) and inherited alignments smaller than the computed
+ -- alignment (where the smaller alignment was overridden). This
+ -- was a dubious fix to get around an ACATS problem which seems
+ -- to have disappeared anyway, and in any case, this peculiarity
+ -- was never documented.
- if Unknown_Alignment (E) or else Alignment (E) < A then
Init_Alignment (E, A);
+
+ -- If no Size (or Object_Size) was specified, then we inherited the
+ -- object size, so we should inherit the alignment as well and not
+ -- modify it. This takes care of cases like:
+
+ -- type R is new Integer;
+ -- for R'Alignment use 1;
+ -- subtype S is R;
+
+ -- Here we have R has a default Object_Size of 32, and a specified
+ -- alignment of 1, and it seeems right for S to inherit both values.
+
+ else
+ null;
end if;
end;
end Set_Elem_Alignment;
OSDN Git Service
