[multiple changes]

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* 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  <ebotcazou@adacore.com>

	* gnat_ugn.texi: Further minor improvement to -flto entry.

2014-10-31  Gary Dismukes  <dismukes@adacore.com>

	* g-dynhta.adb, g-dynhta.ads: Minor typo fixes and reformatting.

From-SVN: r216955
This commit is contained in:
Arnaud Charlet 2014-10-31 11:59:56 +01:00
parent e27d328acd
commit 26b043e041
8 changed files with 131 additions and 65 deletions

View File

@ -1,3 +1,24 @@
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* 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 <ebotcazou@adacore.com>
* gnat_ugn.texi: Further minor improvement to -flto entry.
2014-10-31 Gary Dismukes <dismukes@adacore.com>
* g-dynhta.adb, g-dynhta.ads: Minor typo fixes and reformatting.
2014-10-30 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup.

View File

@ -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

View File

@ -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;
-- 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.
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.
Tag_Assign := Make_Tag_Assignment (N);
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)));
-- 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.
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 --
---------------------------------

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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);

View File

@ -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.