From d964f2aa92920319e5ea812cecbdefa1632dbc8d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 6 Sep 2011 10:53:58 +0000 Subject: [PATCH] 2011-09-06 Robert Dewar * s-tpopsp-vxworks.adb, prj-nmsc.adb: Minor reformatting. 2011-09-06 Hristian Kirtchev * gcc-interface/trans.c (Attribute_to_gnu): New case for attribute Descriptor_Size. * exp_attr.adb (Expand_N_Attribute_Reference): Add processing for attribute Descriptor_Size. * exp_ch7.adb (Double_Size_Of): Removed. (Make_Finalize_Address_Stmts): Remove the code which generates an expression to calculate the dope vector of an unconstrained array. Instead use attribute Descriptor_Size and leave the calculation to the back end. (Nearest_Multiple_Rounded_Up): Removed. (Size_Of): Removed. * sem_attr.adb (Analyze_Attribute): Add processing for attribute Descriptor_Size. Currently the attribute is applicable only to unconstrained arrays. (Eval_Attribute): Add processing for attribute Descriptor_Size. * snames.ads-tmpl: Add a predefined name and an Attribute_Id for Descriptor_Size. 2011-09-06 Ed Schonberg * exp_aggr.adb: Remove useless formal. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178585 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_aggr.adb | 13 ++-- gcc/ada/exp_attr.adb | 9 +++ gcc/ada/exp_ch7.adb | 143 ++++-------------------------------------- gcc/ada/gcc-interface/trans.c | 14 +++++ gcc/ada/prj-nmsc.adb | 10 +-- gcc/ada/s-tpopsp-vxworks.adb | 4 +- gcc/ada/sem_attr.adb | 29 +++++++++ gcc/ada/snames.ads-tmpl | 2 + 8 files changed, 77 insertions(+), 147 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 74a7edf..f79353a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -109,15 +109,12 @@ package body Exp_Aggr is function Build_Record_Aggr_Code (N : Node_Id; Typ : Entity_Id; - Lhs : Node_Id; - Is_Limited_Ancestor_Expansion : Boolean := False) return List_Id; + Lhs : Node_Id) return List_Id; -- N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the -- aggregate. Target is an expression containing the location on which the -- component by component assignments will take place. Returns the list of -- assignments plus all other adjustments needed for tagged and controlled - -- types. Is_Limited_Ancestor_Expansion indicates that the function has - -- been called recursively to expand the limited ancestor to avoid copying - -- it. + -- types. procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id); -- N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the @@ -1734,8 +1731,7 @@ package body Exp_Aggr is function Build_Record_Aggr_Code (N : Node_Id; Typ : Entity_Id; - Lhs : Node_Id; - Is_Limited_Ancestor_Expansion : Boolean := False) return List_Id + Lhs : Node_Id) return List_Id is Loc : constant Source_Ptr := Sloc (N); L : constant List_Id := New_List; @@ -2338,8 +2334,7 @@ package body Exp_Aggr is Build_Record_Aggr_Code ( N => Unqualify (Ancestor), Typ => Etype (Unqualify (Ancestor)), - Lhs => Target, - Is_Limited_Ancestor_Expansion => True)); + Lhs => Target)); -- If the ancestor part is an expression "E", we generate diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 598520a..a98a7b93 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1799,6 +1799,15 @@ package body Exp_Attr is Analyze_And_Resolve (N, Typ); end Count; + --------------------- + -- Descriptor_Size -- + --------------------- + + -- This attribute is handled entirely by the back end + + when Attribute_Descriptor_Size => + Apply_Universal_Integer_Attribute_Checks (N); + --------------- -- Elab_Body -- --------------- diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 5ba3bc4..c7ea703 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7023,99 +7023,6 @@ package body Exp_Ch7 is Desg_Typ : Entity_Id; Obj_Expr : Node_Id; - function Double_Size_Of (Typ : Entity_Id) return Node_Id; - -- Subsidiary routine, produces an expression which calculates double - -- the size of Typ as the nearest multiple of its alignment rounded up. - - function Nearest_Multiple_Rounded_Up - (Size_Expr : Node_Id; - Typ : Entity_Id) return Node_Id; - -- Subsidiary routine, generate the following expression: - -- ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) * Typ'Alignment - - function Size_Of (Typ : Entity_Id) return Node_Id; - -- Subsidiary routine, produces an expression which calculates the size - -- of Typ as the nearest multiple of its alignment rounded up. - - -------------------- - -- Double_Size_Of -- - -------------------- - - function Double_Size_Of (Typ : Entity_Id) return Node_Id is - begin - return - Make_Op_Multiply (Loc, - Left_Opnd => Make_Integer_Literal (Loc, 2), - Right_Opnd => Size_Of (Typ)); - end Double_Size_Of; - - --------------------------------- - -- Nearest_Multiple_Rounded_Up -- - --------------------------------- - - function Nearest_Multiple_Rounded_Up - (Size_Expr : Node_Id; - Typ : Entity_Id) return Node_Id - is - function Alignment_Of (Typ : Entity_Id) return Node_Id; - -- Subsidiary routine, generate the following attribute reference: - -- Typ'Alignment - - ------------------ - -- Alignment_Of -- - ------------------ - - function Alignment_Of (Typ : Entity_Id) return Node_Id is - begin - return - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Typ, Loc), - Attribute_Name => Name_Alignment); - end Alignment_Of; - - -- Start of processing for Nearest_Multiple_Rounded_Up - - begin - -- Generate: - -- ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) * - -- Typ'Alignment - - return - Make_Op_Multiply (Loc, - Left_Opnd => - Make_Op_Divide (Loc, - Left_Opnd => - Make_Op_Add (Loc, - Left_Opnd => Size_Expr, - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => Alignment_Of (Typ), - Right_Opnd => Make_Integer_Literal (Loc, 1))), - Right_Opnd => Alignment_Of (Typ)), - Right_Opnd => Alignment_Of (Typ)); - end Nearest_Multiple_Rounded_Up; - - ------------- - -- Size_Of -- - ------------- - - function Size_Of (Typ : Entity_Id) return Node_Id is - begin - return - Nearest_Multiple_Rounded_Up - (Size_Expr => - Make_Op_Divide (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Typ, Loc), - Attribute_Name => Name_Size), - Right_Opnd => - Make_Integer_Literal (Loc, System_Storage_Unit)), - Typ => Typ); - end Size_Of; - - -- Start of processing for Make_Finalize_Address_Stmts - begin if Is_Array_Type (Typ) then if Is_Constrained (First_Subtype (Typ)) then @@ -7190,11 +7097,7 @@ package body Exp_Ch7 is and then not Is_Constrained (First_Subtype (Typ)) then declare - Dope_Expr : Node_Id; - Dope_Id : Entity_Id; - For_First : Boolean := True; - Index : Node_Id; - Index_Typ : Entity_Id; + Dope_Id : Entity_Id; begin -- Ensure that Ptr_Typ a thin pointer, generate: @@ -7207,40 +7110,9 @@ package body Exp_Ch7 is Expression => Make_Integer_Literal (Loc, System_Address_Size))); - -- For unconstrained arrays, create the expression which computes - -- the size of the dope vector. - - Index := First_Index (Typ); - while Present (Index) loop - Index_Typ := Etype (Index); - - -- Each bound has two values and a potential hole added to - -- compensate for alignment differences. - - if For_First then - For_First := False; - Dope_Expr := Double_Size_Of (Index_Typ); - - else - Dope_Expr := - Make_Op_Add (Loc, - Left_Opnd => Dope_Expr, - Right_Opnd => Double_Size_Of (Index_Typ)); - end if; - - Next_Index (Index); - end loop; - - -- Dope_Expr calculates the size of the dope, acounting for - -- individual alignment holes on the index type level. Since the - -- alignment of the component type dictates the underlying layout - -- of the array, round the size of the dope to the next higher - -- multiple of the component alignment. - - Dope_Expr := Nearest_Multiple_Rounded_Up (Dope_Expr, Typ); - -- Generate: - -- Dnn : Storage_Offset := Dope_Expr; + -- Dnn : constant Storage_Offset := + -- Desg_Typ'Descriptor_Size / Storage_Unit; Dope_Id := Make_Temporary (Loc, 'D'); @@ -7250,7 +7122,14 @@ package body Exp_Ch7 is Constant_Present => True, Object_Definition => New_Reference_To (RTE (RE_Storage_Offset), Loc), - Expression => Dope_Expr)); + Expression => + Make_Op_Divide (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Desg_Typ, Loc), + Attribute_Name => Name_Descriptor_Size), + Right_Opnd => + Make_Integer_Literal (Loc, System_Storage_Unit)))); -- Shift the address from the start of the dope vector to the -- start of the elements: diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 8e0ccd4..13df71f 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1878,6 +1878,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) prefix_unused = true; break; + case Attr_Descriptor_Size: + gnu_type = TREE_TYPE (gnu_prefix); + gcc_assert (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE); + + /* What we want is the offset of the ARRAY field in the record that the + thin pointer designates, but the components have been shifted so this + is actually the opposite of the offset of the BOUNDS field. */ + gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_type); + gnu_result = size_binop (MINUS_EXPR, bitsize_zero_node, + bit_position (TYPE_FIELDS (gnu_type))); + gnu_result_type = get_unpadded_type (Etype (gnat_node)); + prefix_unused = true; + break; + case Attr_Null_Parameter: /* This is just a zero cast to the pointer type for our prefix and dereferenced. */ diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index e7d9c5a..9193769 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6718,11 +6718,11 @@ package body Prj.Nmsc is if not Header_File then Compute_Unit_Name - (File_Name => File_Name, - Naming => Config.Naming_Data, - Kind => Kind, - Unit => Unit, - Project => Project); + (File_Name => File_Name, + Naming => Config.Naming_Data, + Kind => Kind, + Unit => Unit, + Project => Project); if Unit /= No_Name then Language := Tmp_Lang; diff --git a/gcc/ada/s-tpopsp-vxworks.adb b/gcc/ada/s-tpopsp-vxworks.adb index 09c03ef..a926ca4 100644 --- a/gcc/ada/s-tpopsp-vxworks.adb +++ b/gcc/ada/s-tpopsp-vxworks.adb @@ -70,7 +70,9 @@ package body Specific is Result : STATUS; begin - -- If Self_Id is null, delete task specific data + -- If argument is null, destroy task specific data, to make API + -- consistent with other platforms, and thus compatible with the + -- shared version of s-tpoaal.adb. if Self_Id = null then Result := taskVarDelete (taskIdSelf, ATCB_Key'Access); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 789cb47..9b33acd 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3014,6 +3014,28 @@ package body Sem_Attr is Check_Floating_Point_Type_0; Set_Etype (N, Standard_Boolean); + --------------------- + -- Descriptor_Size -- + --------------------- + + when Attribute_Descriptor_Size => + Check_E0; + + -- Attribute Descriptor_Size is relevant only in the context of an + -- unconstrained array type. + + if Is_Entity_Name (P) + and then Is_Type (Entity (P)) + and then Is_Array_Type (Entity (P)) + and then not Is_Constrained (Entity (P)) + then + null; + else + Error_Attr_P ("invalid prefix for % attribute"); + end if; + + Set_Etype (N, Universal_Integer); + ------------ -- Digits -- ------------ @@ -6246,6 +6268,13 @@ package body Sem_Attr is Fold_Uint (N, UI_From_Int (Boolean'Pos (Denorm_On_Target)), True); + --------------------- + -- Descriptor_Size -- + --------------------- + + when Attribute_Descriptor_Size => + null; + ------------ -- Digits -- ------------ diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fea05ef..332a790 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -744,6 +744,7 @@ package Snames is Name_Definite : constant Name_Id := N + $; Name_Delta : constant Name_Id := N + $; Name_Denorm : constant Name_Id := N + $; + Name_Descriptor_Size : constant Name_Id := N + $; Name_Digits : constant Name_Id := N + $; Name_Elaborated : constant Name_Id := N + $; -- GNAT Name_Emax : constant Name_Id := N + $; -- Ada 83 @@ -1298,6 +1299,7 @@ package Snames is Attribute_Definite, Attribute_Delta, Attribute_Denorm, + Attribute_Descriptor_Size, Attribute_Digits, Attribute_Elaborated, Attribute_Emax, -- 2.7.4