Skip to content

R
riscv-gcc-1
Commit 5b42c035 by Arnaud Charlet
Options

[multiple changes] 

2016-10-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Add new usage for Elist29 and Node35.
	(Anonymous_Designated_Type): New routine.
	(Anonymous_Master): Removed.
	(Anonymous_Masters): New routine.
	(Set_Anonymous_Designated_Type): New routine.
	(Set_Anonymous_Master): Removed.
	(Set_Anonymous_Masters): New routine.
	(Write_Field29_Name): Add output for Anonymous_Masters.
	(Write_Field35_Name): Remove the output for Anonymous_Master. Add
	output for Anonymous_Designated_Type.
	* einfo.ads Remove attribute Anonymous_Master along with
	usage in entities. Add attributes Anonymous_Designated_Type
	and Anonymous_Masters along with usage in entities.
	(Anonymous_Designated_Type): New routine along with pragma Inline.
	(Anonymous_Master): Removed along with pragma Inline.
	(Anonymous_Masters): New routine along with pragma Inline.
	(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
	(Set_Anonymous_Master): Removed along with pragma Inline.
	(Set_Anonymous_Masters): New routine along with pragma Inline.
	* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
	defined in the same unit if it services the same designated
	type, otherwise create a new one.
	(Create_Anonymous_Master): Reimplemented.
	(Current_Anonymous_Master): New routine.
	(In_Subtree): Removed.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
	Check properly whether there is an explicit assertion policy
	for predicate checking, even in the presence of a general Ignore
	assertion policy.

2016-10-12  Steve Baird  <baird@adacore.com>

	* sem.adb (Walk_Library_Items): Cope with ignored ghost units.

From-SVN: r241049
parent d89ce432
Showing with 204 additions and 121 deletions
gcc/ada/ChangeLog
2016-10-12 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Add new usage for Elist29 and Node35.
(Anonymous_Designated_Type): New routine.
(Anonymous_Master): Removed.
(Anonymous_Masters): New routine.
(Set_Anonymous_Designated_Type): New routine.
(Set_Anonymous_Master): Removed.
(Set_Anonymous_Masters): New routine.
(Write_Field29_Name): Add output for Anonymous_Masters.
(Write_Field35_Name): Remove the output for Anonymous_Master. Add
output for Anonymous_Designated_Type.
* einfo.ads Remove attribute Anonymous_Master along with
usage in entities. Add attributes Anonymous_Designated_Type
and Anonymous_Masters along with usage in entities.
(Anonymous_Designated_Type): New routine along with pragma Inline.
(Anonymous_Master): Removed along with pragma Inline.
(Anonymous_Masters): New routine along with pragma Inline.
(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
(Set_Anonymous_Master): Removed along with pragma Inline.
(Set_Anonymous_Masters): New routine along with pragma Inline.
* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
defined in the same unit if it services the same designated
type, otherwise create a new one.
(Create_Anonymous_Master): Reimplemented.
(Current_Anonymous_Master): New routine.
(In_Subtree): Removed.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
Check properly whether there is an explicit assertion policy
for predicate checking, even in the presence of a general Ignore
assertion policy.
2016-10-12 Steve Baird <baird@adacore.com>
* sem.adb (Walk_Library_Items): Cope with ignored ghost units.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* lib-writ.adb (Write_ALI): Removal of unused file entries from
......
gcc/ada/einfo.adb
......@@ -244,6 +244,7 @@ package body Einfo is
-- Relative_Deadline_Variable Node28
-- Underlying_Record_View Node28
-- Anonymous_Masters Elist29
-- BIP_Initialization_Call Node29
-- Subprograms_For_Type Elist29
......@@ -265,7 +266,7 @@ package body Einfo is
-- Contract Node34
-- Anonymous_Master Node35
-- Anonymous_Designated_Type Node35
-- Import_Pragma Node35
-- Class_Wide_Preconds List38
......@@ -766,11 +767,20 @@ package body Einfo is
return Uint14 (Id);
end Alignment;
function Anonymous_Master (Id : E) return E is
function Anonymous_Designated_Type (Id : E) return E is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Ekind (Id) = E_Variable);
return Node35 (Id);
end Anonymous_Master;
end Anonymous_Designated_Type;
function Anonymous_Masters (Id : E) return L is
begin
pragma Assert (Ekind_In (Id, E_Function,
E_Package,
E_Procedure,
E_Subprogram_Body));
return Elist29 (Id);
end Anonymous_Masters;
function Anonymous_Object (Id : E) return E is
begin
......@@ -3726,11 +3736,20 @@ package body Einfo is
Set_Elist16 (Id, V);
end Set_Access_Disp_Table;
procedure Set_Anonymous_Master (Id : E; V : E) is
procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Ekind (Id) = E_Variable);
Set_Node35 (Id, V);
end Set_Anonymous_Master;
end Set_Anonymous_Designated_Type;
procedure Set_Anonymous_Masters (Id : E; V : L) is
begin
pragma Assert (Ekind_In (Id, E_Function,
E_Package,
E_Procedure,
E_Subprogram_Body));
Set_Elist29 (Id, V);
end Set_Anonymous_Masters;
procedure Set_Anonymous_Object (Id : E; V : E) is
begin
......@@ -10503,6 +10522,12 @@ package body Einfo is
procedure Write_Field29_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when E_Function |
E_Package |
E_Procedure |
E_Subprogram_Body =>
Write_Str ("Anonymous_Masters");
when E_Constant |
E_Variable =>
Write_Str ("BIP_Initialization_Call");
......@@ -10650,8 +10675,8 @@ package body Einfo is
procedure Write_Field35_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when Type_Kind =>
Write_Str ("Anonymous_Master");
when E_Variable =>
Write_Str ("Anonymous_Designated_Type");
when Subprogram_Kind =>
Write_Str ("Import_Pragma");
......
gcc/ada/einfo.ads
......@@ -438,11 +438,15 @@ package Einfo is
-- definition clause with an (obsolescent) mod clause is converted
-- into an attribute definition clause for this purpose.
-- Anonymous_Master (Node35)
-- Defined in all types. Contains the entity of an anonymous finalization
-- master which services all anonymous access types associated with the
-- same designated type within the current semantic unit. The attribute
-- is set reactively during the expansion of allocators.
-- Anonymous_Designated_Type (Node35)
-- Defined in variables which represent anonymous finalization masters.
-- Contains the designated type which is being services by the master.
-- Anonymous_Masters (Elist29)
-- Defined in packages, subprograms, and subprogram bodies. Contains a
-- list of anonymous finalization masters declared within the related
-- unit. The list acts as a mapping between a master and a designated
-- type.
-- Anonymous_Object (Node30)
-- Present in protected and task type entities. Contains the entity of
......@@ -5530,7 +5534,6 @@ package Einfo is
-- Derived_Type_Link (Node31)
-- No_Tagged_Streams_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Anonymous_Master (Node35)
-- Depends_On_Private (Flag14)
-- Disable_Controlled (Flag253)
......@@ -5982,6 +5985,7 @@ package Einfo is
-- Overridden_Operation (Node26)
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Corresponding_Equality (Node30) (implicit /= only)
-- Thunk_Entity (Node31) (thunk case only)
-- Corresponding_Procedure (Node32) (generate C code only)
......@@ -6207,6 +6211,7 @@ package Einfo is
-- Package_Instantiation (Node26)
-- Current_Use_Clause (Node27)
-- Finalizer (Node28) (non-generic case only)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- SPARK_Aux_Pragma (Node41)
......@@ -6292,6 +6297,7 @@ package Einfo is
-- Overridden_Operation (Node26) (never for init proc)
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Static_Initialization (Node30) (init_proc only)
-- Thunk_Entity (Node31) (thunk case only)
-- Corresponding_Function (Node32) (generate C code only)
......@@ -6483,6 +6489,7 @@ package Einfo is
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- Contains_Ignored_Ghost_Code (Flag279)
......@@ -6564,6 +6571,7 @@ package Einfo is
-- Encapsulating_State (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Anonymous_Designated_Type (Node35)
-- SPARK_Pragma (Node40)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
......@@ -6837,7 +6845,8 @@ package Einfo is
function Address_Taken (Id : E) return B;
function Alias (Id : E) return E;
function Alignment (Id : E) return U;
function Anonymous_Master (Id : E) return E;
function Anonymous_Designated_Type (Id : E) return E;
function Anonymous_Masters (Id : E) return L;
function Anonymous_Object (Id : E) return E;
function Associated_Entity (Id : E) return E;
function Associated_Formal_Package (Id : E) return E;
......@@ -7516,7 +7525,8 @@ package Einfo is
procedure Set_Address_Taken (Id : E; V : B := True);
procedure Set_Alias (Id : E; V : E);
procedure Set_Alignment (Id : E; V : U);
procedure Set_Anonymous_Master (Id : E; V : E);
procedure Set_Anonymous_Designated_Type (Id : E; V : E);
procedure Set_Anonymous_Masters (Id : E; V : L);
procedure Set_Anonymous_Object (Id : E; V : E);
procedure Set_Associated_Entity (Id : E; V : E);
procedure Set_Associated_Formal_Package (Id : E; V : E);
......@@ -8314,7 +8324,8 @@ package Einfo is
pragma Inline (Address_Taken);
pragma Inline (Alias);
pragma Inline (Alignment);
pragma Inline (Anonymous_Master);
pragma Inline (Anonymous_Designated_Type);
pragma Inline (Anonymous_Masters);
pragma Inline (Anonymous_Object);
pragma Inline (Associated_Entity);
pragma Inline (Associated_Formal_Package);
......@@ -8832,7 +8843,8 @@ package Einfo is
pragma Inline (Set_Address_Taken);
pragma Inline (Set_Alias);
pragma Inline (Set_Alignment);
pragma Inline (Set_Anonymous_Master);
pragma Inline (Set_Anonymous_Designated_Type);
pragma Inline (Set_Anonymous_Masters);
pragma Inline (Set_Anonymous_Object);
pragma Inline (Set_Associated_Entity);
pragma Inline (Set_Associated_Formal_Package);
......
gcc/ada/exp_ch7.adb
......@@ -541,14 +541,16 @@ package body Exp_Ch7 is
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id;
Unit_Decl : Node_Id) return Entity_Id;
-- Create a new anonymous finalization master for access type Ptr_Typ
-- with designated type Desig_Typ. The declaration of the master along
-- with its specialized initialization is inserted in the declarative
-- part of unit Unit_Decl. Unit_Id denotes the entity of Unit_Decl.
-- Create a new anonymous master for access type Ptr_Typ with designated
-- type Desig_Typ. The declaration of the master and its initialization
-- are inserted in the declarative part of unit Unit_Decl. Unit_Id is
-- the entity of Unit_Decl.
function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean;
-- Determine whether arbitrary node N appears within the subtree rooted
-- at node Root.
function Current_Anonymous_Master
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id) return Entity_Id;
-- Find an anonymous master declared within unit Unit_Id which services
-- designated type Desig_Typ. If there is no such master, return Empty.
-----------------------------
-- Create_Anonymous_Master --
......@@ -560,15 +562,41 @@ package body Exp_Ch7 is
Unit_Decl : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (Unit_Id);
Spec_Id : constant Entity_Id := Unique_Defining_Entity (Unit_Decl);
All_FMs : Elist_Id;
Decls : List_Id;
FM_Decl : Node_Id;
FM_Id : Entity_Id;
FM_Init : Node_Id;
Pref : Character;
Unit_Spec : Node_Id;
begin
-- Generate:
-- <FM_Id> : Finalization_Master;
FM_Id := Make_Temporary (Loc, 'A');
FM_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => FM_Id,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
-- Generate:
-- Set_Base_Pool
-- (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
FM_Init :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (FM_Id, Loc),
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
Attribute_Name => Name_Unrestricted_Access)));
-- Find the declarative list of the unit
if Nkind (Unit_Decl) = N_Package_Declaration then
......@@ -588,8 +616,8 @@ package body Exp_Ch7 is
-- procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
-- There is no suitable place to create the anonymous master as the
-- subprogram is not in a declarative list.
-- There is no suitable place to create the master as the subprogram
-- is not in a declarative list.
else
Decls := Declarations (Unit_Decl);
......@@ -600,100 +628,74 @@ package body Exp_Ch7 is
end if;
end if;
-- Step 1: Anonymous master creation
-- Use a unique prefix in case the same unit requires two anonymous
-- masters, one for the spec (S) and one for the body (B).
if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
Pref := 'S';
else
Pref := 'B';
end if;
-- The name of the anonymous master has the following format:
-- [BS]scopN__scop1__chars_of_desig_typAM
-- The name utilizes the fully qualified name of the designated type
-- in case two controlled types with the same name are declared in
-- different scopes and both have anonymous access types.
FM_Id :=
Make_Defining_Identifier (Loc,
New_External_Name
(Related_Id => Get_Qualified_Name (Desig_Typ),
Suffix => "AM",
Prefix => Pref));
-- Associate the anonymous master with the designated type. This
-- ensures that any additional anonymous access types with the same
-- designated type will share the same anonymous master within the
-- same unit.
Set_Anonymous_Master (Desig_Typ, FM_Id);
Prepend_To (Decls, FM_Init);
Prepend_To (Decls, FM_Decl);
-- Generate:
-- <FM_Id> : Finalization_Master;
-- Use the scope of the unit when analyzing the declaration of the
-- master and its initialization actions.
FM_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => FM_Id,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
Push_Scope (Unit_Id);
Analyze (FM_Decl);
Analyze (FM_Init);
Pop_Scope;
-- Step 2: Initialization actions
-- Mark the master as servicing this specific designated type
-- Generate:
-- Set_Base_Pool
-- (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
Set_Anonymous_Designated_Type (FM_Id, Desig_Typ);
FM_Init :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (FM_Id, Loc),
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
Attribute_Name => Name_Unrestricted_Access)));
-- Include the anonymous master in the list of existing masters which
-- appear in this unit. This effectively creates a mapping between a
-- master and a designated type which in turn allows for the reusal
-- of masters on a per-unit basis.
Prepend_To (Decls, FM_Init);
Prepend_To (Decls, FM_Decl);
All_FMs := Anonymous_Masters (Unit_Id);
-- Since the anonymous master and all its initialization actions are
-- inserted at top level, use the scope of the unit when analyzing.
if No (All_FMs) then
All_FMs := New_Elmt_List;
Set_Anonymous_Masters (Unit_Id, All_FMs);
end if;
Push_Scope (Spec_Id);
Analyze (FM_Decl);
Analyze (FM_Init);
Pop_Scope;
Prepend_Elmt (FM_Id, All_FMs);
return FM_Id;
end Create_Anonymous_Master;
----------------
-- In_Subtree --
----------------
------------------------------
-- Current_Anonymous_Master --
------------------------------
function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean is
Par : Node_Id;
function Current_Anonymous_Master
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id) return Entity_Id
is
All_FMs : constant Elist_Id := Anonymous_Masters (Unit_Id);
FM_Elmt : Elmt_Id;
FM_Id : Entity_Id;
begin
-- Traverse the parent chain until reaching the same root
-- Inspect the list of anonymous masters declared within the unit
-- looking for an existing master which services the same designated
-- type.
Par := N;
while Present (Par) loop
if Par = Root then
return True;
if Present (All_FMs) then
FM_Elmt := First_Elmt (All_FMs);
while Present (FM_Elmt) loop
FM_Id := Node (FM_Elmt);
-- The currect master services the same designated type. As a
-- result the master can be reused and associated with another
-- anonymous access-to-controlled type.
if Anonymous_Designated_Type (FM_Id) = Desig_Typ then
return FM_Id;
end if;
Par := Parent (Par);
Next_Elmt (FM_Elmt);
end loop;
end if;
return False;
end In_Subtree;
return Empty;
end Current_Anonymous_Master;
-- Local variables
......@@ -714,7 +716,7 @@ package body Exp_Ch7 is
end if;
Unit_Decl := Unit (Cunit (Current_Sem_Unit));
Unit_Id := Defining_Entity (Unit_Decl);
Unit_Id := Unique_Defining_Entity (Unit_Decl);
-- The compilation unit is a package instantiation. In this case the
-- anonymous master is associated with the package spec as both the
......@@ -738,21 +740,14 @@ package body Exp_Ch7 is
Desig_Typ := Priv_View;
end if;
FM_Id := Anonymous_Master (Desig_Typ);
-- Determine whether the current semantic unit already has an anonymous
-- master which services the designated type.
-- The designated type already has at least one anonymous access type
-- pointing to it within the current unit. Reuse the anonymous master
-- because the designated type is the same.
FM_Id := Current_Anonymous_Master (Desig_Typ, Unit_Id);
if Present (FM_Id)
and then In_Subtree (Declaration_Node (FM_Id), Root => Unit_Decl)
then
null;
-- If this is not the case, create a new master
-- Otherwise the designated type lacks an anonymous master or it is
-- declared in a different unit. Create a brand new master.
else
if No (FM_Id) then
FM_Id := Create_Anonymous_Master (Desig_Typ, Unit_Id, Unit_Decl);
end if;
......
gcc/ada/sem.adb
......@@ -1767,6 +1767,11 @@ package body Sem is
pragma Assert (False, "subunit");
null;
when N_Null_Statement =>
pragma Assert (Is_Ignored_Ghost_Node (Original_Node (Item)));
-- Do not call Action for an ignored ghost unit
return;
when others =>
pragma Assert (False);
null;
......@@ -2095,6 +2100,11 @@ package body Sem is
-- happen when the body of a parent depends on some other
-- descendant.
when N_Null_Statement =>
-- Ignore an ignored ghost unit
pragma Assert (Is_Ignored_Ghost_Node (Original_Node (N)));
null;
when others =>
Par := Scope (Defining_Entity (Unit (CU)));
......
gcc/ada/sem_prag.adb
......@@ -19136,15 +19136,17 @@ package body Sem_Prag is
-- the rep item chain, for processing when the type is frozen.
-- This is accomplished by a call to Rep_Item_Too_Late. We also
-- mark the type as having predicates.
-- If the current policy is Ignore mark the subtype accordingly.
-- In the case of predicates we consider them enabled unless an
-- Ignore is specified, to preserve existing warnings.
-- If the current policy for predicate checking is Ignore mark the
-- subtype accordingly. In the case of predicates we consider them
-- enabled unless Ignore is specified (either directly or with a
-- general Assertion_Policy pragma) to preserve existing warnings.
Set_Has_Predicates (Typ);
Set_Predicates_Ignored (Typ,
Present (Check_Policy_List)
and then
Policy_In_Effect (Name_Assertion_Policy) = Name_Ignore);
Policy_In_Effect (Name_Dynamic_Predicate) = Name_Ignore);
Discard := Rep_Item_Too_Late (Typ, N, FOnly => True);
end Predicate;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment