Skip to content

R
riscv-gcc-1
Commit cac01ae3 by Robert Dewar Committed by Arnaud Charlet
Options

layout.adb (Layout_Record_Type): Deal with non-static subtypes of variant records 

2006-10-31  Robert Dewar  <dewar@adacore.com>

        * layout.adb (Layout_Record_Type): Deal with non-static subtypes of
        variant records
        (Layout_Variant_Record): Retrieve the discriminants from the entity
	rather than from the type definition, because in the case of a full
	type for a private type we need to take the discriminants from the
	partial view.
        (Layout_Component_List): When applying the Max operator to variants with
        a nonstatic size, check whether either operand is static and scale that
        operand from bits to storage units before applying Max.
	(Layout_Type): In VMS, if a C-convention access type has no explicit
	size clause (and does not inherit one in the case of a derived type),
	then the size is reset to 32 from 64.

From-SVN: r118283
parent 2d6a1685
Showing with 123 additions and 58 deletions
gcc/ada/layout.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2006, 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- --
......@@ -78,8 +78,7 @@ package body Layout is
function Assoc_Add
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id;
Right_Opnd : Node_Id) return Node_Id;
-- This is like Make_Op_Add except that it optimizes some cases knowing
-- that associative rearrangement is allowed for constant folding if one
-- of the operands is a compile time known value.
......@@ -87,8 +86,7 @@ package body Layout is
function Assoc_Multiply
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id;
Right_Opnd : Node_Id) return Node_Id;
-- This is like Make_Op_Multiply except that it optimizes some cases
-- knowing that associative rearrangement is allowed for constant
-- folding if one of the operands is a compile time known value
......@@ -96,8 +94,7 @@ package body Layout is
function Assoc_Subtract
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id;
Right_Opnd : Node_Id) return Node_Id;
-- This is like Make_Op_Subtract except that it optimizes some cases
-- knowing that associative rearrangement is allowed for constant
-- folding if one of the operands is a compile time known value
......@@ -119,8 +116,7 @@ package body Layout is
function Expr_From_SO_Ref
(Loc : Source_Ptr;
D : SO_Ref;
Comp : Entity_Id := Empty)
return Node_Id;
Comp : Entity_Id := Empty) return Node_Id;
-- Given a value D from a size or offset field, return an expression
-- representing the value stored. If the value is known at compile time,
-- then an N_Integer_Literal is returned with the appropriate value. If
......@@ -137,8 +133,7 @@ package body Layout is
(Expr : Node_Id;
Ins_Type : Entity_Id;
Vtype : Entity_Id := Empty;
Make_Func : Boolean := False)
return Dynamic_SO_Ref;
Make_Func : Boolean := False) return Dynamic_SO_Ref;
-- This routine is used in the case where a size/offset value is dynamic
-- and is represented by the expression Expr. SO_Ref_From_Expr checks if
-- the Expr contains a reference to the identifier V, and if so builds
......@@ -307,8 +302,7 @@ package body Layout is
function Assoc_Add
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id
Right_Opnd : Node_Id) return Node_Id
is
L : Node_Id;
R : Uint;
......@@ -387,8 +381,7 @@ package body Layout is
function Assoc_Multiply
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id
Right_Opnd : Node_Id) return Node_Id
is
L : Node_Id;
R : Uint;
......@@ -446,8 +439,7 @@ package body Layout is
function Assoc_Subtract
(Loc : Source_Ptr;
Left_Opnd : Node_Id;
Right_Opnd : Node_Id)
return Node_Id
Right_Opnd : Node_Id) return Node_Id
is
L : Node_Id;
R : Uint;
......@@ -610,8 +602,7 @@ package body Layout is
function Expr_From_SO_Ref
(Loc : Source_Ptr;
D : SO_Ref;
Comp : Entity_Id := Empty)
return Node_Id
Comp : Entity_Id := Empty) return Node_Id
is
Ent : Entity_Id;
......@@ -1590,12 +1581,36 @@ package body Layout is
procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id) is
Ctyp : constant Entity_Id := Etype (Comp);
ORC : constant Entity_Id := Original_Record_Component (Comp);
Npos : SO_Ref;
Fbit : SO_Ref;
NPMax : SO_Ref;
Forc : Boolean;
begin
-- Increase alignment of record if necessary. Note that we do not
-- do this for packed records, which have an alignment of one by
-- default, or for records for which an explicit alignment was
-- specified with an alignment clause.
if not Is_Packed (E)
and then not Has_Alignment_Clause (E)
and then Alignment (Ctyp) > Alignment (E)
then
Set_Alignment (E, Alignment (Ctyp));
end if;
-- If original component set, then use same layout
if Present (ORC) and then ORC /= Comp then
Set_Normalized_Position (Comp, Normalized_Position (ORC));
Set_Normalized_First_Bit (Comp, Normalized_First_Bit (ORC));
Set_Normalized_Position_Max (Comp, Normalized_Position_Max (ORC));
Set_Component_Bit_Offset (Comp, Component_Bit_Offset (ORC));
Set_Esize (Comp, Esize (ORC));
return;
end if;
-- Parent field is always at start of record, this will overlap
-- the actual fields that are part of the parent, and that's fine
......@@ -1618,18 +1633,6 @@ package body Layout is
Layout_Type (Ctyp);
end if;
-- Increase alignment of record if necessary. Note that we do not
-- do this for packed records, which have an alignment of one by
-- default, or for records for which an explicit alignment was
-- specified with an alignment clause.
if not Is_Packed (E)
and then not Has_Alignment_Clause (E)
and then Alignment (Ctyp) > Alignment (E)
then
Set_Alignment (E, Alignment (Ctyp));
end if;
-- If component already laid out, then we are done
if Known_Normalized_Position (Comp) then
......@@ -1764,10 +1767,33 @@ package body Layout is
Esiz := Uint_0;
RM_Siz := Uint_0;
-- If record subtype with non-static discriminants, then we don't
-- know which variant will be the one which gets chosen. We don't
-- just want to set the maximum size from the base, because the
-- size should depend on the particular variant.
-- What we do is to use the RM_Size of the base type, which has
-- the necessary conditional computation of the size, using the
-- size information for the particular variant chosen. Records
-- with default discriminants for example have an Esize that is
-- set to the maximum of all variants, but that's not what we
-- want for a constrained subtype.
elsif Ekind (E) = E_Record_Subtype
and then not Has_Static_Discriminants (E)
then
declare
BT : constant Node_Id := Base_Type (E);
begin
Esiz := RM_Size (BT);
RM_Siz := RM_Size (BT);
Set_Alignment (E, Alignment (BT));
end;
else
-- First the object size, for which we align past the last
-- field to the alignment of the record (the object size
-- is required to be a multiple of the alignment).
-- First the object size, for which we align past the last field
-- to the alignment of the record (the object size is required to
-- be a multiple of the alignment).
Get_Next_Component_Location
(Prev_Comp,
......@@ -1778,10 +1804,10 @@ package body Layout is
Force_SU => True);
-- If the resulting normalized position is a dynamic reference,
-- then the size is dynamic, and is stored in storage units.
-- In this case, we set the RM_Size to the same value, it is
-- simply not worth distinguishing Esize and RM_Size values in
-- the dynamic case, since the RM has nothing to say about them.
-- then the size is dynamic, and is stored in storage units. In
-- this case, we set the RM_Size to the same value, it is simply
-- not worth distinguishing Esize and RM_Size values in the
-- dynamic case, since the RM has nothing to say about them.
-- Note that a size cannot have been given in this case, since
-- size specifications cannot be given for variable length types.
......@@ -1793,11 +1819,11 @@ package body Layout is
if Is_Dynamic_SO_Ref (End_Npos) then
RM_Siz := End_Npos;
-- Set the Object_Size allowing for alignment. In the
-- dynamic case, we have to actually do the runtime
-- computation. We can skip this in the non-packed
-- record case if the last component has a smaller
-- alignment than the overall record alignment.
-- Set the Object_Size allowing for the alignment. In the
-- dynamic case, we must do the actual runtime computation.
-- We can skip this in the non-packed record case if the
-- last component has a smaller alignment than the overall
-- record alignment.
if Is_Dynamic_SO_Ref (End_NPMax) then
Esiz := End_NPMax;
......@@ -1805,8 +1831,8 @@ package body Layout is
if Is_Packed (E)
or else Alignment (Etype (Prev_Comp)) < Align
then
-- The expression we build is
-- (expr + align - 1) / align * align
-- The expression we build is:
-- (expr + align - 1) / align * align
Esiz :=
SO_Ref_From_Expr
......@@ -1844,7 +1870,7 @@ package body Layout is
-- accordingly. We also adjust the size to match the
-- alignment here.
Esiz := (End_NPMax + Align - 1) / Align * Align * SSU;
Esiz := (End_NPMax + Align - 1) / Align * Align * SSU;
-- Compute the resulting Value_Size (RM_Size). For this
-- purpose we do not force alignment of the record or
......@@ -1872,7 +1898,6 @@ package body Layout is
procedure Layout_Non_Variant_Record is
Esiz : SO_Ref;
RM_Siz : SO_Ref;
begin
Layout_Components (First_Entity (E), Last_Entity (E), Esiz, RM_Siz);
Set_Esize (E, Esiz);
......@@ -1884,10 +1909,11 @@ package body Layout is
---------------------------
procedure Layout_Variant_Record is
Tdef : constant Node_Id := Type_Definition (Decl);
Dlist : constant List_Id := Discriminant_Specifications (Decl);
Esiz : SO_Ref;
RM_Siz : SO_Ref;
Tdef : constant Node_Id := Type_Definition (Decl);
First_Discr : Entity_Id;
Last_Discr : Entity_Id;
Esiz : SO_Ref;
RM_Siz : SO_Ref;
RM_Siz_Expr : Node_Id := Empty;
-- Expression for the evolving RM_Siz value. This is typically a
......@@ -1953,7 +1979,7 @@ package body Layout is
if Is_Static_SO_Ref (RM_Siz) then
RM_Siz_Expr :=
Make_Integer_Literal (Loc,
Intval => RM_Siz);
Intval => RM_Siz);
else
RMS_Ent := Get_Dynamic_SO_Entity (RM_Siz);
......@@ -2019,8 +2045,19 @@ package body Layout is
-- If either value is dynamic, then we have to generate
-- an appropriate Standard_Unsigned'Max attribute call.
-- If one of the values is static then it needs to be
-- converted from bits to storage units to be compatible
-- with the dynamic value.
else
if Is_Static_SO_Ref (Esiz) then
Esiz := (Esiz + SSU - 1) / SSU;
end if;
if Is_Static_SO_Ref (EsizV) then
EsizV := (EsizV + SSU - 1) / SSU;
end if;
Esiz :=
SO_Ref_From_Expr
(Make_Attribute_Reference (Loc,
......@@ -2140,9 +2177,15 @@ package body Layout is
-- Lay out the discriminants
First_Discr := First_Discriminant (E);
Last_Discr := First_Discr;
while Present (Next_Discriminant (Last_Discr)) loop
Next_Discriminant (Last_Discr);
end loop;
Layout_Components
(From => Defining_Identifier (First (Dlist)),
To => Defining_Identifier (Last (Dlist)),
(From => First_Discr,
To => Last_Discr,
Esiz => Esiz,
RM_Siz => RM_Siz);
......@@ -2150,7 +2193,7 @@ package body Layout is
-- to lay out all component lists nested within variants).
Layout_Component_List (Component_List (Tdef), Esiz, RM_Siz_Expr);
Set_Esize (E, Esiz);
Set_Esize (E, Esiz);
-- If the RM_Size is a literal, set its value
......@@ -2176,7 +2219,8 @@ package body Layout is
-- components themselves are all shared.
if (Ekind (E) = E_Record_Subtype
or else Ekind (E) = E_Class_Wide_Subtype)
or else
Ekind (E) = E_Class_Wide_Subtype)
and then Present (Cloned_Subtype (E))
then
Set_Esize (E, Esize (Cloned_Subtype (E)));
......@@ -2342,6 +2386,28 @@ package body Layout is
end;
end if;
-- On VMS, reset size to 32 for convention C access type if no
-- explicit size clause is given and the default size is 64. Really
-- we do not know the size, since depending on options for the VMS
-- compiler, the size of a pointer type can be 32 or 64, but choosing
-- 32 as the default improves compatibility with legacy VMS code.
-- Note: we do not use Has_Size_Clause in the test below, because we
-- want to catch the case of a derived type inheriting a size clause.
-- We want to consider this to be an explicit size clause for this
-- purpose, since it would be weird not to inherit the size in this
-- case.
if OpenVMS_On_Target
and then (Convention (E) = Convention_C
or else
Convention (E) = Convention_CPP)
and then No (Get_Attribute_Definition_Clause (E, Attribute_Size))
and then Esize (E) = 64
then
Init_Size (E, 32);
end if;
Set_Elem_Alignment (E);
-- Scalar types: set size and alignment
......@@ -2936,8 +3002,7 @@ package body Layout is
(Expr : Node_Id;
Ins_Type : Entity_Id;
Vtype : Entity_Id := Empty;
Make_Func : Boolean := False)
return Dynamic_SO_Ref
Make_Func : Boolean := False) return Dynamic_SO_Ref
is
Loc : constant Source_Ptr := Sloc (Ins_Type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment