From: Arnaud Charlet Date: Fri, 31 Oct 2014 10:59:56 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=26b043e041529af951b20d4e94841e6433d9cc1c;p=gcc.git [multiple changes] 2014-10-31 Ed Schonberg * exp_ch3.ads (Make_Tag_Assignment): New function, used to re-initialize the tag in a tagged object declaration with initial value. * exp_ch3.adb (Expand_N_Object_Declaration): Use Make_Tag_Assignment to simplify code for a tagged object declaration. * exp_ch13.adb (Expand_Freeze_Entity): Analyze freeze actions for the freeze node of an object. * freeze.adb (Check_Address_Clause): Use Make_Tag_Assignment when needed to extend Freeze_Actions for a tagged object declaration. 2014-10-31 Eric Botcazou * gnat_ugn.texi: Further minor improvement to -flto entry. 2014-10-31 Gary Dismukes * g-dynhta.adb, g-dynhta.ads: Minor typo fixes and reformatting. From-SVN: r216955 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4a87fef7a2e..4a6b6591854 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2014-10-31 Ed Schonberg + + * exp_ch3.ads (Make_Tag_Assignment): New function, used to + re-initialize the tag in a tagged object declaration with + initial value. + * exp_ch3.adb (Expand_N_Object_Declaration): Use + Make_Tag_Assignment to simplify code for a tagged object + declaration. + * exp_ch13.adb (Expand_Freeze_Entity): Analyze freeze actions + for the freeze node of an object. + * freeze.adb (Check_Address_Clause): Use Make_Tag_Assignment when + needed to extend Freeze_Actions for a tagged object declaration. + +2014-10-31 Eric Botcazou + + * gnat_ugn.texi: Further minor improvement to -flto entry. + +2014-10-31 Gary Dismukes + + * g-dynhta.adb, g-dynhta.ads: Minor typo fixes and reformatting. + 2014-10-30 Ed Schonberg * exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup. diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index ff73d94522b..fa385a0dca1 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -418,6 +418,20 @@ package body Exp_Ch13 is Apply_Address_Clause_Check (E, N); end if; + -- Analyze actions in freeze node, if any. + + if Present (Actions (N)) then + declare + Act : Node_Id; + begin + Act := First (Actions (N)); + while Present (Act) loop + Analyze (Act); + Next (Act); + end loop; + end; + end if; + -- If initialization statements have been captured in a compound -- statement, insert them back into the tree now. @@ -566,7 +580,7 @@ package body Exp_Ch13 is -- If subprogram, freeze the subprogram elsif Is_Subprogram (E) then - Freeze_Subprogram (N); + Exp_Ch6.Freeze_Subprogram (N); -- Ada 2005 (AI-251): Remove the freezing node associated with the -- entities internally used by the frontend to register primitives diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 8df5a503ed4..0e6c8dd755c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5328,7 +5328,6 @@ package body Exp_Ch3 is Next_N : constant Node_Id := Next (N); Id_Ref : Node_Id; - New_Ref : Node_Id; Init_After : Node_Id := N; -- Node after which the initialization actions are to be inserted. This @@ -5336,6 +5335,8 @@ package body Exp_Ch3 is -- which case the init proc call must be inserted only after the bodies -- of the shared variable procedures have been seen. + Tag_Assign : Node_Id; + -- Start of processing for Expand_N_Object_Declaration begin @@ -5825,52 +5826,21 @@ package body Exp_Ch3 is -- CPP_CLASS, and for initializations that are aggregates, because -- they have to have the right tag. - if Is_Tagged_Type (Typ) - and then not Is_Class_Wide_Type (Typ) - and then not Is_CPP_Class (Typ) - and then Tagged_Type_Expansion - and then Nkind (Expr) /= N_Aggregate - and then (Nkind (Expr) /= N_Qualified_Expression - or else Nkind (Expression (Expr)) /= N_Aggregate) - then - declare - Full_Typ : constant Entity_Id := Underlying_Type (Typ); - Tag_Assign : Node_Id; - - begin - -- The re-assignment of the tag has to be done even if the - -- object is a constant. The assignment must be analyzed - -- after the declaration. - - New_Ref := - Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Def_Id, Loc), - Selector_Name => - New_Occurrence_Of (First_Tag_Component (Full_Typ), - Loc)); - Set_Assignment_OK (New_Ref); - - Tag_Assign := - Make_Assignment_Statement (Loc, - Name => New_Ref, - Expression => - Unchecked_Convert_To (RTE (RE_Tag), - New_Occurrence_Of - (Node - (First_Elmt (Access_Disp_Table (Full_Typ))), - Loc))); + -- The re-assignment of the tag has to be done even if the object + -- is a constant. The assignment must be analyzed after the + -- declaration. If an address clause follows, this is handled as + -- part of the freeze actions for the object, otherwise insert + -- tag assignment here. - -- Tag initialization cannot be done before object is - -- frozen. If an address clause follows, make sure freeze - -- node exists, and insert it and the tag assignment after - -- the address clause. + Tag_Assign := Make_Tag_Assignment (N); - if Present (Following_Address_Clause (N)) then - Init_After := Following_Address_Clause (N); - end if; + if Present (Tag_Assign) then + if Present (Following_Address_Clause (N)) then + Ensure_Freeze_Node (Def_Id); + else Insert_Action_After (Init_After, Tag_Assign); - end; + end if; -- Handle C++ constructor calls. Note that we do not check that -- Typ is a tagged type since the equivalent Ada type of a C++ @@ -9717,6 +9687,46 @@ package body Exp_Ch3 is Predef_List := Res; end Make_Predefined_Primitive_Specs; + ------------------------- + -- Make_Tag_Assignment -- + ------------------------- + + function Make_Tag_Assignment (N : Node_Id) return Node_Id is + Loc : constant Source_Ptr := Sloc (N); + Def_If : constant Entity_Id := Defining_Identifier (N); + Expr : constant Node_Id := Expression (N); + Typ : constant Entity_Id := Etype (Def_If); + Full_Typ : constant Entity_Id := Underlying_Type (Typ); + New_Ref : Node_Id; + + begin + if Is_Tagged_Type (Typ) + and then not Is_Class_Wide_Type (Typ) + and then not Is_CPP_Class (Typ) + and then Tagged_Type_Expansion + and then Nkind (Expr) /= N_Aggregate + and then (Nkind (Expr) /= N_Qualified_Expression + or else Nkind (Expression (Expr)) /= N_Aggregate) + then + New_Ref := + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Def_If, Loc), + Selector_Name => + New_Occurrence_Of (First_Tag_Component (Full_Typ), Loc)); + Set_Assignment_OK (New_Ref); + + return + Make_Assignment_Statement (Loc, + Name => New_Ref, + Expression => + Unchecked_Convert_To (RTE (RE_Tag), + New_Occurrence_Of (Node + (First_Elmt (Access_Disp_Table (Full_Typ))), Loc))); + else + return Empty; + end if; + end Make_Tag_Assignment; + --------------------------------- -- Needs_Simple_Initialization -- --------------------------------- diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index de767fcaa6b..f432158ed3d 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -104,6 +104,14 @@ package Exp_Ch3 is -- then tags components located at variable positions of Target are -- initialized. + function Make_Tag_Assignment (N : Node_Id) return Node_Id; + -- An object declaration that has an initialization for a tagged object + -- requires a separate reassignment of the tag of the given type, because + -- the expression may include an unchecked conversion. This tag + -- assignment is inserted after the declaration, but if the object has + -- an address clause the assignment is handled as part of the freezing + -- of the object, see Check_Address_Clause. + function Needs_Simple_Initialization (T : Entity_Id; Consider_IS : Boolean := True) return Boolean; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 63da31844a0..330ba5ddd00 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -578,11 +578,13 @@ package body Freeze is -------------------------- procedure Check_Address_Clause (E : Entity_Id) is - Addr : constant Node_Id := Address_Clause (E); - Expr : Node_Id; - Decl : constant Node_Id := Declaration_Node (E); - Loc : constant Source_Ptr := Sloc (Decl); - Typ : constant Entity_Id := Etype (E); + Addr : constant Node_Id := Address_Clause (E); + Expr : Node_Id; + Decl : constant Node_Id := Declaration_Node (E); + Loc : constant Source_Ptr := Sloc (Decl); + Typ : constant Entity_Id := Etype (E); + Lhs : Node_Id; + Tag_Assign : Node_Id; begin if Present (Addr) then @@ -636,9 +638,13 @@ package body Freeze is if Present (Expression (Decl)) then - -- Capture initialization value at point of declaration + -- Capture initialization value at point of declaration, + -- and make explicit assignment legal, because object may + -- be a constant. Remove_Side_Effects (Expression (Decl)); + Lhs := New_Occurrence_Of (E, Loc); + Set_Assignment_OK (Lhs); -- Move initialization to freeze actions (once the object has -- been frozen, and the address clause alignment check has been @@ -646,10 +652,19 @@ package body Freeze is Append_Freeze_Action (E, Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (E, Loc), + Name => Lhs, Expression => Expression (Decl))); Set_No_Initialization (Decl); + + -- If the objet is tagged, check whether the tag must be + -- reassigned expliitly. + + Tag_Assign := Make_Tag_Assignment (Decl); + if Present (Tag_Assign) then + Append_Freeze_Action (E, Tag_Assign); + end if; + end if; end if; end Check_Address_Clause; diff --git a/gcc/ada/g-dynhta.adb b/gcc/ada/g-dynhta.adb index 9d3424c54fc..929191d24aa 100644 --- a/gcc/ada/g-dynhta.adb +++ b/gcc/ada/g-dynhta.adb @@ -507,7 +507,7 @@ package body GNAT.Dynamic_HTables is begin -- Skip the dummy head, inspect the bucket chain for an element whose - -- key matches the requested key. Since each bucket chain is curcular + -- key matches the requested key. Since each bucket chain is circular -- the search must stop once the dummy head is encountered. Elmt := Chain.Next; diff --git a/gcc/ada/g-dynhta.ads b/gcc/ada/g-dynhta.ads index b5670b3120a..d1dedae2a25 100644 --- a/gcc/ada/g-dynhta.ads +++ b/gcc/ada/g-dynhta.ads @@ -238,10 +238,10 @@ package GNAT.Dynamic_HTables is -- Load_Factor_HTable -- ------------------------ - -- A simple hash table abstraction capable of growing once a treshold has + -- A simple hash table abstraction capable of growing once a threshold has -- been exceeded. Collisions are resolved by chaining elements onto lists -- hanging from individual buckets. This implementation does not make any - -- effort in minimizing the number of necessary rehashes once the table has + -- effort to minimize the number of necessary rehashes once the table has -- been expanded, hence the term "simple". -- WARNING: This hash table implementation utilizes dynamic allocation. @@ -254,7 +254,7 @@ package GNAT.Dynamic_HTables is generic type Range_Type is range <>; -- The underlying range of the hash table. Note that this type must be - -- large enough to accomodate multiple expansions of the table. + -- large enough to accommodate multiple expansions of the table. type Key_Type is private; type Value_Type is private; @@ -270,12 +270,12 @@ package GNAT.Dynamic_HTables is Growth_Percentage : Positive; -- The amount of increase expressed as a percentage. The hash table must -- grow by at least 1%. To illustrate, a value of 100 will increase the - -- table by 100% effectively doubling its size. + -- table by 100%, effectively doubling its size. Load_Factor : Float; -- The ratio of the elements stored within the hash table divided by the - -- current size of the table. This value acts as the growth treshold. If - -- exceeded, the hash table is expanded by Growth_Percentage. + -- current size of the table. This value acts as the growth threshold. + -- If exceeded, the hash table is expanded by Growth_Percentage. with function Equal (Left : Key_Type; @@ -293,7 +293,7 @@ package GNAT.Dynamic_HTables is -- Obtain the current size of the table function Get (T : Table; Key : Key_Type) return Value_Type; - -- Obtain the value associated with a key. This routne returns No_Value + -- Obtain the value associated with a key. This routine returns No_Value -- if the key is not present in the hash table. procedure Remove (T : in out Table; Key : Key_Type); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 573377fd146..532a0c111d2 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3513,14 +3513,12 @@ approach is that the compiler can do a whole-program analysis and choose the best interprocedural optimization strategy based on a complete view of the program, instead of a fragmentary view with the usual approach. This can also speed up the compilation of big programs and reduce the -size of the executable when used in conjunction with the @option{-gnatn1} -switch, compared with a traditional per-unit compilation with full -inlining across modules enabled with the @option{-gnatn2} switch. +size of the executable, compared with a traditional per-unit compilation +with inlining across modules enabled by the @option{-gnatn} switch. The drawback of this approach is that it may require more memory and that the debugging information generated by -g with it might be hardly usable. The switch, as well as the accompanying @option{-Ox} switches, must be -specified both for the compilation and the link phases; the recommended -combination is @option{-O[23] -gnatn1 -flto[=n]} in most cases. +specified both for the compilation and the link phases. If the @var{n} parameter is specified, the optimization and final code generation at link time are executed using @var{n} parallel jobs by means of an installed @command{make} program.