summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-02 14:41:13 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-02 14:41:13 +0000
commit87d6f1a47daa6fc5d56bcf76f6d6d7e3e6c08294 (patch)
treeda702c5ed32a3bb7f2b98f32918a110fe1e52652 /gcc
parent4a473cb984ee38140d0b05541e95a90f6507c95b (diff)
downloadgcc-87d6f1a47daa6fc5d56bcf76f6d6d7e3e6c08294.tar.gz
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_disp.ads (Build_VM_TSDs): Build the runtime Type Specific Data record of all the tagged types declared inside library level package declarations, library level package bodies or library level subprograms. * exp_disp.adb (Make_VM_TSD): New subprogram that builds the TSD associated with a given tagged type. (Build_VM_TSDs): New subprogram. * exp_ch6.adb (Expand_N_Subprogram_Body): Generate TSDs records of main compilation units that are subprograms. * exp_ch7.adb (Expand_N_Package_Body): Generate TSDs of main compilation units that are package bodies. (Expand_N_Package_Declaration): Generate TSDs of the main compilation units that are a package declaration or a package instantiation. * exp_intr.adb (Expand_Dispatching_Constructor_Call): Minor code reorganization to improve the error generated by the frontend when the function Ada.Tags.Secondary_Tag is not available. * rtsfind.ads (RE_Register_TSD): New runtime entity. * exp_ch4.adb (Expand_N_Type_Conversion): Minor code cleanup. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177163 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog20
-rw-r--r--gcc/ada/exp_ch4.adb11
-rw-r--r--gcc/ada/exp_ch6.adb10
-rw-r--r--gcc/ada/exp_ch7.adb36
-rw-r--r--gcc/ada/exp_disp.adb404
-rw-r--r--gcc/ada/exp_disp.ads5
-rw-r--r--gcc/ada/exp_intr.adb44
-rw-r--r--gcc/ada/rtsfind.ads2
8 files changed, 509 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 61efaa8bdb0..e401f48668d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,25 @@
2011-08-02 Javier Miranda <miranda@adacore.com>
+ * exp_disp.ads (Build_VM_TSDs): Build the runtime Type Specific Data
+ record of all the tagged types declared inside library level package
+ declarations, library level package bodies or library level subprograms.
+ * exp_disp.adb (Make_VM_TSD): New subprogram that builds the TSD
+ associated with a given tagged type.
+ (Build_VM_TSDs): New subprogram.
+ * exp_ch6.adb (Expand_N_Subprogram_Body): Generate TSDs records of main
+ compilation units that are subprograms.
+ * exp_ch7.adb (Expand_N_Package_Body): Generate TSDs of main
+ compilation units that are package bodies.
+ (Expand_N_Package_Declaration): Generate TSDs of the main compilation
+ units that are a package declaration or a package instantiation.
+ * exp_intr.adb (Expand_Dispatching_Constructor_Call): Minor code
+ reorganization to improve the error generated by the frontend when the
+ function Ada.Tags.Secondary_Tag is not available.
+ * rtsfind.ads (RE_Register_TSD): New runtime entity.
+ * exp_ch4.adb (Expand_N_Type_Conversion): Minor code cleanup.
+
+2011-08-02 Javier Miranda <miranda@adacore.com>
+
* exp_disp.adb (Make_DT): Generate call to Check_TSD in Ada 2005 mode.
2011-08-02 Robert Dewar <dewar@adacore.com>
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e92e1062a8e..ebf1a381aaa 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8606,16 +8606,19 @@ package body Exp_Ch4 is
-- Start of processing for Tagged_Conversion
begin
- if Is_Access_Type (Target_Type) then
-
- -- Handle entities from the limited view
+ -- Handle entities from the limited view
+ if Is_Access_Type (Operand_Type) then
Actual_Op_Typ :=
Available_View (Designated_Type (Operand_Type));
+ else
+ Actual_Op_Typ := Operand_Type;
+ end if;
+
+ if Is_Access_Type (Target_Type) then
Actual_Targ_Typ :=
Available_View (Designated_Type (Target_Type));
else
- Actual_Op_Typ := Operand_Type;
Actual_Targ_Typ := Target_Type;
end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 0d2c12c147a..aa8775c3dbf 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5121,6 +5121,16 @@ package body Exp_Ch6 is
-- Start of processing for Expand_N_Subprogram_Body
begin
+ -- If this is the main compilation unit and we are generating code for
+ -- VM targets we generate now the Type Specific Data record of all the
+ -- enclosing tagged type declarations
+
+ if not Tagged_Type_Expansion
+ and then Unit (Cunit (Main_Unit)) = N
+ then
+ Build_VM_TSDs (N);
+ end if;
+
-- Set L to either the list of declarations if present, or to the list
-- of statements if no declarations are present. This is used to insert
-- new stuff at the start.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 4d64b84b2a7..d52740a659b 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1553,7 +1553,15 @@ package body Exp_Ch7 is
-- Build dispatch tables of library level tagged types
if Is_Library_Level_Entity (Ent) then
- Build_Static_Dispatch_Tables (N);
+ if Tagged_Type_Expansion then
+ Build_Static_Dispatch_Tables (N);
+
+ -- In VM targets there is no need to build dispatch tables but
+ -- we must generate the corresponding Type Specific Data record
+
+ elsif Unit (Cunit (Main_Unit)) = N then
+ Build_VM_TSDs (N);
+ end if;
end if;
Build_Task_Activation_Call (N);
@@ -1654,7 +1662,31 @@ package body Exp_Ch7 is
or else (Is_Generic_Instance (Id)
and then Is_Library_Level_Entity (Id))
then
- Build_Static_Dispatch_Tables (N);
+ if Tagged_Type_Expansion then
+ Build_Static_Dispatch_Tables (N);
+
+ -- In VM targets there is no need to build dispatch tables but
+ -- we must generate the corresponding Type Specific Data record
+
+ elsif Unit (Cunit (Main_Unit)) = N then
+
+ -- Enter the scope of the package because the new declarations
+ -- are appended at the end of the package and must be analyzed
+ -- in that context.
+
+ Push_Scope (Id);
+
+ if Is_Generic_Instance (Main_Unit_Entity) then
+ if Package_Instantiation (Main_Unit_Entity) = N then
+ Build_VM_TSDs (N);
+ end if;
+
+ else
+ Build_VM_TSDs (N);
+ end if;
+
+ Pop_Scope;
+ end if;
end if;
-- Note: it is not necessary to worry about generating a subprogram
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 541abe7b6aa..88f4b80b11d 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -83,6 +83,10 @@ package body Exp_Disp is
-- Returns true if Prim is not a predefined dispatching primitive but it is
-- an alias of a predefined dispatching primitive (i.e. through a renaming)
+ function Make_VM_TSD (Typ : Entity_Id) return List_Id;
+ -- Build the Type Specific Data record associated with tagged type Typ.
+ -- Invoked only when generating code for VM targets.
+
function New_Value (From : Node_Id) return Node_Id;
-- From is the original Expression. New_Value is equivalent to a call
-- to Duplicate_Subexpr with an explicit dereference when From is an
@@ -465,6 +469,140 @@ package body Exp_Disp is
end if;
end Build_Static_Dispatch_Tables;
+ -------------------
+ -- Build_VM_TSDs --
+ -------------------
+
+ procedure Build_VM_TSDs (N : Entity_Id) is
+ Target_List : List_Id;
+
+ procedure Build_TSDs (List : List_Id);
+ -- Build the static dispatch table of tagged types found in the list of
+ -- declarations. The generated nodes are added at the end of Target_List
+
+ procedure Build_Package_TSDs (N : Node_Id);
+ -- Build static dispatch tables associated with package declaration N
+
+ ---------------------------
+ -- Build_Dispatch_Tables --
+ ---------------------------
+
+ procedure Build_TSDs (List : List_Id) is
+ D : Node_Id;
+
+ begin
+ D := First (List);
+ while Present (D) loop
+
+ -- Handle nested packages and package bodies recursively. The
+ -- generated code is placed on the Target_List established for
+ -- the enclosing compilation unit.
+
+ if Nkind (D) = N_Package_Declaration then
+ Build_Package_TSDs (D);
+
+ elsif Nkind_In (D, N_Package_Body,
+ N_Subprogram_Body)
+ then
+ Build_TSDs (Declarations (D));
+
+ elsif Nkind (D) = N_Package_Body_Stub
+ and then Present (Library_Unit (D))
+ then
+ Build_TSDs
+ (Declarations (Proper_Body (Unit (Library_Unit (D)))));
+
+ -- Handle full type declarations and derivations of library
+ -- level tagged types
+
+ elsif Nkind_In (D, N_Full_Type_Declaration,
+ N_Derived_Type_Definition)
+ and then Ekind (Defining_Entity (D)) /= E_Record_Subtype
+ and then Is_Tagged_Type (Defining_Entity (D))
+ and then not Is_Private_Type (Defining_Entity (D))
+ then
+ -- Do not generate TSDs for the internal types created for
+ -- a type extension with unknown discriminants. The needed
+ -- information is shared with the source type.
+ -- See Expand_N_Record_Extension.
+
+ if Is_Underlying_Record_View (Defining_Entity (D))
+ or else
+ (not Comes_From_Source (Defining_Entity (D))
+ and then
+ Has_Unknown_Discriminants (Etype (Defining_Entity (D)))
+ and then
+ not Comes_From_Source
+ (First_Subtype (Defining_Entity (D))))
+ then
+ null;
+
+ else
+ Append_List_To (Target_List,
+ Make_VM_TSD (Defining_Entity (D)));
+ end if;
+ end if;
+
+ Next (D);
+ end loop;
+ end Build_TSDs;
+
+ ------------------------
+ -- Build_Package_TSDs --
+ ------------------------
+
+ procedure Build_Package_TSDs (N : Node_Id) is
+ Spec : constant Node_Id := Specification (N);
+ Vis_Decls : constant List_Id := Visible_Declarations (Spec);
+ Priv_Decls : constant List_Id := Private_Declarations (Spec);
+
+ begin
+ if Present (Priv_Decls) then
+ Build_TSDs (Vis_Decls);
+ Build_TSDs (Priv_Decls);
+
+ elsif Present (Vis_Decls) then
+ Build_TSDs (Vis_Decls);
+ end if;
+ end Build_Package_TSDs;
+
+ -- Start of processing for Build_VM_TSDs
+
+ begin
+ if not Expander_Active or else No_Run_Time_Mode then
+ return;
+ end if;
+
+ if Nkind (N) = N_Package_Declaration then
+ declare
+ Spec : constant Node_Id := Specification (N);
+ Vis_Decls : constant List_Id := Visible_Declarations (Spec);
+ Priv_Decls : constant List_Id := Private_Declarations (Spec);
+
+ begin
+ Target_List := New_List;
+ Build_Package_TSDs (N);
+ Analyze_List (Target_List);
+
+ if Present (Priv_Decls)
+ and then Is_Non_Empty_List (Priv_Decls)
+ then
+ Append_List (Target_List, Priv_Decls);
+ else
+ Append_List (Target_List, Vis_Decls);
+ end if;
+ end;
+
+ elsif Nkind_In (N, N_Package_Body, N_Subprogram_Body) then
+ if Is_Non_Empty_List (Declarations (N)) then
+ Target_List := New_List;
+ Build_TSDs (Declarations (N));
+ Analyze_List (Target_List);
+ Append_List (Target_List, Declarations (N));
+ end if;
+ end if;
+ end Build_VM_TSDs;
+
------------------------------
-- Convert_Tag_To_Interface --
------------------------------
@@ -6109,6 +6247,272 @@ package body Exp_Disp is
return Result;
end Make_DT;
+ -----------------
+ -- Make_VM_TSD --
+ -----------------
+
+ function Make_VM_TSD (Typ : Entity_Id) return List_Id is
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Result : constant List_Id := New_List;
+ AI : Elmt_Id;
+ I_Depth : Nat := 0;
+ Iface_Table_Node : Node_Id;
+ Num_Ifaces : Nat := 0;
+ TSD_Aggr_List : List_Id;
+ Typ_Ifaces : Elist_Id;
+ TSD_Tags_List : List_Id;
+
+ Tname : constant Name_Id := Chars (Typ);
+ Name_TSD : constant Name_Id :=
+ New_External_Name (Tname, 'B', Suffix_Index => -1);
+ TSD : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, Name_TSD);
+ begin
+ -- Generate code to create the storage for the type specific data object
+ -- with enough space to store the tags of the ancestors plus the tags
+ -- of all the implemented interfaces (as described in a-tags.ads).
+
+ -- TSD : Type_Specific_Data (I_Depth) :=
+ -- (Idepth => I_Depth,
+ -- T => T'Tag,
+ -- Access_Level => Type_Access_Level (Typ),
+ -- HT_Link => null,
+ -- Type_Is_Abstract => <<boolean-value>>,
+ -- Type_Is_Library_Level => <<boolean-value>>,
+ -- Interfaces_Table => <<access-value>>
+ -- Tags_Table => (0 => Typ'Tag,
+ -- 1 => Parent'Tag
+ -- ...));
+
+ TSD_Aggr_List := New_List;
+
+ -- Idepth: Count ancestors to compute the inheritance depth. For private
+ -- extensions, always go to the full view in order to compute the real
+ -- inheritance depth.
+
+ declare
+ Current_Typ : Entity_Id;
+ Parent_Typ : Entity_Id;
+
+ begin
+ I_Depth := 0;
+ Current_Typ := Typ;
+ loop
+ Parent_Typ := Etype (Current_Typ);
+
+ if Is_Private_Type (Parent_Typ) then
+ Parent_Typ := Full_View (Base_Type (Parent_Typ));
+ end if;
+
+ exit when Parent_Typ = Current_Typ;
+
+ I_Depth := I_Depth + 1;
+ Current_Typ := Parent_Typ;
+ end loop;
+ end;
+
+ Append_To (TSD_Aggr_List,
+ Make_Integer_Literal (Loc, I_Depth));
+
+ -- Access_Level
+
+ Append_To (TSD_Aggr_List,
+ Make_Integer_Literal (Loc, Type_Access_Level (Typ)));
+
+ -- HT_Link
+
+ Append_To (TSD_Aggr_List,
+ Make_Null (Loc));
+
+ -- Type_Is_Abstract (Ada 2012: AI05-0173)
+
+ declare
+ Type_Is_Abstract : Entity_Id;
+
+ begin
+ Type_Is_Abstract :=
+ Boolean_Literals (Is_Abstract_Type (Typ));
+
+ Append_To (TSD_Aggr_List,
+ New_Occurrence_Of (Type_Is_Abstract, Loc));
+ end;
+
+ -- Type_Is_Library_Level
+
+ declare
+ Type_Is_Library_Level : Entity_Id;
+
+ begin
+ Type_Is_Library_Level :=
+ Boolean_Literals (Is_Library_Level_Entity (Typ));
+
+ Append_To (TSD_Aggr_List,
+ New_Occurrence_Of (Type_Is_Library_Level, Loc));
+ end;
+
+ -- Interfaces_Table (required for AI-405)
+
+ if RTE_Record_Component_Available (RE_Interfaces_Table) then
+
+ -- Count the number of interface types implemented by Typ
+
+ Collect_Interfaces (Typ, Typ_Ifaces);
+
+ AI := First_Elmt (Typ_Ifaces);
+ while Present (AI) loop
+ Num_Ifaces := Num_Ifaces + 1;
+ Next_Elmt (AI);
+ end loop;
+
+ if Num_Ifaces = 0 then
+ Iface_Table_Node := Make_Null (Loc);
+
+ -- Generate the Interface_Table object
+
+ else
+ declare
+ TSD_Ifaces_List : constant List_Id := New_List;
+ ITable : Node_Id;
+
+ begin
+ AI := First_Elmt (Typ_Ifaces);
+ while Present (AI) loop
+ Append_To (TSD_Ifaces_List,
+ Make_Aggregate (Loc,
+ Expressions => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Node (AI), Loc),
+ Attribute_Name => Name_Tag)
+ )));
+
+ Next_Elmt (AI);
+ end loop;
+
+ ITable := Make_Temporary (Loc, 'I');
+
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => ITable,
+ Aliased_Present => True,
+ Constant_Present => True,
+ Object_Definition =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Reference_To (RTE (RE_Interface_Data), Loc),
+ Constraint => Make_Index_Or_Discriminant_Constraint
+ (Loc,
+ Constraints => New_List (
+ Make_Integer_Literal (Loc, Num_Ifaces)))),
+
+ Expression => Make_Aggregate (Loc,
+ Expressions => New_List (
+ Make_Integer_Literal (Loc, Num_Ifaces),
+ Make_Aggregate (Loc,
+ Expressions => TSD_Ifaces_List)))));
+
+ Iface_Table_Node :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (ITable, Loc),
+ Attribute_Name => Name_Unchecked_Access);
+ end;
+ end if;
+
+ Append_To (TSD_Aggr_List, Iface_Table_Node);
+ end if;
+
+ -- Initialize the table of ancestor tags. In case of interface types
+ -- this table is not needed.
+
+ TSD_Tags_List := New_List;
+
+ -- Fill position 0 with Typ'Tag
+
+ Append_To (TSD_Tags_List,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Typ, Loc),
+ Attribute_Name => Name_Tag));
+
+ -- Fill the rest of the table with the tags of the ancestors
+
+ declare
+ Current_Typ : Entity_Id;
+ Parent_Typ : Entity_Id;
+ Pos : Nat;
+
+ begin
+ Pos := 1;
+ Current_Typ := Typ;
+
+ loop
+ Parent_Typ := Etype (Current_Typ);
+
+ if Is_Private_Type (Parent_Typ) then
+ Parent_Typ := Full_View (Base_Type (Parent_Typ));
+ end if;
+
+ exit when Parent_Typ = Current_Typ;
+
+ Append_To (TSD_Tags_List,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Parent_Typ, Loc),
+ Attribute_Name => Name_Tag));
+
+ Pos := Pos + 1;
+ Current_Typ := Parent_Typ;
+ end loop;
+
+ pragma Assert (Pos = I_Depth + 1);
+ end;
+
+ Append_To (TSD_Aggr_List,
+ Make_Aggregate (Loc,
+ Expressions => TSD_Tags_List));
+
+ -- Build the TSD object
+
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => TSD,
+ Aliased_Present => True,
+ Constant_Present => True,
+ Object_Definition =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark => New_Reference_To (
+ RTE (RE_Type_Specific_Data), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc,
+ Constraints => New_List (
+ Make_Integer_Literal (Loc, I_Depth)))),
+
+ Expression => Make_Aggregate (Loc,
+ Expressions => TSD_Aggr_List)));
+
+ -- Generate:
+ -- Check_TSD
+ -- (TSD => TSD'Unrestricted_Access);
+
+ Append_To (Result,
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Reference_To (RTE (RE_Check_TSD), Loc),
+ Parameter_Associations => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (TSD, Loc),
+ Attribute_Name => Name_Unrestricted_Access))));
+
+ -- Generate:
+ -- Register_TSD (TSD'Unrestricted_Access);
+
+ Append_To (Result,
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Reference_To (RTE (RE_Register_TSD), Loc),
+ Parameter_Associations => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (TSD, Loc),
+ Attribute_Name => Name_Unrestricted_Access))));
+
+ return Result;
+ end Make_VM_TSD;
+
-------------------------------------
-- Make_Select_Specific_Data_Table --
-------------------------------------
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index d2dd7760dda..82a9d9abc15 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -186,6 +186,11 @@ package Exp_Disp is
-- bodies they are added to the end of the list of declarations of the
-- package body.
+ procedure Build_VM_TSDs (N : Entity_Id);
+ -- N is a library level package declaration, a library level package body
+ -- or a library level subprogram body. Build the runtime Type Specific
+ -- Data record of all the tagged types declared inside N.
+
function Convert_Tag_To_Interface
(Typ : Entity_Id; Expr : Node_Id) return Node_Id;
pragma Inline (Convert_Tag_To_Interface);
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 4a300b80199..0dfbac1079c 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -234,23 +234,33 @@ package body Exp_Intr is
if not Is_Ancestor (Etype (Result_Typ), Etype (Tag_Arg),
Use_Full_View => True)
then
- pragma Assert (not Is_Interface (Etype (Tag_Arg)));
-
- Iface_Tag :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Make_Temporary (Loc, 'V'),
- Object_Definition =>
- New_Reference_To (RTE (RE_Tag), Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name => New_Reference_To (RTE (RE_Secondary_Tag), Loc),
- Parameter_Associations => New_List (
- Relocate_Node (Tag_Arg),
- New_Reference_To
- (Node (First_Elmt (Access_Disp_Table
- (Etype (Etype (Act_Constr))))),
- Loc))));
- Insert_Action (N, Iface_Tag);
+ -- Obtain the reference to the Ada.Tags service before generating
+ -- the Object_Declaration node to ensure that if this service is
+ -- not available in the runtime then we generate a clear error.
+
+ declare
+ Fname : constant Node_Id :=
+ New_Reference_To (RTE (RE_Secondary_Tag), Loc);
+
+ begin
+ pragma Assert (not Is_Interface (Etype (Tag_Arg)));
+
+ Iface_Tag :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Make_Temporary (Loc, 'V'),
+ Object_Definition =>
+ New_Reference_To (RTE (RE_Tag), Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name => Fname,
+ Parameter_Associations => New_List (
+ Relocate_Node (Tag_Arg),
+ New_Reference_To
+ (Node (First_Elmt (Access_Disp_Table
+ (Etype (Etype (Act_Constr))))),
+ Loc))));
+ Insert_Action (N, Iface_Tag);
+ end;
end if;
end if;
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 06e60660e6e..e4fb3830ae7 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -607,6 +607,7 @@ package Rtsfind is
RE_Type_Specific_Data, -- Ada.Tags
RE_Register_Interface_Offset, -- Ada.Tags
RE_Register_Tag, -- Ada.Tags
+ RE_Register_TSD, -- Ada.Tags
RE_Transportable, -- Ada.Tags
RE_Secondary_DT, -- Ada.Tags
RE_Secondary_Tag, -- Ada.Tags
@@ -1786,6 +1787,7 @@ package Rtsfind is
RE_Type_Specific_Data => Ada_Tags,
RE_Register_Interface_Offset => Ada_Tags,
RE_Register_Tag => Ada_Tags,
+ RE_Register_TSD => Ada_Tags,
RE_Transportable => Ada_Tags,
RE_Secondary_DT => Ada_Tags,
RE_Secondary_Tag => Ada_Tags,