From d1cf00c6585d3de72209a429aa1a1974d894524d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 31 Oct 2006 18:01:28 +0000 Subject: [PATCH] 2006-10-31 Robert Dewar * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118283 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/layout.adb | 181 ++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 123 insertions(+), 58 deletions(-) diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index b24b4d8..b5b1ef9 100644 --- a/gcc/ada/layout.adb +++ b/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); -- 2.7.4