+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.
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.
-- 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
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
-- 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
-- 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++
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 --
---------------------------------
-- --
-- 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- --
-- 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;
--------------------------
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
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
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;
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;
-- 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.
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;
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;
-- 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);
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.
projects / gcc.git / commitdiff