Skip to content

R
riscv-gcc-1
Commit 3ff38f33 by Javier Miranda Committed by Arnaud Charlet
Options

sem_ch3.ads, [...] (Add_Internal_Interface_Entities): Routine moved from the… 

sem_ch3.ads, [...] (Add_Internal_Interface_Entities): Routine moved from the expander to the semantic analyzer to allow the...

2009-07-29  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.ads, sem_ch3.adb (Add_Internal_Interface_Entities): Routine
	moved from the expander to the semantic analyzer to allow the
	generation of these internal entities when compiling with no code
	generation. Required by ASIS.
	* sem.adb (Analyze): Add processing for N_Freeze_Entity nodes.
	* sem_ch13.ads, sem_ch13.adb (Analyze_Freeze_Entity): New subprogram.
	* exp_ch3.adb (Add_Internal_Interface_Entities): Moved to sem_ch3
	(Expand_Freeze_Record_Type): Remove call to
	Add_Internal_Interface_Entities because this routine is now called at
	early stage --when the freezing node is analyzed.

From-SVN: r150205
parent a73734f5
Showing with 140 additions and 112 deletions
gcc/ada/ChangeLog
2009-07-29 Javier Miranda <miranda@adacore.com>
* sem_ch3.ads, sem_ch3.adb (Add_Internal_Interface_Entities): Routine
moved from the expander to the semantic analyzer to allow the
generation of these internal entities when compiling with no code
generation. Required by ASIS.
* sem.adb (Analyze): Add processing for N_Freeze_Entity nodes.
* sem_ch13.ads, sem_ch13.adb (Analyze_Freeze_Entity): New subprogram.
* exp_ch3.adb (Add_Internal_Interface_Entities): Moved to sem_ch3
(Expand_Freeze_Record_Type): Remove call to
Add_Internal_Interface_Entities because this routine is now called at
early stage --when the freezing node is analyzed.
2009-07-29 Robert Dewar <dewar@adacore.com>
* exp_atag.ads, exp_atag.adb, s-tasini.adb, s-soflin.ads,
......
gcc/ada/exp_ch3.adb
......@@ -5617,105 +5617,6 @@ package body Exp_Ch3 is
-------------------------------
procedure Expand_Freeze_Record_Type (N : Node_Id) is
procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id);
-- Add to the list of primitives of Tagged_Types the internal entities
-- associated with interface primitives that are located in secondary
-- dispatch tables.
-------------------------------------
-- Add_Internal_Interface_Entities --
-------------------------------------
procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id) is
Elmt : Elmt_Id;
Iface : Entity_Id;
Iface_Elmt : Elmt_Id;
Iface_Prim : Entity_Id;
Ifaces_List : Elist_Id;
New_Subp : Entity_Id := Empty;
Prim : Entity_Id;
begin
pragma Assert (Ada_Version >= Ada_05
and then Is_Record_Type (Tagged_Type)
and then Is_Tagged_Type (Tagged_Type)
and then Has_Interfaces (Tagged_Type)
and then not Is_Interface (Tagged_Type));
Collect_Interfaces (Tagged_Type, Ifaces_List);
Iface_Elmt := First_Elmt (Ifaces_List);
while Present (Iface_Elmt) loop
Iface := Node (Iface_Elmt);
-- Exclude from this processing interfaces that are parents
-- of Tagged_Type because their primitives are located in the
-- primary dispatch table (and hence no auxiliary internal
-- entities are required to handle secondary dispatch tables
-- in such case).
if not Is_Ancestor (Iface, Tagged_Type) then
Elmt := First_Elmt (Primitive_Operations (Iface));
while Present (Elmt) loop
Iface_Prim := Node (Elmt);
if not Is_Predefined_Dispatching_Operation (Iface_Prim) then
Prim :=
Find_Primitive_Covering_Interface
(Tagged_Type => Tagged_Type,
Iface_Prim => Iface_Prim);
pragma Assert (Present (Prim));
Derive_Subprogram
(New_Subp => New_Subp,
Parent_Subp => Iface_Prim,
Derived_Type => Tagged_Type,
Parent_Type => Iface);
-- Ada 2005 (AI-251): Decorate internal entity Iface_Subp
-- associated with interface types. These entities are
-- only registered in the list of primitives of its
-- corresponding tagged type because they are only used
-- to fill the contents of the secondary dispatch tables.
-- Therefore they are removed from the homonym chains.
Set_Is_Hidden (New_Subp);
Set_Is_Internal (New_Subp);
Set_Alias (New_Subp, Prim);
Set_Is_Abstract_Subprogram (New_Subp,
Is_Abstract_Subprogram (Prim));
Set_Interface_Alias (New_Subp, Iface_Prim);
-- Internal entities associated with interface types are
-- only registered in the list of primitives of the
-- tagged type. They are only used to fill the contents
-- of the secondary dispatch tables. Therefore they are
-- not needed in the homonym chains.
Remove_Homonym (New_Subp);
-- Hidden entities associated with interfaces must have
-- set the Has_Delay_Freeze attribute to ensure that, in
-- case of locally defined tagged types (or compiling
-- with static dispatch tables generation disabled) the
-- corresponding entry of the secondary dispatch table is
-- filled when such entity is frozen.
Set_Has_Delayed_Freeze (New_Subp);
end if;
Next_Elmt (Elmt);
end loop;
end if;
Next_Elmt (Iface_Elmt);
end loop;
end Add_Internal_Interface_Entities;
-- Local variables
Def_Id : constant Node_Id := Entity (N);
Type_Decl : constant Node_Id := Parent (Def_Id);
Comp : Entity_Id;
......@@ -5948,17 +5849,6 @@ package body Exp_Ch3 is
Insert_Actions (N, Null_Proc_Decl_List);
end if;
-- Ada 2005 (AI-251): Add internal entities associated with
-- secondary dispatch tables to the list of primitives of tagged
-- types that are not interfaces
if Ada_Version >= Ada_05
and then not Is_Interface (Def_Id)
and then Has_Interfaces (Def_Id)
then
Add_Internal_Interface_Entities (Def_Id);
end if;
Set_Is_Frozen (Def_Id);
Set_All_DT_Position (Def_Id);
......
gcc/ada/sem.adb
......@@ -243,7 +243,7 @@ package body Sem is
Analyze_Free_Statement (N);
when N_Freeze_Entity =>
null; -- no semantic processing required
Analyze_Freeze_Entity (N);
when N_Full_Type_Declaration =>
Analyze_Type_Declaration (N);
......
gcc/ada/sem_ch13.adb
......@@ -40,6 +40,7 @@ with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
......@@ -2197,6 +2198,33 @@ package body Sem_Ch13 is
Analyze (Expression (N));
end Analyze_Free_Statement;
---------------------------
-- Analyze_Freeze_Entity --
---------------------------
procedure Analyze_Freeze_Entity (N : Node_Id) is
E : constant Entity_Id := Entity (N);
begin
-- For tagged types covering interfaces add internal entities that link
-- the primitives of the interfaces with the primitives that cover them.
-- Note: These entities were originally generated only when generating
-- code because their main purpose was to provide support to initialize
-- the secondary dispatch tables. They are now generated also when
-- compiling with no code generation to provide ASIS the relationship
-- between interface primitives and tagged type primitives.
if Ada_Version >= Ada_05
and then Ekind (E) = E_Record_Type
and then Is_Tagged_Type (E)
and then not Is_Interface (E)
and then Has_Interfaces (E)
then
Add_Internal_Interface_Entities (E);
end if;
end Analyze_Freeze_Entity;
------------------------------------------
-- Analyze_Record_Representation_Clause --
------------------------------------------
......
gcc/ada/sem_ch13.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
......@@ -31,6 +31,7 @@ package Sem_Ch13 is
procedure Analyze_Attribute_Definition_Clause (N : Node_Id);
procedure Analyze_Enumeration_Representation_Clause (N : Node_Id);
procedure Analyze_Free_Statement (N : Node_Id);
procedure Analyze_Freeze_Entity (N : Node_Id);
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
......
gcc/ada/sem_ch3.adb
......@@ -1506,6 +1506,97 @@ package body Sem_Ch3 is
end if;
end Add_Interface_Tag_Components;
-------------------------------------
-- Add_Internal_Interface_Entities --
-------------------------------------
procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id) is
Elmt : Elmt_Id;
Iface : Entity_Id;
Iface_Elmt : Elmt_Id;
Iface_Prim : Entity_Id;
Ifaces_List : Elist_Id;
New_Subp : Entity_Id := Empty;
Prim : Entity_Id;
begin
pragma Assert (Ada_Version >= Ada_05
and then Is_Record_Type (Tagged_Type)
and then Is_Tagged_Type (Tagged_Type)
and then Has_Interfaces (Tagged_Type)
and then not Is_Interface (Tagged_Type));
Collect_Interfaces (Tagged_Type, Ifaces_List);
Iface_Elmt := First_Elmt (Ifaces_List);
while Present (Iface_Elmt) loop
Iface := Node (Iface_Elmt);
-- Exclude from this processing interfaces that are parents
-- of Tagged_Type because their primitives are located in the
-- primary dispatch table (and hence no auxiliary internal
-- entities are required to handle secondary dispatch tables
-- in such case).
if not Is_Ancestor (Iface, Tagged_Type) then
Elmt := First_Elmt (Primitive_Operations (Iface));
while Present (Elmt) loop
Iface_Prim := Node (Elmt);
if not Is_Predefined_Dispatching_Operation (Iface_Prim) then
Prim :=
Find_Primitive_Covering_Interface
(Tagged_Type => Tagged_Type,
Iface_Prim => Iface_Prim);
pragma Assert (Present (Prim));
Derive_Subprogram
(New_Subp => New_Subp,
Parent_Subp => Iface_Prim,
Derived_Type => Tagged_Type,
Parent_Type => Iface);
-- Ada 2005 (AI-251): Decorate internal entity Iface_Subp
-- associated with interface types. These entities are
-- only registered in the list of primitives of its
-- corresponding tagged type because they are only used
-- to fill the contents of the secondary dispatch tables.
-- Therefore they are removed from the homonym chains.
Set_Is_Hidden (New_Subp);
Set_Is_Internal (New_Subp);
Set_Alias (New_Subp, Prim);
Set_Is_Abstract_Subprogram (New_Subp,
Is_Abstract_Subprogram (Prim));
Set_Interface_Alias (New_Subp, Iface_Prim);
-- Internal entities associated with interface types are
-- only registered in the list of primitives of the
-- tagged type. They are only used to fill the contents
-- of the secondary dispatch tables. Therefore they are
-- not needed in the homonym chains.
Remove_Homonym (New_Subp);
-- Hidden entities associated with interfaces must have
-- set the Has_Delay_Freeze attribute to ensure that, in
-- case of locally defined tagged types (or compiling
-- with static dispatch tables generation disabled) the
-- corresponding entry of the secondary dispatch table is
-- filled when such entity is frozen.
Set_Has_Delayed_Freeze (New_Subp);
end if;
Next_Elmt (Elmt);
end loop;
end if;
Next_Elmt (Iface_Elmt);
end loop;
end Add_Internal_Interface_Entities;
-----------------------------------
-- Analyze_Component_Declaration --
-----------------------------------
......
gcc/ada/sem_ch3.ads
......@@ -64,6 +64,11 @@ package Sem_Ch3 is
-- the signature of the implicit type works like the profile of a regular
-- subprogram.
procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id);
-- Add to the list of primitives of Tagged_Type the internal entities
-- associated with covered interface primitives. These entities link the
-- interface primitives with the tagged type primitives that cover them.
procedure Analyze_Declarations (L : List_Id);
-- Called to analyze a list of declarations (in what context ???). Also
-- performs necessary freezing actions (more description needed ???)
......
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