From f44b3c78755e01a9bd7fd9b639a08711b7c52660 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 26 Sep 2016 20:40:24 +0200
Subject: vhdl08: more support for interface subprograms.
---
src/vhdl/canon.adb | 3 +-
src/vhdl/disp_vhdl.adb | 22 +-
src/vhdl/iir_chains.adb | 22 ++
src/vhdl/iir_chains.ads | 5 +
src/vhdl/iirs.adb | 16 ++
src/vhdl/iirs.ads | 9 +
src/vhdl/nodes_meta.adb | 439 +++++++++++++++++++------------------
src/vhdl/nodes_meta.ads | 2 +
src/vhdl/sem.adb | 3 +-
src/vhdl/sem_assocs.adb | 201 ++++++++++++++++-
src/vhdl/sem_decls.adb | 8 +-
src/vhdl/sem_inst.adb | 18 +-
src/vhdl/translate/trans-chap4.adb | 3 +-
src/vhdl/translate/trans-chap5.adb | 3 +-
14 files changed, 520 insertions(+), 234 deletions(-)
(limited to 'src/vhdl')
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index 028a9819c..3fe106861 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -890,7 +890,8 @@ package body Canon is
when Iir_Kind_Association_Element_By_Individual =>
Found := True;
when Iir_Kind_Association_Element_Package
- | Iir_Kind_Association_Element_Type =>
+ | Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
goto Done;
when others =>
Error_Kind ("canon_association_chain", Assoc_El);
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 8ceab99cf..646630602 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -832,13 +832,11 @@ package body Disp_Vhdl is
procedure Disp_Type_Declaration (Decl: Iir_Type_Declaration)
is
- Indent: Count;
- Def : Iir;
+ Indent : constant Count := Col;
+ Def : constant Iir := Get_Type_Definition (Decl);
begin
- Indent := Col;
Put ("type ");
Disp_Name_Of (Decl);
- Def := Get_Type_Definition (Decl);
if Def = Null_Iir
or else Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition
then
@@ -1114,6 +1112,8 @@ package body Disp_Vhdl is
when Iir_Kind_Interface_Type_Declaration =>
Put ("type ");
Disp_Identifier (Inter);
+ when Iir_Kinds_Interface_Subprogram_Declaration =>
+ Disp_Subprogram_Declaration (Inter);
when others =>
Error_Kind ("disp_interface_chain", Inter);
end case;
@@ -1434,13 +1434,15 @@ package body Disp_Vhdl is
end if;
case Get_Kind (Subprg) is
- when Iir_Kind_Function_Declaration =>
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration =>
if Get_Has_Pure (Subprg) then
Disp_Pure (Subprg);
Put (' ');
end if;
Put ("function");
- when Iir_Kind_Procedure_Declaration =>
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Interface_Procedure_Declaration =>
Put ("procedure");
when others =>
raise Internal_Error;
@@ -1457,14 +1459,16 @@ package body Disp_Vhdl is
end if;
case Get_Kind (Subprg) is
- when Iir_Kind_Function_Declaration =>
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration =>
Put (" return ");
if Implicit then
Disp_Type (Get_Return_Type (Subprg));
else
Disp_Name (Get_Return_Type_Mark (Subprg));
end if;
- when Iir_Kind_Procedure_Declaration =>
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Interface_Procedure_Declaration =>
null;
when others =>
raise Internal_Error;
@@ -1713,7 +1717,7 @@ package body Disp_Vhdl is
when Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body =>
-- The declaration was just displayed.
- Put_Line (" is");
+ Put_Line ("is");
Set_Col (Indent);
Disp_Subprogram_Body (Decl);
when Iir_Kind_Protected_Type_Body =>
diff --git a/src/vhdl/iir_chains.adb b/src/vhdl/iir_chains.adb
index d6d944f4e..43d02d44f 100644
--- a/src/vhdl/iir_chains.adb
+++ b/src/vhdl/iir_chains.adb
@@ -28,6 +28,28 @@ package body Iir_Chains is
return Res;
end Get_Chain_Length;
+ procedure Append_Chain
+ (N : Iir; Field : Nodes_Meta.Fields_Enum; Chain : Iir)
+ is
+ use Nodes_Meta;
+ N_Chain : Iir;
+ Next_Chain : Iir;
+ begin
+ N_Chain := Get_Iir (N, Field);
+ if Is_Null (N_Chain) then
+ Set_Iir (N, Field, Chain);
+ else
+ loop
+ Next_Chain := Get_Chain (N_Chain);
+ if Is_Null (Next_Chain) then
+ Set_Chain (N_Chain, Chain);
+ exit;
+ end if;
+ N_Chain := Next_Chain;
+ end loop;
+ end if;
+ end Append_Chain;
+
procedure Sub_Chain_Init (First, Last : out Iir) is
begin
First := Null_Iir;
diff --git a/src/vhdl/iir_chains.ads b/src/vhdl/iir_chains.ads
index 85746f154..fc9da1136 100644
--- a/src/vhdl/iir_chains.ads
+++ b/src/vhdl/iir_chains.ads
@@ -18,6 +18,7 @@
with Iirs; use Iirs;
with Iir_Chain_Handling;
pragma Elaborate_All (Iir_Chain_Handling);
+with Nodes_Meta;
package Iir_Chains is
-- Chains are simply linked list of iirs.
@@ -84,6 +85,10 @@ package Iir_Chains is
-- Not very efficient since O(N).
function Get_Chain_Length (First : Iir) return Natural;
+ -- Append CHAIN to the chain FIELD of node N. Not very efficient.
+ procedure Append_Chain
+ (N : Iir; Field : Nodes_Meta.Fields_Enum; Chain : Iir);
+
-- These two subprograms can be used to build a sub-chain.
-- FIRST and LAST designates respectively the first and last element of
-- the sub-chain.
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 1cf90d515..787be2df1 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -2478,6 +2478,22 @@ package body Iirs is
Set_Field3 (Def, Decl);
end Set_Type_Declarator;
+ function Get_Associated_Type (Def : Iir) return Iir is
+ begin
+ pragma Assert (Def /= Null_Iir);
+ pragma Assert (Has_Associated_Type (Get_Kind (Def)),
+ "no field Associated_Type");
+ return Get_Field5 (Def);
+ end Get_Associated_Type;
+
+ procedure Set_Associated_Type (Def : Iir; Atype : Iir) is
+ begin
+ pragma Assert (Def /= Null_Iir);
+ pragma Assert (Has_Associated_Type (Get_Kind (Def)),
+ "no field Associated_Type");
+ Set_Field5 (Def, Atype);
+ end Set_Associated_Type;
+
function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is
begin
pragma Assert (Target /= Null_Iir);
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 75d569377..8f2d21c29 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -2221,6 +2221,11 @@ package Iirs is
--
-- Get/Set_Base_Type (Field4)
--
+ -- Set only during analysis of association: type associated with this
+ -- interface, so that references to this interface can use the actual
+ -- type.
+ -- Get/Set_Associated_Type (Field5)
+ --
-- Get/Set_Type_Staticness (State1)
--
-- Get/Set_Resolved_Flag (Flag1)
@@ -6072,6 +6077,10 @@ package Iirs is
function Get_Type_Declarator (Def : Iir) return Iir;
procedure Set_Type_Declarator (Def : Iir; Decl : Iir);
+ -- Field: Field5 Ref
+ function Get_Associated_Type (Def : Iir) return Iir;
+ procedure Set_Associated_Type (Def : Iir; Atype : Iir);
+
-- Field: Field2 (uc)
function Get_Enumeration_Literal_List (Target : Iir) return Iir_List;
procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List);
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 71cb3a684..8cbb22906 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -140,6 +140,7 @@ package body Nodes_Meta is
Field_Context_Reference_Chain => Type_Iir,
Field_Selected_Name => Type_Iir,
Field_Type_Declarator => Type_Iir,
+ Field_Associated_Type => Type_Iir,
Field_Enumeration_Literal_List => Type_Iir_List,
Field_Entity_Class_Entry_Chain => Type_Iir,
Field_Group_Constituent_List => Type_Iir_List,
@@ -581,6 +582,8 @@ package body Nodes_Meta is
return "selected_name";
when Field_Type_Declarator =>
return "type_declarator";
+ when Field_Associated_Type =>
+ return "associated_type";
when Field_Enumeration_Literal_List =>
return "enumeration_literal_list";
when Field_Entity_Class_Entry_Chain =>
@@ -1737,6 +1740,8 @@ package body Nodes_Meta is
return Attr_None;
when Field_Type_Declarator =>
return Attr_Ref;
+ when Field_Associated_Type =>
+ return Attr_Ref;
when Field_Enumeration_Literal_List =>
return Attr_None;
when Field_Entity_Class_Entry_Chain =>
@@ -2430,6 +2435,7 @@ package body Nodes_Meta is
Field_Type_Staticness,
Field_Type_Declarator,
Field_Base_Type,
+ Field_Associated_Type,
-- Iir_Kind_File_Type_Definition
Field_Resolved_Flag,
Field_Signal_Type_Flag,
@@ -4251,218 +4257,218 @@ package body Nodes_Meta is
Iir_Kind_Configuration_Specification => 238,
Iir_Kind_Access_Type_Definition => 245,
Iir_Kind_Incomplete_Type_Definition => 252,
- Iir_Kind_Interface_Type_Definition => 258,
- Iir_Kind_File_Type_Definition => 265,
- Iir_Kind_Protected_Type_Declaration => 274,
- Iir_Kind_Record_Type_Definition => 284,
- Iir_Kind_Array_Type_Definition => 296,
- Iir_Kind_Array_Subtype_Definition => 311,
- Iir_Kind_Record_Subtype_Definition => 322,
- Iir_Kind_Access_Subtype_Definition => 330,
- Iir_Kind_Physical_Subtype_Definition => 339,
- Iir_Kind_Floating_Subtype_Definition => 349,
- Iir_Kind_Integer_Subtype_Definition => 358,
- Iir_Kind_Enumeration_Subtype_Definition => 367,
- Iir_Kind_Enumeration_Type_Definition => 376,
- Iir_Kind_Integer_Type_Definition => 382,
- Iir_Kind_Floating_Type_Definition => 388,
- Iir_Kind_Physical_Type_Definition => 397,
- Iir_Kind_Range_Expression => 403,
- Iir_Kind_Protected_Type_Body => 410,
- Iir_Kind_Wildcard_Type_Definition => 415,
- Iir_Kind_Subtype_Definition => 419,
- Iir_Kind_Scalar_Nature_Definition => 423,
- Iir_Kind_Overload_List => 424,
- Iir_Kind_Type_Declaration => 430,
- Iir_Kind_Anonymous_Type_Declaration => 435,
- Iir_Kind_Subtype_Declaration => 443,
- Iir_Kind_Nature_Declaration => 449,
- Iir_Kind_Subnature_Declaration => 455,
- Iir_Kind_Package_Declaration => 470,
- Iir_Kind_Package_Instantiation_Declaration => 482,
- Iir_Kind_Package_Body => 490,
- Iir_Kind_Configuration_Declaration => 499,
- Iir_Kind_Entity_Declaration => 511,
- Iir_Kind_Architecture_Body => 523,
- Iir_Kind_Context_Declaration => 529,
- Iir_Kind_Package_Header => 531,
- Iir_Kind_Unit_Declaration => 540,
- Iir_Kind_Library_Declaration => 547,
- Iir_Kind_Component_Declaration => 557,
- Iir_Kind_Attribute_Declaration => 564,
- Iir_Kind_Group_Template_Declaration => 570,
- Iir_Kind_Group_Declaration => 577,
- Iir_Kind_Element_Declaration => 584,
- Iir_Kind_Non_Object_Alias_Declaration => 592,
- Iir_Kind_Psl_Declaration => 600,
- Iir_Kind_Psl_Endpoint_Declaration => 614,
- Iir_Kind_Terminal_Declaration => 620,
- Iir_Kind_Free_Quantity_Declaration => 629,
- Iir_Kind_Across_Quantity_Declaration => 641,
- Iir_Kind_Through_Quantity_Declaration => 653,
- Iir_Kind_Enumeration_Literal => 664,
- Iir_Kind_Function_Declaration => 688,
- Iir_Kind_Procedure_Declaration => 711,
- Iir_Kind_Function_Body => 721,
- Iir_Kind_Procedure_Body => 732,
- Iir_Kind_Object_Alias_Declaration => 744,
- Iir_Kind_File_Declaration => 759,
- Iir_Kind_Guard_Signal_Declaration => 772,
- Iir_Kind_Signal_Declaration => 789,
- Iir_Kind_Variable_Declaration => 802,
- Iir_Kind_Constant_Declaration => 816,
- Iir_Kind_Iterator_Declaration => 828,
- Iir_Kind_Interface_Constant_Declaration => 844,
- Iir_Kind_Interface_Variable_Declaration => 860,
- Iir_Kind_Interface_Signal_Declaration => 881,
- Iir_Kind_Interface_File_Declaration => 897,
- Iir_Kind_Interface_Type_Declaration => 907,
- Iir_Kind_Interface_Package_Declaration => 917,
- Iir_Kind_Interface_Function_Declaration => 933,
- Iir_Kind_Interface_Procedure_Declaration => 945,
- Iir_Kind_Identity_Operator => 949,
- Iir_Kind_Negation_Operator => 953,
- Iir_Kind_Absolute_Operator => 957,
- Iir_Kind_Not_Operator => 961,
- Iir_Kind_Condition_Operator => 965,
- Iir_Kind_Reduction_And_Operator => 969,
- Iir_Kind_Reduction_Or_Operator => 973,
- Iir_Kind_Reduction_Nand_Operator => 977,
- Iir_Kind_Reduction_Nor_Operator => 981,
- Iir_Kind_Reduction_Xor_Operator => 985,
- Iir_Kind_Reduction_Xnor_Operator => 989,
- Iir_Kind_And_Operator => 994,
- Iir_Kind_Or_Operator => 999,
- Iir_Kind_Nand_Operator => 1004,
- Iir_Kind_Nor_Operator => 1009,
- Iir_Kind_Xor_Operator => 1014,
- Iir_Kind_Xnor_Operator => 1019,
- Iir_Kind_Equality_Operator => 1024,
- Iir_Kind_Inequality_Operator => 1029,
- Iir_Kind_Less_Than_Operator => 1034,
- Iir_Kind_Less_Than_Or_Equal_Operator => 1039,
- Iir_Kind_Greater_Than_Operator => 1044,
- Iir_Kind_Greater_Than_Or_Equal_Operator => 1049,
- Iir_Kind_Match_Equality_Operator => 1054,
- Iir_Kind_Match_Inequality_Operator => 1059,
- Iir_Kind_Match_Less_Than_Operator => 1064,
- Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1069,
- Iir_Kind_Match_Greater_Than_Operator => 1074,
- Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1079,
- Iir_Kind_Sll_Operator => 1084,
- Iir_Kind_Sla_Operator => 1089,
- Iir_Kind_Srl_Operator => 1094,
- Iir_Kind_Sra_Operator => 1099,
- Iir_Kind_Rol_Operator => 1104,
- Iir_Kind_Ror_Operator => 1109,
- Iir_Kind_Addition_Operator => 1114,
- Iir_Kind_Substraction_Operator => 1119,
- Iir_Kind_Concatenation_Operator => 1124,
- Iir_Kind_Multiplication_Operator => 1129,
- Iir_Kind_Division_Operator => 1134,
- Iir_Kind_Modulus_Operator => 1139,
- Iir_Kind_Remainder_Operator => 1144,
- Iir_Kind_Exponentiation_Operator => 1149,
- Iir_Kind_Function_Call => 1157,
- Iir_Kind_Aggregate => 1163,
- Iir_Kind_Parenthesis_Expression => 1166,
- Iir_Kind_Qualified_Expression => 1170,
- Iir_Kind_Type_Conversion => 1175,
- Iir_Kind_Allocator_By_Expression => 1179,
- Iir_Kind_Allocator_By_Subtype => 1185,
- Iir_Kind_Selected_Element => 1191,
- Iir_Kind_Dereference => 1196,
- Iir_Kind_Implicit_Dereference => 1201,
- Iir_Kind_Slice_Name => 1208,
- Iir_Kind_Indexed_Name => 1214,
- Iir_Kind_Psl_Expression => 1216,
- Iir_Kind_Sensitized_Process_Statement => 1236,
- Iir_Kind_Process_Statement => 1256,
- Iir_Kind_Concurrent_Simple_Signal_Assignment => 1267,
- Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1278,
- Iir_Kind_Concurrent_Selected_Signal_Assignment => 1290,
- Iir_Kind_Concurrent_Assertion_Statement => 1298,
- Iir_Kind_Concurrent_Procedure_Call_Statement => 1305,
- Iir_Kind_Psl_Assert_Statement => 1318,
- Iir_Kind_Psl_Cover_Statement => 1331,
- Iir_Kind_Block_Statement => 1344,
- Iir_Kind_If_Generate_Statement => 1354,
- Iir_Kind_Case_Generate_Statement => 1363,
- Iir_Kind_For_Generate_Statement => 1372,
- Iir_Kind_Component_Instantiation_Statement => 1382,
- Iir_Kind_Psl_Default_Clock => 1386,
- Iir_Kind_Simple_Simultaneous_Statement => 1393,
- Iir_Kind_Generate_Statement_Body => 1404,
- Iir_Kind_If_Generate_Else_Clause => 1409,
- Iir_Kind_Simple_Signal_Assignment_Statement => 1418,
- Iir_Kind_Conditional_Signal_Assignment_Statement => 1427,
- Iir_Kind_Null_Statement => 1431,
- Iir_Kind_Assertion_Statement => 1438,
- Iir_Kind_Report_Statement => 1444,
- Iir_Kind_Wait_Statement => 1451,
- Iir_Kind_Variable_Assignment_Statement => 1457,
- Iir_Kind_Conditional_Variable_Assignment_Statement => 1463,
- Iir_Kind_Return_Statement => 1469,
- Iir_Kind_For_Loop_Statement => 1478,
- Iir_Kind_While_Loop_Statement => 1486,
- Iir_Kind_Next_Statement => 1492,
- Iir_Kind_Exit_Statement => 1498,
- Iir_Kind_Case_Statement => 1506,
- Iir_Kind_Procedure_Call_Statement => 1512,
- Iir_Kind_If_Statement => 1521,
- Iir_Kind_Elsif => 1526,
- Iir_Kind_Character_Literal => 1533,
- Iir_Kind_Simple_Name => 1540,
- Iir_Kind_Selected_Name => 1548,
- Iir_Kind_Operator_Symbol => 1553,
- Iir_Kind_Selected_By_All_Name => 1558,
- Iir_Kind_Parenthesis_Name => 1562,
- Iir_Kind_External_Constant_Name => 1571,
- Iir_Kind_External_Signal_Name => 1580,
- Iir_Kind_External_Variable_Name => 1589,
- Iir_Kind_Package_Pathname => 1592,
- Iir_Kind_Absolute_Pathname => 1593,
- Iir_Kind_Relative_Pathname => 1594,
- Iir_Kind_Pathname_Element => 1598,
- Iir_Kind_Base_Attribute => 1600,
- Iir_Kind_Left_Type_Attribute => 1605,
- Iir_Kind_Right_Type_Attribute => 1610,
- Iir_Kind_High_Type_Attribute => 1615,
- Iir_Kind_Low_Type_Attribute => 1620,
- Iir_Kind_Ascending_Type_Attribute => 1625,
- Iir_Kind_Image_Attribute => 1631,
- Iir_Kind_Value_Attribute => 1637,
- Iir_Kind_Pos_Attribute => 1643,
- Iir_Kind_Val_Attribute => 1649,
- Iir_Kind_Succ_Attribute => 1655,
- Iir_Kind_Pred_Attribute => 1661,
- Iir_Kind_Leftof_Attribute => 1667,
- Iir_Kind_Rightof_Attribute => 1673,
- Iir_Kind_Delayed_Attribute => 1681,
- Iir_Kind_Stable_Attribute => 1689,
- Iir_Kind_Quiet_Attribute => 1697,
- Iir_Kind_Transaction_Attribute => 1705,
- Iir_Kind_Event_Attribute => 1709,
- Iir_Kind_Active_Attribute => 1713,
- Iir_Kind_Last_Event_Attribute => 1717,
- Iir_Kind_Last_Active_Attribute => 1721,
- Iir_Kind_Last_Value_Attribute => 1725,
- Iir_Kind_Driving_Attribute => 1729,
- Iir_Kind_Driving_Value_Attribute => 1733,
- Iir_Kind_Behavior_Attribute => 1733,
- Iir_Kind_Structure_Attribute => 1733,
- Iir_Kind_Simple_Name_Attribute => 1740,
- Iir_Kind_Instance_Name_Attribute => 1745,
- Iir_Kind_Path_Name_Attribute => 1750,
- Iir_Kind_Left_Array_Attribute => 1757,
- Iir_Kind_Right_Array_Attribute => 1764,
- Iir_Kind_High_Array_Attribute => 1771,
- Iir_Kind_Low_Array_Attribute => 1778,
- Iir_Kind_Length_Array_Attribute => 1785,
- Iir_Kind_Ascending_Array_Attribute => 1792,
- Iir_Kind_Range_Array_Attribute => 1799,
- Iir_Kind_Reverse_Range_Array_Attribute => 1806,
- Iir_Kind_Attribute_Name => 1814
+ Iir_Kind_Interface_Type_Definition => 259,
+ Iir_Kind_File_Type_Definition => 266,
+ Iir_Kind_Protected_Type_Declaration => 275,
+ Iir_Kind_Record_Type_Definition => 285,
+ Iir_Kind_Array_Type_Definition => 297,
+ Iir_Kind_Array_Subtype_Definition => 312,
+ Iir_Kind_Record_Subtype_Definition => 323,
+ Iir_Kind_Access_Subtype_Definition => 331,
+ Iir_Kind_Physical_Subtype_Definition => 340,
+ Iir_Kind_Floating_Subtype_Definition => 350,
+ Iir_Kind_Integer_Subtype_Definition => 359,
+ Iir_Kind_Enumeration_Subtype_Definition => 368,
+ Iir_Kind_Enumeration_Type_Definition => 377,
+ Iir_Kind_Integer_Type_Definition => 383,
+ Iir_Kind_Floating_Type_Definition => 389,
+ Iir_Kind_Physical_Type_Definition => 398,
+ Iir_Kind_Range_Expression => 404,
+ Iir_Kind_Protected_Type_Body => 411,
+ Iir_Kind_Wildcard_Type_Definition => 416,
+ Iir_Kind_Subtype_Definition => 420,
+ Iir_Kind_Scalar_Nature_Definition => 424,
+ Iir_Kind_Overload_List => 425,
+ Iir_Kind_Type_Declaration => 431,
+ Iir_Kind_Anonymous_Type_Declaration => 436,
+ Iir_Kind_Subtype_Declaration => 444,
+ Iir_Kind_Nature_Declaration => 450,
+ Iir_Kind_Subnature_Declaration => 456,
+ Iir_Kind_Package_Declaration => 471,
+ Iir_Kind_Package_Instantiation_Declaration => 483,
+ Iir_Kind_Package_Body => 491,
+ Iir_Kind_Configuration_Declaration => 500,
+ Iir_Kind_Entity_Declaration => 512,
+ Iir_Kind_Architecture_Body => 524,
+ Iir_Kind_Context_Declaration => 530,
+ Iir_Kind_Package_Header => 532,
+ Iir_Kind_Unit_Declaration => 541,
+ Iir_Kind_Library_Declaration => 548,
+ Iir_Kind_Component_Declaration => 558,
+ Iir_Kind_Attribute_Declaration => 565,
+ Iir_Kind_Group_Template_Declaration => 571,
+ Iir_Kind_Group_Declaration => 578,
+ Iir_Kind_Element_Declaration => 585,
+ Iir_Kind_Non_Object_Alias_Declaration => 593,
+ Iir_Kind_Psl_Declaration => 601,
+ Iir_Kind_Psl_Endpoint_Declaration => 615,
+ Iir_Kind_Terminal_Declaration => 621,
+ Iir_Kind_Free_Quantity_Declaration => 630,
+ Iir_Kind_Across_Quantity_Declaration => 642,
+ Iir_Kind_Through_Quantity_Declaration => 654,
+ Iir_Kind_Enumeration_Literal => 665,
+ Iir_Kind_Function_Declaration => 689,
+ Iir_Kind_Procedure_Declaration => 712,
+ Iir_Kind_Function_Body => 722,
+ Iir_Kind_Procedure_Body => 733,
+ Iir_Kind_Object_Alias_Declaration => 745,
+ Iir_Kind_File_Declaration => 760,
+ Iir_Kind_Guard_Signal_Declaration => 773,
+ Iir_Kind_Signal_Declaration => 790,
+ Iir_Kind_Variable_Declaration => 803,
+ Iir_Kind_Constant_Declaration => 817,
+ Iir_Kind_Iterator_Declaration => 829,
+ Iir_Kind_Interface_Constant_Declaration => 845,
+ Iir_Kind_Interface_Variable_Declaration => 861,
+ Iir_Kind_Interface_Signal_Declaration => 882,
+ Iir_Kind_Interface_File_Declaration => 898,
+ Iir_Kind_Interface_Type_Declaration => 908,
+ Iir_Kind_Interface_Package_Declaration => 918,
+ Iir_Kind_Interface_Function_Declaration => 934,
+ Iir_Kind_Interface_Procedure_Declaration => 946,
+ Iir_Kind_Identity_Operator => 950,
+ Iir_Kind_Negation_Operator => 954,
+ Iir_Kind_Absolute_Operator => 958,
+ Iir_Kind_Not_Operator => 962,
+ Iir_Kind_Condition_Operator => 966,
+ Iir_Kind_Reduction_And_Operator => 970,
+ Iir_Kind_Reduction_Or_Operator => 974,
+ Iir_Kind_Reduction_Nand_Operator => 978,
+ Iir_Kind_Reduction_Nor_Operator => 982,
+ Iir_Kind_Reduction_Xor_Operator => 986,
+ Iir_Kind_Reduction_Xnor_Operator => 990,
+ Iir_Kind_And_Operator => 995,
+ Iir_Kind_Or_Operator => 1000,
+ Iir_Kind_Nand_Operator => 1005,
+ Iir_Kind_Nor_Operator => 1010,
+ Iir_Kind_Xor_Operator => 1015,
+ Iir_Kind_Xnor_Operator => 1020,
+ Iir_Kind_Equality_Operator => 1025,
+ Iir_Kind_Inequality_Operator => 1030,
+ Iir_Kind_Less_Than_Operator => 1035,
+ Iir_Kind_Less_Than_Or_Equal_Operator => 1040,
+ Iir_Kind_Greater_Than_Operator => 1045,
+ Iir_Kind_Greater_Than_Or_Equal_Operator => 1050,
+ Iir_Kind_Match_Equality_Operator => 1055,
+ Iir_Kind_Match_Inequality_Operator => 1060,
+ Iir_Kind_Match_Less_Than_Operator => 1065,
+ Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1070,
+ Iir_Kind_Match_Greater_Than_Operator => 1075,
+ Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1080,
+ Iir_Kind_Sll_Operator => 1085,
+ Iir_Kind_Sla_Operator => 1090,
+ Iir_Kind_Srl_Operator => 1095,
+ Iir_Kind_Sra_Operator => 1100,
+ Iir_Kind_Rol_Operator => 1105,
+ Iir_Kind_Ror_Operator => 1110,
+ Iir_Kind_Addition_Operator => 1115,
+ Iir_Kind_Substraction_Operator => 1120,
+ Iir_Kind_Concatenation_Operator => 1125,
+ Iir_Kind_Multiplication_Operator => 1130,
+ Iir_Kind_Division_Operator => 1135,
+ Iir_Kind_Modulus_Operator => 1140,
+ Iir_Kind_Remainder_Operator => 1145,
+ Iir_Kind_Exponentiation_Operator => 1150,
+ Iir_Kind_Function_Call => 1158,
+ Iir_Kind_Aggregate => 1164,
+ Iir_Kind_Parenthesis_Expression => 1167,
+ Iir_Kind_Qualified_Expression => 1171,
+ Iir_Kind_Type_Conversion => 1176,
+ Iir_Kind_Allocator_By_Expression => 1180,
+ Iir_Kind_Allocator_By_Subtype => 1186,
+ Iir_Kind_Selected_Element => 1192,
+ Iir_Kind_Dereference => 1197,
+ Iir_Kind_Implicit_Dereference => 1202,
+ Iir_Kind_Slice_Name => 1209,
+ Iir_Kind_Indexed_Name => 1215,
+ Iir_Kind_Psl_Expression => 1217,
+ Iir_Kind_Sensitized_Process_Statement => 1237,
+ Iir_Kind_Process_Statement => 1257,
+ Iir_Kind_Concurrent_Simple_Signal_Assignment => 1268,
+ Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1279,
+ Iir_Kind_Concurrent_Selected_Signal_Assignment => 1291,
+ Iir_Kind_Concurrent_Assertion_Statement => 1299,
+ Iir_Kind_Concurrent_Procedure_Call_Statement => 1306,
+ Iir_Kind_Psl_Assert_Statement => 1319,
+ Iir_Kind_Psl_Cover_Statement => 1332,
+ Iir_Kind_Block_Statement => 1345,
+ Iir_Kind_If_Generate_Statement => 1355,
+ Iir_Kind_Case_Generate_Statement => 1364,
+ Iir_Kind_For_Generate_Statement => 1373,
+ Iir_Kind_Component_Instantiation_Statement => 1383,
+ Iir_Kind_Psl_Default_Clock => 1387,
+ Iir_Kind_Simple_Simultaneous_Statement => 1394,
+ Iir_Kind_Generate_Statement_Body => 1405,
+ Iir_Kind_If_Generate_Else_Clause => 1410,
+ Iir_Kind_Simple_Signal_Assignment_Statement => 1419,
+ Iir_Kind_Conditional_Signal_Assignment_Statement => 1428,
+ Iir_Kind_Null_Statement => 1432,
+ Iir_Kind_Assertion_Statement => 1439,
+ Iir_Kind_Report_Statement => 1445,
+ Iir_Kind_Wait_Statement => 1452,
+ Iir_Kind_Variable_Assignment_Statement => 1458,
+ Iir_Kind_Conditional_Variable_Assignment_Statement => 1464,
+ Iir_Kind_Return_Statement => 1470,
+ Iir_Kind_For_Loop_Statement => 1479,
+ Iir_Kind_While_Loop_Statement => 1487,
+ Iir_Kind_Next_Statement => 1493,
+ Iir_Kind_Exit_Statement => 1499,
+ Iir_Kind_Case_Statement => 1507,
+ Iir_Kind_Procedure_Call_Statement => 1513,
+ Iir_Kind_If_Statement => 1522,
+ Iir_Kind_Elsif => 1527,
+ Iir_Kind_Character_Literal => 1534,
+ Iir_Kind_Simple_Name => 1541,
+ Iir_Kind_Selected_Name => 1549,
+ Iir_Kind_Operator_Symbol => 1554,
+ Iir_Kind_Selected_By_All_Name => 1559,
+ Iir_Kind_Parenthesis_Name => 1563,
+ Iir_Kind_External_Constant_Name => 1572,
+ Iir_Kind_External_Signal_Name => 1581,
+ Iir_Kind_External_Variable_Name => 1590,
+ Iir_Kind_Package_Pathname => 1593,
+ Iir_Kind_Absolute_Pathname => 1594,
+ Iir_Kind_Relative_Pathname => 1595,
+ Iir_Kind_Pathname_Element => 1599,
+ Iir_Kind_Base_Attribute => 1601,
+ Iir_Kind_Left_Type_Attribute => 1606,
+ Iir_Kind_Right_Type_Attribute => 1611,
+ Iir_Kind_High_Type_Attribute => 1616,
+ Iir_Kind_Low_Type_Attribute => 1621,
+ Iir_Kind_Ascending_Type_Attribute => 1626,
+ Iir_Kind_Image_Attribute => 1632,
+ Iir_Kind_Value_Attribute => 1638,
+ Iir_Kind_Pos_Attribute => 1644,
+ Iir_Kind_Val_Attribute => 1650,
+ Iir_Kind_Succ_Attribute => 1656,
+ Iir_Kind_Pred_Attribute => 1662,
+ Iir_Kind_Leftof_Attribute => 1668,
+ Iir_Kind_Rightof_Attribute => 1674,
+ Iir_Kind_Delayed_Attribute => 1682,
+ Iir_Kind_Stable_Attribute => 1690,
+ Iir_Kind_Quiet_Attribute => 1698,
+ Iir_Kind_Transaction_Attribute => 1706,
+ Iir_Kind_Event_Attribute => 1710,
+ Iir_Kind_Active_Attribute => 1714,
+ Iir_Kind_Last_Event_Attribute => 1718,
+ Iir_Kind_Last_Active_Attribute => 1722,
+ Iir_Kind_Last_Value_Attribute => 1726,
+ Iir_Kind_Driving_Attribute => 1730,
+ Iir_Kind_Driving_Value_Attribute => 1734,
+ Iir_Kind_Behavior_Attribute => 1734,
+ Iir_Kind_Structure_Attribute => 1734,
+ Iir_Kind_Simple_Name_Attribute => 1741,
+ Iir_Kind_Instance_Name_Attribute => 1746,
+ Iir_Kind_Path_Name_Attribute => 1751,
+ Iir_Kind_Left_Array_Attribute => 1758,
+ Iir_Kind_Right_Array_Attribute => 1765,
+ Iir_Kind_High_Array_Attribute => 1772,
+ Iir_Kind_Low_Array_Attribute => 1779,
+ Iir_Kind_Length_Array_Attribute => 1786,
+ Iir_Kind_Ascending_Array_Attribute => 1793,
+ Iir_Kind_Range_Array_Attribute => 1800,
+ Iir_Kind_Reverse_Range_Array_Attribute => 1807,
+ Iir_Kind_Attribute_Name => 1815
);
function Get_Fields (K : Iir_Kind) return Fields_Array
@@ -4968,6 +4974,8 @@ package body Nodes_Meta is
return Get_Selected_Name (N);
when Field_Type_Declarator =>
return Get_Type_Declarator (N);
+ when Field_Associated_Type =>
+ return Get_Associated_Type (N);
when Field_Entity_Class_Entry_Chain =>
return Get_Entity_Class_Entry_Chain (N);
when Field_Unit_Chain =>
@@ -5344,6 +5352,8 @@ package body Nodes_Meta is
Set_Selected_Name (N, V);
when Field_Type_Declarator =>
Set_Type_Declarator (N, V);
+ when Field_Associated_Type =>
+ Set_Associated_Type (N, V);
when Field_Entity_Class_Entry_Chain =>
Set_Entity_Class_Entry_Chain (N, V);
when Field_Unit_Chain =>
@@ -7650,6 +7660,11 @@ package body Nodes_Meta is
end case;
end Has_Type_Declarator;
+ function Has_Associated_Type (K : Iir_Kind) return Boolean is
+ begin
+ return K = Iir_Kind_Interface_Type_Definition;
+ end Has_Associated_Type;
+
function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean is
begin
return K = Iir_Kind_Enumeration_Type_Definition;
diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads
index c9fe6e695..c31d87ea7 100644
--- a/src/vhdl/nodes_meta.ads
+++ b/src/vhdl/nodes_meta.ads
@@ -180,6 +180,7 @@ package Nodes_Meta is
Field_Context_Reference_Chain,
Field_Selected_Name,
Field_Type_Declarator,
+ Field_Associated_Type,
Field_Enumeration_Literal_List,
Field_Entity_Class_Entry_Chain,
Field_Group_Constituent_List,
@@ -673,6 +674,7 @@ package Nodes_Meta is
function Has_Context_Reference_Chain (K : Iir_Kind) return Boolean;
function Has_Selected_Name (K : Iir_Kind) return Boolean;
function Has_Type_Declarator (K : Iir_Kind) return Boolean;
+ function Has_Associated_Type (K : Iir_Kind) return Boolean;
function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean;
function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean;
function Has_Group_Constituent_List (K : Iir_Kind) return Boolean;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 08c3a7a8b..66e81d135 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -431,7 +431,8 @@ package body Sem is
when Iir_Kind_Association_Element_Open
| Iir_Kind_Association_Element_By_Individual
| Iir_Kind_Association_Element_Package
- | Iir_Kind_Association_Element_Type =>
+ | Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
null;
when others =>
Error_Kind ("sem_generic_association_chain(1)", El);
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index a56840df0..19ba3de92 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -39,6 +39,8 @@ package body Sem_Assocs is
N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package);
when Iir_Kind_Interface_Type_Declaration =>
N_Assoc := Create_Iir (Iir_Kind_Association_Element_Type);
+ when Iir_Kinds_Interface_Subprogram_Declaration =>
+ N_Assoc := Create_Iir (Iir_Kind_Association_Element_Subprogram);
when others =>
Error_Kind ("rewrite_non_object_association", Inter);
end case;
@@ -1601,12 +1603,12 @@ package body Sem_Assocs is
return Null_Iir;
end Sem_Implicit_Operator_Association;
- procedure Sem_Association_Type
- (Assoc : Iir;
- Inter : Iir;
- Finish : Boolean;
- Match : out Compatibility_Level)
+ procedure Sem_Association_Type (Assoc : Iir;
+ Inter : Iir;
+ Finish : Boolean;
+ Match : out Compatibility_Level)
is
+ Inter_Def : constant Iir := Get_Type (Inter);
Actual : Iir;
Op_Eq, Op_Neq : Iir;
begin
@@ -1626,6 +1628,10 @@ package body Sem_Assocs is
Actual := Sem_Types.Sem_Subtype_Indication (Actual);
Set_Actual (Assoc, Actual);
+ -- Set type association for analysis of reference to this interface.
+ pragma Assert (Is_Null (Get_Associated_Type (Inter_Def)));
+ Set_Associated_Type (Inter_Def, Get_Type (Actual));
+
-- FIXME: it is not clear at all from the LRM how the implicit
-- associations are done...
Op_Eq := Sem_Implicit_Operator_Association
@@ -1638,6 +1644,178 @@ package body Sem_Assocs is
end if;
end Sem_Association_Type;
+ function Has_Interface_Subprogram_Profile
+ (Inter : Iir;
+ Decl : Iir;
+ Explain_Loc : Location_Type := No_Location) return Boolean
+ is
+ -- Handle previous assocation of interface type before full
+ -- instantiation.
+ function Get_Inter_Type (Inter : Iir) return Iir
+ is
+ Res : Iir;
+ begin
+ Res := Get_Type (Inter);
+ if Get_Kind (Res) = Iir_Kind_Interface_Type_Definition then
+ -- FIXME: recurse ?
+ return Get_Associated_Type (Res);
+ else
+ return Res;
+ end if;
+ end Get_Inter_Type;
+
+ Explain : constant Boolean := Explain_Loc /= No_Location;
+ El_Inter, El_Decl : Iir;
+ begin
+ case Iir_Kinds_Interface_Subprogram_Declaration (Get_Kind (Inter)) is
+ when Iir_Kind_Interface_Function_Declaration =>
+ if not Is_Function_Declaration (Decl) then
+ if Explain then
+ Error_Msg_Sem (Explain_Loc, " actual is not a function");
+ end if;
+ return False;
+ end if;
+ if Get_Base_Type (Get_Inter_Type (Inter))
+ /= Get_Base_Type (Get_Type (Decl))
+ then
+ if Explain then
+ Error_Msg_Sem (Explain_Loc, " return type doesn't match");
+ end if;
+ return False;
+ end if;
+ when Iir_Kind_Interface_Procedure_Declaration =>
+ if not Is_Procedure_Declaration (Decl) then
+ if Explain then
+ Error_Msg_Sem (Explain_Loc, " actual is not a procedure");
+ end if;
+ return False;
+ end if;
+ end case;
+
+ El_Inter := Get_Interface_Declaration_Chain (Inter);
+ El_Decl := Get_Interface_Declaration_Chain (Decl);
+ loop
+ exit when Is_Null (El_Inter) and Is_Null (El_Decl);
+ if Is_Null (El_Inter) or Is_Null (El_Decl) then
+ if Explain then
+ Error_Msg_Sem
+ (Explain_Loc, " number of interfaces doesn't match");
+ end if;
+ return False;
+ end if;
+ if Get_Base_Type (Get_Inter_Type (El_Inter))
+ /= Get_Base_Type (Get_Type (El_Decl))
+ then
+ if Explain then
+ Error_Msg_Sem
+ (Explain_Loc,
+ " type of interface %i doesn't match", +El_Inter);
+ end if;
+ return False;
+ end if;
+ El_Inter := Get_Chain (El_Inter);
+ El_Decl := Get_Chain (El_Decl);
+ end loop;
+
+ return True;
+ end Has_Interface_Subprogram_Profile;
+
+ procedure Sem_Association_Subprogram (Assoc : Iir;
+ Inter : Iir;
+ Finish : Boolean;
+ Match : out Compatibility_Level)
+ is
+ Discard : Boolean;
+ pragma Unreferenced (Discard);
+ Actual : Iir;
+ Res : Iir;
+ begin
+ if not Finish then
+ Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match);
+ return;
+ end if;
+
+ Match := Fully_Compatible;
+ Sem_Association_Package_Type_Finish (Assoc, Inter);
+ Actual := Get_Actual (Assoc);
+
+ -- LRM08 6.5.7.2 Generic map aspects
+ -- An actual associated with a formal generic subprogram shall be a name
+ -- that denotes a subprogram whose profile conforms to that of the
+ -- formal, or the reserved word OPEN. The actual, if a predefined
+ -- attribute name that denotes a function, shall be one of the
+ -- predefined attributes 'IMAGE, 'VALUE, 'POS, 'VAL, 'SUCC, 'PREV,
+ -- 'LEFTOF, or 'RIGHTOF.
+ Sem_Name (Actual);
+ Res := Get_Named_Entity (Actual);
+
+ if Is_Error (Res) then
+ return;
+ end if;
+
+ case Get_Kind (Res) is
+ when Iir_Kinds_Subprogram_Declaration
+ | Iir_Kinds_Interface_Subprogram_Declaration =>
+ if not Has_Interface_Subprogram_Profile (Inter, Res) then
+ Error_Msg_Sem
+ (+Assoc, "profile of %n doesn't match profile of %n",
+ (+Actual, +Inter));
+ Discard := Has_Interface_Subprogram_Profile
+ (Inter, Res, Get_Location (Assoc));
+ end if;
+ when Iir_Kind_Overload_List =>
+ declare
+ First_Error : Boolean;
+ List : Iir_List;
+ El, R : Iir;
+ begin
+ First_Error := True;
+ R := Null_Iir;
+ List := Get_Overload_List (Res);
+ for I in Natural loop
+ El := Get_Nth_Element (List, I);
+ exit when El = Null_Iir;
+ if Has_Interface_Subprogram_Profile (Inter, El) then
+ if Is_Null (R) then
+ R := El;
+ else
+ if First_Error then
+ Error_Msg_Sem
+ (+Assoc,
+ "many possible actual subprogram for %n:",
+ +Inter);
+ Error_Msg_Sem
+ (+Assoc, " %n declared at %l", (+R, + R));
+ First_Error := False;
+ else
+ Error_Msg_Sem
+ (+Assoc, " %n declared at %l", (+El, +El));
+ end if;
+ end if;
+ end if;
+ end loop;
+ if Is_Null (R) then
+ Error_Msg_Sem
+ (+Assoc, "no matching name for %n", +Inter);
+ if True then
+ Error_Msg_Sem
+ (+Assoc, " these names were incompatible:");
+ for I in Natural loop
+ El := Get_Nth_Element (List, I);
+ exit when El = Null_Iir;
+ Error_Msg_Sem
+ (+Assoc, " %n declared at %l", (+El, +El));
+ end loop;
+ end if;
+ end if;
+ Free_Overload_List (Res);
+ Set_Named_Entity (Actual, R);
+ end;
+ when others =>
+ Error_Kind ("sem_association_subprogram", Res);
+ end case;
+ end Sem_Association_Subprogram;
+
-- Associate ASSOC with interface INTERFACE
-- This sets MATCH.
procedure Sem_Association_By_Expression
@@ -1872,14 +2050,17 @@ package body Sem_Assocs is
when Iir_Kind_Association_Element_Open =>
Sem_Association_Open (Assoc, Inter, Finish, Match);
+ when Iir_Kind_Association_Element_By_Expression =>
+ Sem_Association_By_Expression (Assoc, Inter, Finish, Match);
+
when Iir_Kind_Association_Element_Package =>
Sem_Association_Package (Assoc, Inter, Finish, Match);
when Iir_Kind_Association_Element_Type =>
Sem_Association_Type (Assoc, Inter, Finish, Match);
- when Iir_Kind_Association_Element_By_Expression =>
- Sem_Association_By_Expression (Assoc, Inter, Finish, Match);
+ when Iir_Kind_Association_Element_Subprogram =>
+ Sem_Association_Subprogram (Assoc, Inter, Finish, Match);
when others =>
Error_Kind ("sem_assocation", Assoc);
@@ -2173,6 +2354,12 @@ package body Sem_Assocs is
Error_Kind ("sem_association_chain", Inter);
end case;
end if;
+
+ -- Clear associated type of interface type.
+ if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then
+ Set_Associated_Type (Get_Type (Inter), Null_Iir);
+ end if;
+
Inter := Get_Chain (Inter);
Pos := Pos + 1;
end loop;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 7cf490249..3fd25927e 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -456,6 +456,7 @@ package body Sem_Decls is
procedure Sem_Interface_Chain (Interface_Chain: Iir;
Interface_Kind : Interface_Kind_Type)
is
+ -- Control visibility of interface object. See below for its use.
Immediately_Visible : constant Boolean :=
Interface_Kind = Generic_Interface_List
and then Flags.Vhdl_Std >= Vhdl_08;
@@ -484,6 +485,10 @@ package body Sem_Decls is
end case;
-- LRM08 6.5.6 Interface lists
+ -- A name that denotes an interface object declared in a port
+ -- interface list of a prameter interface list shall not appear in
+ -- any interface declaration within the interface list containing the
+ -- denoted interface object expect to declare this object.
-- A name that denotes an interface declaration in a generic
-- interface list may appear in an interface declaration within the
-- interface list containing the denoted interface declaration.
@@ -3136,7 +3141,8 @@ package body Sem_Decls is
end if;
end;
when Iir_Kind_Package_Declaration =>
- if Get_Need_Body (El)
+ if Is_Null (Get_Package_Origin (El))
+ and then Get_Need_Body (El)
and then Get_Package_Body (El) = Null_Iir
then
Error_Msg_Sem (+El, "missing package body for %n", +El);
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index 597010b62..20841263b 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -402,6 +402,9 @@ package body Sem_Inst is
Set_Subprogram_Body (Spec, Res);
end;
+ when Field_Incomplete_Type_List =>
+ null;
+
when others =>
-- Common case.
Instantiate_Iir_Field (Res, N, F);
@@ -410,6 +413,7 @@ package body Sem_Inst is
-- TODO: other forward references:
-- incomplete constant
+ -- incomplete type
-- attribute_value
return Res;
@@ -457,6 +461,8 @@ package body Sem_Inst is
(Res, Get_Uninstantiated_Package_Name (Inter));
when Iir_Kind_Interface_Type_Declaration =>
Set_Type (Res, Get_Type (Inter));
+ when Iir_Kinds_Interface_Subprogram_Declaration =>
+ null;
when others =>
Error_Kind ("instantiate_generic_chain", Res);
end case;
@@ -662,6 +668,16 @@ package body Sem_Inst is
begin
Set_Instance (Inter_Type_Def, Actual_Type);
end;
+ when Iir_Kind_Association_Element_Subprogram =>
+ -- Replace the interface subprogram by the subprogram.
+ declare
+ Inter_Subprg : constant Iir :=
+ Get_Association_Interface (Assoc, Inter);
+ Actual_Subprg : constant Iir :=
+ Get_Named_Entity (Get_Actual (Assoc));
+ begin
+ Set_Instance (Get_Origin (Inter_Subprg), Actual_Subprg);
+ end;
when others =>
Error_Kind ("instantiate_generic_map_chain", Assoc);
end case;
@@ -759,7 +775,7 @@ package body Sem_Inst is
begin
Imp_Assoc := Get_Subprogram_Association_Chain (Inst_El);
Imp_Inter := Get_Interface_Type_Subprograms
- (Get_Origin (Inter_El));
+ (Get_Origin (Inter));
while Is_Valid (Imp_Inter) and Is_Valid (Imp_Assoc) loop
Set_Instance
(Imp_Inter,
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index ca0bff60b..fa1a09843 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -1631,7 +1631,8 @@ package body Trans.Chap4 is
Create_Object (Decl);
when Iir_Kind_Interface_Package_Declaration =>
Create_Package_Interface (Decl);
- when Iir_Kind_Interface_Type_Declaration =>
+ when Iir_Kind_Interface_Type_Declaration
+ | Iir_Kinds_Interface_Subprogram_Declaration =>
null;
when others =>
Error_Kind ("translate_generic_chain", Decl);
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index cc5f349d0..c86f34602 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -802,7 +802,8 @@ package body Trans.Chap5 is
(Actual_Info.Package_Instance_Body_Scope),
Uninst_Info.Package_Body_Ptr_Type));
end;
- when Iir_Kind_Association_Element_Type =>
+ when Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
null;
when others =>
Error_Kind ("elab_generic_map_aspect(1)", Assoc);
--
cgit v1.2.3