* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@241049
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
-- Relative_Deadline_Variable Node28
-- Underlying_Record_View Node28
+ -- Anonymous_Masters Elist29
-- BIP_Initialization_Call Node29
-- Subprograms_For_Type Elist29
-- Contract Node34
- -- Anonymous_Master Node35
+ -- Anonymous_Designated_Type Node35
-- Import_Pragma Node35
-- Class_Wide_Preconds List38
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
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
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");
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");
-- 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
-- Derived_Type_Link (Node31)
-- No_Tagged_Streams_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
- -- Anonymous_Master (Node35)
-- Depends_On_Private (Flag14)
-- Disable_Controlled (Flag253)
-- 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)
-- 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)
-- 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)
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
-- Extra_Formals (Node28)
+ -- Anonymous_Masters (Elist29)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Encapsulating_State (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
+ -- Anonymous_Designated_Type (Node35)
-- SPARK_Pragma (Node40)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
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;
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);
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);
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);
(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 --
Unit_Id : Entity_Id;
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);
+ Loc : constant Source_Ptr := Sloc (Unit_Id);
+
+ 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
-- 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);
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;
- end if;
+ if Present (All_FMs) then
+ FM_Elmt := First_Elmt (All_FMs);
+ while Present (FM_Elmt) loop
+ FM_Id := Node (FM_Elmt);
- Par := Parent (Par);
- end loop;
+ -- 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.
- return False;
- end In_Subtree;
+ if Anonymous_Designated_Type (FM_Id) = Desig_Typ then
+ return FM_Id;
+ end if;
+
+ Next_Elmt (FM_Elmt);
+ end loop;
+ end if;
+
+ return Empty;
+ end Current_Anonymous_Master;
-- Local variables
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
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;
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;
-- 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)));
-- 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;
projects / thirdparty / gcc.git / commitdiff
