Skip to content

R
riscv-gcc-1
Commit 57ae790f by Hristian Kirtchev Committed by Arnaud Charlet
Options

2015-05-22 Hristian Kirtchev <kirtchev@adacore.com> 

	* einfo.adb Node36 is now used as Anonymous_Master. Flag253
	is now unused.
	(Anonymous_Master): New routine.
	(Has_Anonymous_Master): Removed.
	(Set_Anonymous_Master): New routine.
	(Set_Has_Anonymous_Master): Removed.
	(Write_Entity_Flags): Remove the output for Has_Anonymous_Maser.
	(Write_Field36_Name): Add output for Anonymous_Master.
	* einfo.ads Add new attribute Anonymous_Master along with
	occurrences in nodes. Remove attribute Has_Anonymous_Master along
	with occurrences in nodes.
	(Anonymous_Master): New routine along with pragma Inline.
	(Has_Anonymous_Master): Removed along with pragma Inline.
	(Set_Anonymous_Master): New routine along with pragma Inline.
	(Set_Has_Anonymous_Master): Removed along with pragma Inline.
	* exp_ch4.adb (Create_Anonymous_Master): New routine.
	(Current_Anonymous_Master): Reimplemented.

From-SVN: r223550
parent a79cdb2c
Showing with 170 additions and 158 deletions
gcc/ada/ChangeLog
2015-05-22 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Node36 is now used as Anonymous_Master. Flag253
is now unused.
(Anonymous_Master): New routine.
(Has_Anonymous_Master): Removed.
(Set_Anonymous_Master): New routine.
(Set_Has_Anonymous_Master): Removed.
(Write_Entity_Flags): Remove the output for Has_Anonymous_Maser.
(Write_Field36_Name): Add output for Anonymous_Master.
* einfo.ads Add new attribute Anonymous_Master along with
occurrences in nodes. Remove attribute Has_Anonymous_Master along
with occurrences in nodes.
(Anonymous_Master): New routine along with pragma Inline.
(Has_Anonymous_Master): Removed along with pragma Inline.
(Set_Anonymous_Master): New routine along with pragma Inline.
(Set_Has_Anonymous_Master): Removed along with pragma Inline.
* exp_ch4.adb (Create_Anonymous_Master): New routine.
(Current_Anonymous_Master): Reimplemented.
2015-05-22 Bob Duff <duff@adacore.com>
* freeze.adb (Freeze_Profile): Suppress warning if imported
......
gcc/ada/einfo.adb
......@@ -264,7 +264,8 @@ package body Einfo is
-- Import_Pragma Node35
-- (unused) Node36
-- Anonymous_Master Node36
-- (unused) Node38
-- (unused) Node39
-- (unused) Node40
......@@ -556,7 +557,6 @@ package body Einfo is
-- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252
-- Has_Anonymous_Master Flag253
-- Is_Implementation_Defined Flag254
-- Is_Predicate_Function Flag255
-- Is_Predicate_Function_M Flag256
......@@ -594,6 +594,7 @@ package body Einfo is
-- Has_Volatile_Full_Access Flag285
-- Needs_Typedef Flag286
-- (unused) Flag253
-- (unused) Flag287
-- (unused) Flag288
-- (unused) Flag289
......@@ -753,6 +754,12 @@ package body Einfo is
return Uint14 (Id);
end Alignment;
function Anonymous_Master (Id : E) return E is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
return Node36 (Id);
end Anonymous_Master;
function Associated_Entity (Id : E) return E is
begin
return Node37 (Id);
......@@ -1375,13 +1382,6 @@ package body Einfo is
return Flag79 (Id);
end Has_All_Calls_Remote;
function Has_Anonymous_Master (Id : E) return B is
begin
pragma Assert
(Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
return Flag253 (Id);
end Has_Anonymous_Master;
function Has_Atomic_Components (Id : E) return B is
begin
return Flag86 (Implementation_Base_Type (Id));
......@@ -3576,6 +3576,12 @@ package body Einfo is
Set_Elist16 (Id, V);
end Set_Access_Disp_Table;
procedure Set_Anonymous_Master (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
Set_Node36 (Id, V);
end Set_Anonymous_Master;
procedure Set_Associated_Entity (Id : E; V : E) is
begin
Set_Node37 (Id, V);
......@@ -4246,13 +4252,6 @@ package body Einfo is
Set_Flag79 (Id, V);
end Set_Has_All_Calls_Remote;
procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
begin
pragma Assert
(Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
Set_Flag253 (Id, V);
end Set_Has_Anonymous_Master;
procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
begin
pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
......@@ -8634,7 +8633,6 @@ package body Einfo is
W ("Has_Aliased_Components", Flag135 (Id));
W ("Has_Alignment_Clause", Flag46 (Id));
W ("Has_All_Calls_Remote", Flag79 (Id));
W ("Has_Anonymous_Master", Flag253 (Id));
W ("Has_Atomic_Components", Flag86 (Id));
W ("Has_Biased_Representation", Flag139 (Id));
W ("Has_Completion", Flag26 (Id));
......@@ -10121,6 +10119,12 @@ package body Einfo is
procedure Write_Field36_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when E_Function |
E_Operator |
E_Package |
E_Procedure =>
Write_Str ("Anonymous_Master");
when others =>
Write_Str ("Field36??");
end case;
......
gcc/ada/einfo.ads
......@@ -436,6 +436,12 @@ package Einfo is
-- definition clause with an (obsolescent) mod clause is converted
-- into an attribute definition clause for this purpose.
-- Anonymous_Master (Node36)
-- Defined in the entities of non-generic subprogram and package units.
-- Contains the entity of a special heterogeneous finalization master
-- that services most anonymous access-to-controlled allocations that
-- occur within the unit.
-- Associated_Entity (Node37)
-- Defined in all entities. This field is similar to Associated_Node, but
-- applied to entities. The attribute links an entity from the generic
......@@ -1423,13 +1429,6 @@ package Einfo is
-- entities, so the flag Is_Remote_Call_Interface will always be set if
-- this flag is set.
-- Has_Anonymous_Master (Flag253)
-- Defined in units (top-level functions and procedures, library-level
-- packages). Set if the associated unit contains a heterogeneous
-- finalization master. The master's name is of the form <unit>AM and it
-- services anonymous access-to-controlled types with an undetermined
-- lifetime.
-- Has_Atomic_Components (Flag86) [implementation base type only]
-- Defined in all types and objects. Set only for an array type or
-- an array object if a valid pragma Atomic_Components applies to the
......@@ -5833,6 +5832,7 @@ package Einfo is
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Import_Pragma (Node35) (non-generic case only)
-- Anonymous_Master (Node36) (non-generic case only)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Default_Expressions_Processed (Flag108)
......@@ -5840,7 +5840,6 @@ package Einfo is
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
-- Elaboration_Entity_Required (Flag174)
-- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Controlling_Result (Flag98)
-- Has_Expanded_Contract (Flag240) (non-generic case only)
......@@ -6050,6 +6049,7 @@ package Einfo is
-- SPARK_Pragma (Node32)
-- SPARK_Aux_Pragma (Node33)
-- Contract (Node34)
-- Anonymous_Master (Node36) (non-generic case only)
-- Delay_Subprogram_Descriptors (Flag50)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
......@@ -6058,7 +6058,6 @@ package Einfo is
-- Elaborate_Body_Desirable (Flag210) (non-generic case only)
-- From_Limited_With (Flag159)
-- Has_All_Calls_Remote (Flag79)
-- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Forward_Instantiation (Flag175)
-- Has_Master_Entity (Flag21)
......@@ -6089,7 +6088,6 @@ package Einfo is
-- Contract (Node34)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Delay_Subprogram_Descriptors (Flag50)
-- Has_Anonymous_Master (Flag253)
-- SPARK_Aux_Pragma_Inherited (Flag266)
-- SPARK_Pragma_Inherited (Flag265)
-- Scope_Depth (synth)
......@@ -6139,6 +6137,7 @@ package Einfo is
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Import_Pragma (Node35) (non-generic case only)
-- Anonymous_Master (Node36) (non-generic case only)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Delay_Cleanups (Flag114)
......@@ -6148,7 +6147,6 @@ package Einfo is
-- Delay_Cleanups (Flag114)
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
-- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
-- Has_Expanded_Contract (Flag240) (non-generic case only)
-- Has_Invariants (Flag232)
......@@ -6647,6 +6645,7 @@ 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 Associated_Entity (Id : E) return E;
function Associated_Formal_Package (Id : E) return E;
function Associated_Node_For_Itype (Id : E) return N;
......@@ -6750,7 +6749,6 @@ package Einfo is
function Has_Aliased_Components (Id : E) return B;
function Has_Alignment_Clause (Id : E) return B;
function Has_All_Calls_Remote (Id : E) return B;
function Has_Anonymous_Master (Id : E) return B;
function Has_Atomic_Components (Id : E) return B;
function Has_Biased_Representation (Id : E) return B;
function Has_Completion (Id : E) return B;
......@@ -7301,6 +7299,7 @@ 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_Associated_Entity (Id : E; V : E);
procedure Set_Associated_Formal_Package (Id : E; V : E);
procedure Set_Associated_Node_For_Itype (Id : E; V : N);
......@@ -7403,7 +7402,6 @@ package Einfo is
procedure Set_Has_Aliased_Components (Id : E; V : B := True);
procedure Set_Has_Alignment_Clause (Id : E; V : B := True);
procedure Set_Has_All_Calls_Remote (Id : E; V : B := True);
procedure Set_Has_Anonymous_Master (Id : E; V : B := True);
procedure Set_Has_Atomic_Components (Id : E; V : B := True);
procedure Set_Has_Biased_Representation (Id : E; V : B := True);
procedure Set_Has_Completion (Id : E; V : B := True);
......@@ -8076,6 +8074,7 @@ package Einfo is
pragma Inline (Address_Taken);
pragma Inline (Alias);
pragma Inline (Alignment);
pragma Inline (Anonymous_Master);
pragma Inline (Associated_Entity);
pragma Inline (Associated_Formal_Package);
pragma Inline (Associated_Node_For_Itype);
......@@ -8176,7 +8175,6 @@ package Einfo is
pragma Inline (Has_Aliased_Components);
pragma Inline (Has_Alignment_Clause);
pragma Inline (Has_All_Calls_Remote);
pragma Inline (Has_Anonymous_Master);
pragma Inline (Has_Atomic_Components);
pragma Inline (Has_Biased_Representation);
pragma Inline (Has_Completion);
......@@ -8577,6 +8575,7 @@ package Einfo is
pragma Inline (Set_Address_Taken);
pragma Inline (Set_Alias);
pragma Inline (Set_Alignment);
pragma Inline (Set_Anonymous_Master);
pragma Inline (Set_Associated_Entity);
pragma Inline (Set_Associated_Formal_Package);
pragma Inline (Set_Associated_Node_For_Itype);
......@@ -8675,7 +8674,6 @@ package Einfo is
pragma Inline (Set_Has_Aliased_Components);
pragma Inline (Set_Has_Alignment_Clause);
pragma Inline (Set_Has_All_Calls_Remote);
pragma Inline (Set_Has_Anonymous_Master);
pragma Inline (Set_Has_Atomic_Components);
pragma Inline (Set_Has_Biased_Representation);
pragma Inline (Set_Has_Completion);
......
gcc/ada/exp_ch4.adb
......@@ -415,174 +415,164 @@ package body Exp_Ch4 is
------------------------------
function Current_Anonymous_Master return Entity_Id is
Decls : List_Id;
Loc : Source_Ptr;
Subp_Body : Node_Id;
Unit_Decl : Node_Id;
Unit_Id : Entity_Id;
function Create_Anonymous_Master
(Unit_Id : Entity_Id;
Decls : List_Id) return Entity_Id;
-- Create a new anonymous finalization master for a unit denoted by
-- Unit_Id. The declaration of the master along with any specialized
-- initialization is inserted at the top of declarative list Decls.
-- Return the entity of the anonymous master.
begin
Unit_Id := Cunit_Entity (Current_Sem_Unit);
-----------------------------
-- Create_Anonymous_Master --
-----------------------------
-- Find the entity of the current unit
function Create_Anonymous_Master
(Unit_Id : Entity_Id;
Decls : List_Id) return Entity_Id
is
First_Decl : Node_Id := Empty;
-- The first declaration of list Decls. This variable is used when
-- inserting various actions.
if Ekind (Unit_Id) = E_Subprogram_Body then
procedure Insert_And_Analyze (Action : Node_Id);
-- Insert arbitrary node Action in declarative list Decl and analyze
-- it.
-- When processing subprogram bodies, the proper scope is always that
-- of the spec.
------------------------
-- Insert_And_Analyze --
------------------------
Subp_Body := Unit_Id;
while Present (Subp_Body)
and then Nkind (Subp_Body) /= N_Subprogram_Body
loop
Subp_Body := Parent (Subp_Body);
end loop;
procedure Insert_And_Analyze (Action : Node_Id) is
begin
-- The list is already populated, the actions are inserted at the
-- top of the list, preserving their order.
Unit_Id := Corresponding_Spec (Subp_Body);
end if;
if Present (First_Decl) then
Insert_Before_And_Analyze (First_Decl, Action);
Loc := Sloc (Unit_Id);
Unit_Decl := Unit (Cunit (Current_Sem_Unit));
-- Otherwise append to the declarations to preserve order
-- Find the declarations list of the current unit
else
Append_To (Decls, Action);
Analyze (Action);
end if;
end Insert_And_Analyze;
if Nkind (Unit_Decl) = N_Package_Declaration then
Unit_Decl := Specification (Unit_Decl);
Decls := Visible_Declarations (Unit_Decl);
-- Local variables
if No (Decls) then
Decls := New_List (Make_Null_Statement (Loc));
Set_Visible_Declarations (Unit_Decl, Decls);
Loc : constant Source_Ptr := Sloc (Unit_Id);
FM_Id : Entity_Id;
elsif Is_Empty_List (Decls) then
Append_To (Decls, Make_Null_Statement (Loc));
end if;
-- Start of processing for Create_Anonymous_Master
else
Decls := Declarations (Unit_Decl);
if No (Decls) then
Decls := New_List (Make_Null_Statement (Loc));
Set_Declarations (Unit_Decl, Decls);
elsif Is_Empty_List (Decls) then
Append_To (Decls, Make_Null_Statement (Loc));
begin
if Present (Decls) then
First_Decl := First (Decls);
end if;
end if;
-- The current unit has an existing anonymous master, traverse its
-- declarations and locate the entity.
if Has_Anonymous_Master (Unit_Id) then
declare
Decl : Node_Id;
Fin_Mas_Id : Entity_Id;
begin
Decl := First (Decls);
while Present (Decl) loop
-- Look for the first variable in the declarations whole type
-- is Finalization_Master.
if Nkind (Decl) = N_Object_Declaration then
Fin_Mas_Id := Defining_Identifier (Decl);
if Ekind (Fin_Mas_Id) = E_Variable
and then Etype (Fin_Mas_Id) = RTE (RE_Finalization_Master)
then
return Fin_Mas_Id;
end if;
end if;
-- Since the anonymous master and all its initialization actions are
-- inserted at top level, use the scope of the unit when analyzing.
Next (Decl);
end loop;
Push_Scope (Unit_Id);
-- The master was not found even though the unit was labeled as
-- having one.
-- Create the anonymous master
raise Program_Error;
end;
FM_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Unit_Id), "AM"));
Set_Anonymous_Master (Unit_Id, FM_Id);
-- Create a new anonymous master
-- Generate:
-- <FM_Id> : Finalization_Master;
else
declare
First_Decl : constant Node_Id := First (Decls);
Action : Node_Id;
Fin_Mas_Id : Entity_Id;
Insert_And_Analyze
(Make_Object_Declaration (Loc,
Defining_Identifier => FM_Id,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
begin
-- Since the master and its associated initialization is inserted
-- at top level, use the scope of the unit when analyzing.
-- Do not set the base pool and mode of operation on .NET/JVM since
-- those targets do not support pools and all VM masters defaulted to
-- heterogeneous.
Push_Scope (Unit_Id);
if VM_Target = No_VM then
-- Create the finalization master
-- Generate:
-- Set_Base_Pool
-- (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
Fin_Mas_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Unit_Id), "AM"));
Insert_And_Analyze
(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))));
-- Generate:
-- <Fin_Mas_Id> : Finalization_Master;
-- Set_Is_Heterogeneous (<FM_Id>);
Action :=
Make_Object_Declaration (Loc,
Defining_Identifier => Fin_Mas_Id,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
Insert_Before_And_Analyze (First_Decl, Action);
Insert_And_Analyze
(Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (FM_Id, Loc))));
end if;
-- Mark the unit to prevent the generation of multiple masters
Pop_Scope;
Set_Has_Anonymous_Master (Unit_Id);
return FM_Id;
end Create_Anonymous_Master;
-- Do not set the base pool and mode of operation on .NET/JVM
-- since those targets do not support pools and all VM masters
-- are heterogeneous by default.
-- Local declarations
if VM_Target = No_VM then
Unit_Decl : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
Unit_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl);
Decls : List_Id;
FM_Id : Entity_Id;
Unit_Spec : Node_Id;
-- Generate:
-- Set_Base_Pool
-- (<Fin_Mas_Id>, Global_Pool_Object'Unrestricted_Access);
-- Start of processing for Current_Anonymous_Master
Action :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
begin
FM_Id := Anonymous_Master (Unit_Id);
Parameter_Associations => New_List (
New_Occurrence_Of (Fin_Mas_Id, Loc),
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
Attribute_Name => Name_Unrestricted_Access)));
-- Create a new anonymous master when allocating an object of anonymous
-- access-to-controlled type for the first time.
Insert_Before_And_Analyze (First_Decl, Action);
if No (FM_Id) then
-- Generate:
-- Set_Is_Heterogeneous (<Fin_Mas_Id>);
-- Find the declarative list of the current unit
Action :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Fin_Mas_Id, Loc)));
if Nkind (Unit_Decl) = N_Package_Declaration then
Unit_Spec := Specification (Unit_Decl);
Decls := Visible_Declarations (Unit_Spec);
Insert_Before_And_Analyze (First_Decl, Action);
if No (Decls) then
Decls := New_List;
Set_Visible_Declarations (Unit_Spec, Decls);
end if;
-- Restore the original state of the scope stack
-- Package or subprogram body
Pop_Scope;
else
Decls := Declarations (Unit_Decl);
return Fin_Mas_Id;
end;
if No (Decls) then
Decls := New_List;
Set_Declarations (Unit_Decl, Decls);
end if;
end if;
FM_Id := Create_Anonymous_Master (Unit_Id, Decls);
end if;
return FM_Id;
end Current_Anonymous_Master;
--------------------------------
......
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