[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:
parent
e27d328acd
commit
26b043e041
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 --
|
||||
---------------------------------
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue