aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/canon.adb87
-rw-r--r--src/vhdl/canon.ads5
-rw-r--r--src/vhdl/disp_tree.adb2
-rw-r--r--src/vhdl/disp_vhdl.adb16
-rw-r--r--src/vhdl/errorout.adb11
-rw-r--r--src/vhdl/iirs.adb25
-rw-r--r--src/vhdl/iirs.ads30
-rw-r--r--src/vhdl/iirs_utils.adb6
-rw-r--r--src/vhdl/nodes_meta.adb135
-rw-r--r--src/vhdl/nodes_meta.ads3
-rw-r--r--src/vhdl/parse.adb31
-rw-r--r--src/vhdl/parse.ads4
-rw-r--r--src/vhdl/scanner.adb55
-rw-r--r--src/vhdl/sem.adb17
-rw-r--r--src/vhdl/sem_assocs.adb106
-rw-r--r--src/vhdl/sem_decls.adb2
-rw-r--r--src/vhdl/sem_expr.adb6
-rw-r--r--src/vhdl/sem_inst.adb18
-rw-r--r--src/vhdl/sem_names.adb12
-rw-r--r--src/vhdl/translate/trans-chap2.adb183
-rw-r--r--src/vhdl/translate/trans-chap2.ads2
-rw-r--r--src/vhdl/translate/trans-chap4.adb14
-rw-r--r--src/vhdl/translate/trans-rtis.adb51
-rw-r--r--src/vhdl/translate/translation.adb6
24 files changed, 499 insertions, 328 deletions
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index a23bbeb3f..577ff9e8f 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -2592,6 +2592,7 @@ package body Canon is
function Canon_Package_Instantiation_Declaration (Decl : Iir) return Iir
is
Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Decl);
+ Bod : Iir;
begin
-- Canon map aspect.
Set_Generic_Map_Aspect_Chain
@@ -2600,79 +2601,25 @@ package body Canon is
(Get_Generic_Chain (Decl),
Get_Generic_Map_Aspect_Chain (Decl), Decl));
- if Get_Macro_Expanded_Flag (Pkg) then
- declare
- New_Decl : Iir;
- New_Hdr : Iir;
- begin
- -- Replace package instantiation by the macro-expanded
- -- generic-mapped package.
- -- Use move semantics.
- -- FIXME: adjust Parent.
- New_Decl := Create_Iir (Iir_Kind_Package_Declaration);
- Location_Copy (New_Decl, Decl);
- Set_Parent (New_Decl, Get_Parent (Decl));
- Set_Identifier (New_Decl, Get_Identifier (Decl));
- Set_Need_Body (New_Decl, Get_Need_Body (Pkg));
-
- New_Hdr := Create_Iir (Iir_Kind_Package_Header);
- Set_Package_Header (New_Decl, New_Hdr);
- Location_Copy (New_Hdr, Get_Package_Header (Pkg));
- Set_Generic_Chain (New_Hdr, Get_Generic_Chain (Decl));
- Set_Generic_Map_Aspect_Chain
- (New_Hdr, Get_Generic_Map_Aspect_Chain (Decl));
- Set_Generic_Chain (Decl, Null_Iir);
- Set_Generic_Map_Aspect_Chain (Decl, Null_Iir);
-
- Set_Declaration_Chain (New_Decl, Get_Declaration_Chain (Decl));
- Set_Declaration_Chain (Decl, Null_Iir);
- Set_Chain (New_Decl, Get_Chain (Decl));
- Set_Chain (Decl, Null_Iir);
-
- Set_Package_Origin (New_Decl, Decl);
- return New_Decl;
- end;
- else
- return Decl;
+ -- Generate the body now.
+ -- Note: according to the LRM, if the instantiation occurs within a
+ -- package, the body of the instance should be appended to the package
+ -- body.
+ -- FIXME: generate only if generating code for this unit.
+ if Get_Macro_Expanded_Flag (Pkg)
+ and then Get_Need_Body (Pkg)
+ then
+ Bod := Sem_Inst.Instantiate_Package_Body (Decl);
+ Set_Parent (Bod, Get_Parent (Decl));
+ Set_Package_Body (Decl, Bod);
end if;
- end Canon_Package_Instantiation_Declaration;
-
- function Create_Instantiation_Bodies
- (Decl : Iir_Package_Declaration; Parent : Iir) return Iir
- is
- First, Last : Iir;
- El : Iir;
- Bod : Iir;
- begin
- First := Null_Iir;
- Last := Null_Iir; -- Kill the warning
- El := Get_Declaration_Chain (Decl);
- while Is_Valid (El) loop
- if Get_Kind (El) = Iir_Kind_Package_Declaration
- and then Get_Need_Body (El)
- and then Get_Package_Origin (El) /= Null_Iir
- then
- Bod := Sem_Inst.Instantiate_Package_Body (El);
- Set_Parent (Bod, Parent);
- -- Append.
- if First = Null_Iir then
- First := Bod;
- else
- Set_Chain (Last, Bod);
- end if;
- Last := Bod;
- end if;
- El := Get_Chain (El);
- end loop;
- return First;
- end Create_Instantiation_Bodies;
+ return Decl;
+ end Canon_Package_Instantiation_Declaration;
- function Canon_Declaration (Top : Iir_Design_Unit;
- Decl : Iir;
- Parent : Iir;
- Decl_Parent : Iir)
- return Iir
+ function Canon_Declaration
+ (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir; Decl_Parent : Iir)
+ return Iir
is
Stmts : Iir;
begin
diff --git a/src/vhdl/canon.ads b/src/vhdl/canon.ads
index 40ce5088f..45e7db6a5 100644
--- a/src/vhdl/canon.ads
+++ b/src/vhdl/canon.ads
@@ -61,11 +61,6 @@ package Canon is
(Arch : Iir_Architecture_Body)
return Iir_Design_Unit;
- -- Macro-expand package bodies for instantiations in DECL. Return the
- -- chain of bodies (the parent of each body is set to PARENT).
- function Create_Instantiation_Bodies
- (Decl : Iir_Package_Declaration; Parent : Iir) return Iir;
-
-- Canonicalize a subprogram call.
procedure Canon_Subprogram_Call (Call : Iir);
diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb
index ecfc93ba4..92cfff293 100644
--- a/src/vhdl/disp_tree.adb
+++ b/src/vhdl/disp_tree.adb
@@ -452,6 +452,8 @@ package body Disp_Tree is
Ndepth := Depth - 1;
when Attr_Of_Ref =>
Ndepth := 0;
+ when Attr_Ref =>
+ Ndepth := 0;
when Attr_Of_Maybe_Ref =>
if Get_Is_Ref (N) then
Ndepth := 0;
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 291214af6..c00565515 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -2335,7 +2335,18 @@ package body Disp_Vhdl is
end if;
Formal := Get_Formal (El);
if Formal /= Null_Iir then
- Disp_Expression (Formal);
+ case Get_Kind (El) is
+ when Iir_Kind_Association_Element_Package
+ | Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
+ Disp_Name (Formal);
+ when Iir_Kind_Association_Element_By_Expression
+ | Iir_Kind_Association_Element_By_Individual
+ | Iir_Kind_Association_Element_Open =>
+ Disp_Expression (Formal);
+ when others =>
+ raise Internal_Error;
+ end case;
if Conv /= Null_Iir then
Put (")");
end if;
@@ -2346,7 +2357,8 @@ package body Disp_Vhdl is
when Iir_Kind_Association_Element_Open =>
Put ("open");
when Iir_Kind_Association_Element_Package
- | Iir_Kind_Association_Element_Type =>
+ | Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
Disp_Name (Get_Actual (El));
when others =>
Conv := Get_In_Conversion (El);
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 7119563cc..c5c5d9b1f 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -1259,9 +1259,11 @@ package body Errorout is
case Get_Kind (Subprg) is
when Iir_Kind_Enumeration_Literal =>
Append (Res, "enumeration literal ");
- when Iir_Kind_Function_Declaration =>
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration =>
Append (Res, "function ");
- when Iir_Kind_Procedure_Declaration =>
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Interface_Procedure_Declaration =>
Append (Res, "procedure ");
when others =>
Error_Kind ("disp_subprg", Subprg);
@@ -1289,8 +1291,8 @@ package body Errorout is
Append (Res, " [");
case Get_Kind (Subprg) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
+ when Iir_Kinds_Subprogram_Declaration
+ | Iir_Kinds_Interface_Subprogram_Declaration =>
declare
El : Iir;
begin
@@ -1308,6 +1310,7 @@ package body Errorout is
case Get_Kind (Subprg) is
when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration
| Iir_Kind_Enumeration_Literal =>
Append (Res, " return ");
Append_Type (Get_Return_Type (Subprg));
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index a5a12a742..219d21734 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -1776,23 +1776,6 @@ package body Iirs is
Set_Field5 (Pkg, Decl);
end Set_Package_Body;
- function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir is
- begin
- pragma Assert (Pkg /= Null_Iir);
- pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)),
- "no field Package_Instantiation_Bodies_Chain");
- return Get_Field8 (Pkg);
- end Get_Package_Instantiation_Bodies_Chain;
-
- procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir)
- is
- begin
- pragma Assert (Pkg /= Null_Iir);
- pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)),
- "no field Package_Instantiation_Bodies_Chain");
- Set_Field8 (Pkg, Chain);
- end Set_Package_Instantiation_Bodies_Chain;
-
function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is
begin
pragma Assert (Decl /= Null_Iir);
@@ -4741,7 +4724,7 @@ package body Iirs is
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Actual_Type (Get_Kind (Target)),
"no field Actual_Type");
- return Get_Field3 (Target);
+ return Get_Field5 (Target);
end Get_Actual_Type;
procedure Set_Actual_Type (Target : Iir; Atype : Iir) is
@@ -4749,7 +4732,7 @@ package body Iirs is
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Actual_Type (Get_Kind (Target)),
"no field Actual_Type");
- Set_Field3 (Target, Atype);
+ Set_Field5 (Target, Atype);
end Set_Actual_Type;
function Get_Actual_Type_Definition (Target : Iir) return Iir is
@@ -4757,7 +4740,7 @@ package body Iirs is
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Actual_Type_Definition (Get_Kind (Target)),
"no field Actual_Type_Definition");
- return Get_Field5 (Target);
+ return Get_Field3 (Target);
end Get_Actual_Type_Definition;
procedure Set_Actual_Type_Definition (Target : Iir; Atype : Iir) is
@@ -4765,7 +4748,7 @@ package body Iirs is
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Actual_Type_Definition (Get_Kind (Target)),
"no field Actual_Type_Definition");
- Set_Field5 (Target, Atype);
+ Set_Field3 (Target, Atype);
end Set_Actual_Type_Definition;
function Get_Association_Chain (Target : Iir) return Iir is
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 4e0cbfd57..380ae998a 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -452,10 +452,11 @@ package Iirs is
--
-- Owner of Actual_Type if needed.
-- Only for Iir_Kind_Association_Element_By_Individual:
- -- Get/Set_Actual_Type_Definition (Field5)
+ -- Get/Set_Actual_Type_Definition (Field3)
--
-- Only for Iir_Kind_Association_Element_By_Individual:
- -- Get/Set_Actual_Type (Field3)
+ -- Only for Iir_Kind_Association_Element_Type:
+ -- Get/Set_Actual_Type (Field5)
--
-- Get/Set the whole association flag (true if the formal is associated in
-- whole and not individually, see LRM93 4.3.2.2)
@@ -883,10 +884,6 @@ package Iirs is
--
-- Get/Set_Package_Origin (Field7)
--
- -- Chain of bodies for package instantiation. Present only in certain
- -- conditions.
- -- Get/Set_Package_Instantiation_Bodies_Chain (Field8)
- --
-- If true, the package need a body.
-- Get/Set_Need_Body (Flag1)
--
@@ -896,10 +893,10 @@ package Iirs is
-- type.
-- Get/Set_Macro_Expanded_Flag (Flag2)
--
- -- True if the package declaration has the package has at least one
- -- package instantiation declaration whose uninstantiated declaration
- -- needs both a body and macro-expansion. In that case, the instantiation
- -- needs macro-expansion of their body.
+ -- True if the package declaration at least one package instantiation
+ -- declaration whose uninstantiated declaration needs both a body and
+ -- macro-expansion. In that case, the instantiation needs macro-expansion
+ -- of their body.
-- Get/Set_Need_Instance_Bodies (Flag3)
--
-- Get/Set_Visible_Flag (Flag4)
@@ -4719,6 +4716,11 @@ package Iirs is
Iir_Predefined_None ..
Iir_Predefined_Functions'Last;
+ -- Explicit known subprograms (from ieee)
+ subtype Iir_Predefined_IEEE_Explicit is Iir_Predefined_Functions range
+ Iir_Predefined_Functions'Succ (Iir_Predefined_None) ..
+ Iir_Predefined_Functions'Last;
+
-- Staticness as defined by LRM93 6.1 and 7.4
type Iir_Staticness is (Unknown, None, Globally, Locally);
@@ -6008,10 +6010,6 @@ package Iirs is
function Get_Package_Body (Pkg : Iir) return Iir;
procedure Set_Package_Body (Pkg : Iir; Decl : Iir);
- -- Field: Field8 Chain
- function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir;
- procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir);
-
-- Field: Flag1
function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean;
procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean);
@@ -6929,11 +6927,11 @@ package Iirs is
-- Unless the formal is an unconstrained array type, this is the same as
-- the formal type.
-- Subtype indiciation for a type association.
- -- Field: Field3 Ref
+ -- Field: Field5 Ref
function Get_Actual_Type (Target : Iir) return Iir;
procedure Set_Actual_Type (Target : Iir; Atype : Iir);
- -- Field: Field5
+ -- Field: Field3
function Get_Actual_Type_Definition (Target : Iir) return Iir;
procedure Set_Actual_Type_Definition (Target : Iir; Atype : Iir);
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 5495e6057..99ce824e9 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -376,7 +376,8 @@ package body Iirs_Utils is
El := Formal;
loop
case Get_Kind (El) is
- when Iir_Kind_Simple_Name =>
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Operator_Symbol =>
return Get_Named_Entity (El);
when Iir_Kinds_Interface_Declaration =>
return El;
@@ -425,7 +426,8 @@ package body Iirs_Utils is
if Formal /= Null_Iir then
-- Strip denoting name
case Get_Kind (Formal) is
- when Iir_Kind_Simple_Name =>
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Operator_Symbol =>
return Get_Named_Entity (Formal);
when Iir_Kinds_Interface_Declaration =>
-- Shouldn't happen.
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 67a25689b..65917b4aa 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -93,7 +93,6 @@ package body Nodes_Meta is
Field_Entity_Name => Type_Iir,
Field_Package => Type_Iir,
Field_Package_Body => Type_Iir,
- Field_Package_Instantiation_Bodies_Chain => Type_Iir,
Field_Need_Body => Type_Boolean,
Field_Macro_Expanded_Flag => Type_Boolean,
Field_Need_Instance_Bodies => Type_Boolean,
@@ -500,8 +499,6 @@ package body Nodes_Meta is
return "package";
when Field_Package_Body =>
return "package_body";
- when Field_Package_Instantiation_Bodies_Chain =>
- return "package_instantiation_bodies_chain";
when Field_Need_Body =>
return "need_body";
when Field_Macro_Expanded_Flag =>
@@ -1690,8 +1687,6 @@ package body Nodes_Meta is
return Attr_Ref;
when Field_Package_Body =>
return Attr_Forward_Ref;
- when Field_Package_Instantiation_Bodies_Chain =>
- return Attr_Chain;
when Field_Need_Body =>
return Attr_None;
when Field_Macro_Expanded_Flag =>
@@ -2345,6 +2340,7 @@ package body Nodes_Meta is
Field_Chain,
Field_Actual,
Field_Subprogram_Association_Chain,
+ Field_Actual_Type,
-- Iir_Kind_Association_Element_Subprogram
Field_Whole_Association_Flag,
Field_Collapse_Signal_Flag,
@@ -2764,7 +2760,6 @@ package body Nodes_Meta is
Field_Attribute_Value_Chain,
Field_Package_Body,
Field_Package_Origin,
- Field_Package_Instantiation_Bodies_Chain,
-- Iir_Kind_Package_Instantiation_Declaration
Field_Identifier,
Field_Visible_Flag,
@@ -4352,61 +4347,61 @@ package body Nodes_Meta is
Iir_Kind_Association_Element_By_Individual => 111,
Iir_Kind_Association_Element_Open => 116,
Iir_Kind_Association_Element_Package => 121,
- Iir_Kind_Association_Element_Type => 127,
- Iir_Kind_Association_Element_Subprogram => 132,
- Iir_Kind_Choice_By_Others => 137,
- Iir_Kind_Choice_By_Expression => 144,
- Iir_Kind_Choice_By_Range => 151,
- Iir_Kind_Choice_By_None => 156,
- Iir_Kind_Choice_By_Name => 162,
- Iir_Kind_Entity_Aspect_Entity => 164,
- Iir_Kind_Entity_Aspect_Configuration => 165,
- Iir_Kind_Entity_Aspect_Open => 165,
- Iir_Kind_Block_Configuration => 171,
- Iir_Kind_Block_Header => 175,
- Iir_Kind_Component_Configuration => 182,
- Iir_Kind_Binding_Indication => 186,
- Iir_Kind_Entity_Class => 188,
- Iir_Kind_Attribute_Value => 196,
- Iir_Kind_Signature => 199,
- Iir_Kind_Aggregate_Info => 206,
- Iir_Kind_Procedure_Call => 210,
- Iir_Kind_Record_Element_Constraint => 216,
- Iir_Kind_Array_Element_Resolution => 218,
- Iir_Kind_Record_Resolution => 219,
- Iir_Kind_Record_Element_Resolution => 222,
- Iir_Kind_Attribute_Specification => 230,
- Iir_Kind_Disconnection_Specification => 236,
- Iir_Kind_Configuration_Specification => 242,
- Iir_Kind_Access_Type_Definition => 250,
- Iir_Kind_Incomplete_Type_Definition => 258,
- Iir_Kind_Interface_Type_Definition => 265,
- Iir_Kind_File_Type_Definition => 272,
- Iir_Kind_Protected_Type_Declaration => 281,
- Iir_Kind_Record_Type_Definition => 291,
- Iir_Kind_Array_Type_Definition => 303,
- Iir_Kind_Array_Subtype_Definition => 318,
- Iir_Kind_Record_Subtype_Definition => 329,
- Iir_Kind_Access_Subtype_Definition => 337,
- Iir_Kind_Physical_Subtype_Definition => 347,
- Iir_Kind_Floating_Subtype_Definition => 358,
- Iir_Kind_Integer_Subtype_Definition => 368,
- Iir_Kind_Enumeration_Subtype_Definition => 378,
- Iir_Kind_Enumeration_Type_Definition => 388,
- Iir_Kind_Integer_Type_Definition => 396,
- Iir_Kind_Floating_Type_Definition => 404,
- Iir_Kind_Physical_Type_Definition => 415,
- Iir_Kind_Range_Expression => 423,
- Iir_Kind_Protected_Type_Body => 430,
- Iir_Kind_Wildcard_Type_Definition => 435,
- Iir_Kind_Subtype_Definition => 440,
- Iir_Kind_Scalar_Nature_Definition => 444,
- Iir_Kind_Overload_List => 445,
- Iir_Kind_Type_Declaration => 452,
- Iir_Kind_Anonymous_Type_Declaration => 458,
- Iir_Kind_Subtype_Declaration => 465,
- Iir_Kind_Nature_Declaration => 471,
- Iir_Kind_Subnature_Declaration => 477,
+ Iir_Kind_Association_Element_Type => 128,
+ Iir_Kind_Association_Element_Subprogram => 133,
+ Iir_Kind_Choice_By_Others => 138,
+ Iir_Kind_Choice_By_Expression => 145,
+ Iir_Kind_Choice_By_Range => 152,
+ Iir_Kind_Choice_By_None => 157,
+ Iir_Kind_Choice_By_Name => 163,
+ Iir_Kind_Entity_Aspect_Entity => 165,
+ Iir_Kind_Entity_Aspect_Configuration => 166,
+ Iir_Kind_Entity_Aspect_Open => 166,
+ Iir_Kind_Block_Configuration => 172,
+ Iir_Kind_Block_Header => 176,
+ Iir_Kind_Component_Configuration => 183,
+ Iir_Kind_Binding_Indication => 187,
+ Iir_Kind_Entity_Class => 189,
+ Iir_Kind_Attribute_Value => 197,
+ Iir_Kind_Signature => 200,
+ Iir_Kind_Aggregate_Info => 207,
+ Iir_Kind_Procedure_Call => 211,
+ Iir_Kind_Record_Element_Constraint => 217,
+ Iir_Kind_Array_Element_Resolution => 219,
+ Iir_Kind_Record_Resolution => 220,
+ Iir_Kind_Record_Element_Resolution => 223,
+ Iir_Kind_Attribute_Specification => 231,
+ Iir_Kind_Disconnection_Specification => 237,
+ Iir_Kind_Configuration_Specification => 243,
+ Iir_Kind_Access_Type_Definition => 251,
+ Iir_Kind_Incomplete_Type_Definition => 259,
+ Iir_Kind_Interface_Type_Definition => 266,
+ Iir_Kind_File_Type_Definition => 273,
+ Iir_Kind_Protected_Type_Declaration => 282,
+ Iir_Kind_Record_Type_Definition => 292,
+ Iir_Kind_Array_Type_Definition => 304,
+ Iir_Kind_Array_Subtype_Definition => 319,
+ Iir_Kind_Record_Subtype_Definition => 330,
+ Iir_Kind_Access_Subtype_Definition => 338,
+ Iir_Kind_Physical_Subtype_Definition => 348,
+ Iir_Kind_Floating_Subtype_Definition => 359,
+ Iir_Kind_Integer_Subtype_Definition => 369,
+ Iir_Kind_Enumeration_Subtype_Definition => 379,
+ Iir_Kind_Enumeration_Type_Definition => 389,
+ Iir_Kind_Integer_Type_Definition => 397,
+ Iir_Kind_Floating_Type_Definition => 405,
+ Iir_Kind_Physical_Type_Definition => 416,
+ Iir_Kind_Range_Expression => 424,
+ Iir_Kind_Protected_Type_Body => 431,
+ Iir_Kind_Wildcard_Type_Definition => 436,
+ Iir_Kind_Subtype_Definition => 441,
+ Iir_Kind_Scalar_Nature_Definition => 445,
+ Iir_Kind_Overload_List => 446,
+ Iir_Kind_Type_Declaration => 453,
+ Iir_Kind_Anonymous_Type_Declaration => 459,
+ Iir_Kind_Subtype_Declaration => 466,
+ Iir_Kind_Nature_Declaration => 472,
+ Iir_Kind_Subnature_Declaration => 478,
Iir_Kind_Package_Declaration => 492,
Iir_Kind_Package_Instantiation_Declaration => 505,
Iir_Kind_Package_Body => 513,
@@ -5018,8 +5013,6 @@ package body Nodes_Meta is
return Get_Package (N);
when Field_Package_Body =>
return Get_Package_Body (N);
- when Field_Package_Instantiation_Bodies_Chain =>
- return Get_Package_Instantiation_Bodies_Chain (N);
when Field_Block_Configuration =>
return Get_Block_Configuration (N);
when Field_Concurrent_Statement_Chain =>
@@ -5418,8 +5411,6 @@ package body Nodes_Meta is
Set_Package (N, V);
when Field_Package_Body =>
Set_Package_Body (N, V);
- when Field_Package_Instantiation_Bodies_Chain =>
- Set_Package_Instantiation_Bodies_Chain (N, V);
when Field_Block_Configuration =>
Set_Block_Configuration (N, V);
when Field_Concurrent_Statement_Chain =>
@@ -7047,12 +7038,6 @@ package body Nodes_Meta is
end case;
end Has_Package_Body;
- function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind)
- return Boolean is
- begin
- return K = Iir_Kind_Package_Declaration;
- end Has_Package_Instantiation_Bodies_Chain;
-
function Has_Need_Body (K : Iir_Kind) return Boolean is
begin
return K = Iir_Kind_Package_Declaration;
@@ -9802,7 +9787,13 @@ package body Nodes_Meta is
function Has_Actual_Type (K : Iir_Kind) return Boolean is
begin
- return K = Iir_Kind_Association_Element_By_Individual;
+ case K is
+ when Iir_Kind_Association_Element_By_Individual
+ | Iir_Kind_Association_Element_Type =>
+ return True;
+ when others =>
+ return False;
+ end case;
end Has_Actual_Type;
function Has_Actual_Type_Definition (K : Iir_Kind) return Boolean is
diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads
index ddd23ed79..0400f4025 100644
--- a/src/vhdl/nodes_meta.ads
+++ b/src/vhdl/nodes_meta.ads
@@ -133,7 +133,6 @@ package Nodes_Meta is
Field_Entity_Name,
Field_Package,
Field_Package_Body,
- Field_Package_Instantiation_Bodies_Chain,
Field_Need_Body,
Field_Macro_Expanded_Flag,
Field_Need_Instance_Bodies,
@@ -640,8 +639,6 @@ package Nodes_Meta is
function Has_Entity_Name (K : Iir_Kind) return Boolean;
function Has_Package (K : Iir_Kind) return Boolean;
function Has_Package_Body (K : Iir_Kind) return Boolean;
- function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind)
- return Boolean;
function Has_Need_Body (K : Iir_Kind) return Boolean;
function Has_Macro_Expanded_Flag (K : Iir_Kind) return Boolean;
function Has_Need_Instance_Bodies (K : Iir_Kind) return Boolean;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 99c459027..31af2556d 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -3162,7 +3162,7 @@ package body Parse is
Set_Minus_Terminal (First, Parse_Name);
end if;
when others =>
- Error_Msg_Parse ("missign type or across/throught aspect "
+ Error_Msg_Parse ("missing type or across/throught aspect "
& "in quantity declaration");
Eat_Tokens_Until_Semi_Colon;
raise Expect_Error;
@@ -3271,7 +3271,7 @@ package body Parse is
if Current_Token /= Tok_Comma then
case Current_Token is
when Tok_Assign =>
- Error_Msg_Parse ("missign type in " & Disp_Name (Kind));
+ Error_Msg_Parse ("missing type in " & Disp_Name (Kind));
exit;
when others =>
Error_Msg_Parse
@@ -6642,23 +6642,27 @@ package body Parse is
return Res;
end Parse_Process_Statement;
- procedure Check_Formal_Form (Formal : Iir) is
+ function Check_Formal_Form (Formal : Iir) return Iir is
begin
if Formal = Null_Iir then
- return;
+ return Formal;
end if;
case Get_Kind (Formal) is
when Iir_Kind_Simple_Name
| Iir_Kind_Slice_Name
| Iir_Kind_Selected_Name =>
- null;
+ return Formal;
when Iir_Kind_Parenthesis_Name =>
-- Could be an indexed name, so nothing to check within the
-- parenthesis.
- null;
+ return Formal;
+ when Iir_Kind_String_Literal8 =>
+ -- Operator designator
+ return String_To_Operator_Symbol (Formal);
when others =>
- Error_Msg_Parse (+Formal, "incorrect formal name");
+ Error_Msg_Parse (+Formal, "incorrect formal name ignored");
+ return Null_Iir;
end case;
end Check_Formal_Form;
@@ -6736,10 +6740,8 @@ package body Parse is
end if;
when Tok_Double_Arrow =>
- Formal := Actual;
-
-- Check that FORMAL is a name and not an expression.
- Check_Formal_Form (Formal);
+ Formal := Check_Formal_Form (Actual);
-- Skip '=>'
Scan;
@@ -6805,8 +6807,13 @@ package body Parse is
function Parse_Generic_Map_Aspect return Iir is
begin
Expect (Tok_Generic);
+
+ -- Skip 'generic'.
Scan_Expect (Tok_Map);
+
+ -- Skip 'map'.
Scan;
+
return Parse_Association_List_In_Parenthesis;
end Parse_Generic_Map_Aspect;
@@ -8539,6 +8546,10 @@ package body Parse is
if Current_Token = Tok_Generic then
Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+ elsif Current_Token = Tok_Left_Paren then
+ Error_Msg_Parse ("missing 'generic map'");
+ Set_Generic_Map_Aspect_Chain
+ (Res, Parse_Association_List_In_Parenthesis);
end if;
Expect (Tok_Semi_Colon);
diff --git a/src/vhdl/parse.ads b/src/vhdl/parse.ads
index ea7c56cf0..41f22a3fd 100644
--- a/src/vhdl/parse.ads
+++ b/src/vhdl/parse.ads
@@ -36,6 +36,10 @@ package Parse is
Len : Nat32;
Loc : Location_Type) return Name_Id;
+ -- Convert string literal STR to an operator symbol.
+ -- Emit an error message if the string is not an operator name.
+ function String_To_Operator_Symbol (Str : Iir) return Iir;
+
-- Parse a single design unit.
-- The scanner must have been initialized, however, the current_token
-- shouldn't have been set.
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index 40fe9a4e7..d9039fcc6 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -905,13 +905,60 @@ package body Scanner is
end if;
end if;
end;
- end if;
- if Vhdl_Std > Vhdl_87 and then C = '\' then
+ elsif Vhdl_Std > Vhdl_87 and then C = '\' then
-- Start of extended identifier. Cannot follow an identifier.
Error_Separator;
end if;
- when Invalid
- | Format_Effector
+
+ when Invalid =>
+ -- Improve error message for use of UTF-8 quote marks.
+ -- It's possible because in the sequence of UTF-8 bytes for the
+ -- quote marks, there are invalid character (in the 128-160
+ -- range).
+ if C = Character'Val (16#80#)
+ and then Nam_Buffer (Len) = Character'Val (16#e2#)
+ and then (Source (Pos + 1) = Character'Val (16#98#)
+ or else Source (Pos + 1) = Character'Val (16#99#))
+ then
+ -- UTF-8 left or right single quote mark.
+ if Len > 1 then
+ -- The first byte (0xe2) is part of the identifier. An
+ -- error will be detected as the next byte (0x80) is
+ -- invalid. Remove the first byte from the identifier, and
+ -- let's catch the error later.
+ Nam_Length := Len - 1;
+ Pos := Pos - 1;
+ else
+ Error_Msg_Scan ("invalid use of UTF8 character for '");
+ Pos := Pos + 2;
+
+ -- Distinguish between character literal and tick. Don't
+ -- care about possible invalid character literal, as in any
+ -- case we have already emitted an error message.
+ if Current_Context.Prev_Token /= Tok_Identifier
+ and then Current_Context.Prev_Token /= Tok_Character
+ and then
+ (Source (Pos + 1) = '''
+ or else
+ (Source (Pos + 1) = Character'Val (16#e2#)
+ and then Source (Pos + 2) = Character'Val (16#80#)
+ and then Source (Pos + 3) = Character'Val (16#99#)))
+ then
+ Current_Token := Tok_Character;
+ Current_Context.Identifier :=
+ Name_Table.Get_Identifier (Source (Pos));
+ if Source (Pos + 1) = ''' then
+ Pos := Pos + 2;
+ else
+ Pos := Pos + 4;
+ end if;
+ else
+ Current_Token := Tok_Tick;
+ end if;
+ return;
+ end if;
+ end if;
+ when Format_Effector
| Space_Character =>
null;
end case;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 1664d67e1..39916bb76 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -1479,6 +1479,12 @@ package body Sem is
when Iir_Kinds_Monadic_Operator =>
return Are_Trees_Equal (Get_Operand (Left), Get_Operand (Right));
+ when Iir_Kind_Function_Call =>
+ return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right))
+ and then
+ Are_Trees_Chain_Equal (Get_Parameter_Association_Chain (Left),
+ Get_Parameter_Association_Chain (Right));
+
when Iir_Kind_Access_Type_Definition
| Iir_Kind_Record_Type_Definition
| Iir_Kind_Array_Type_Definition
@@ -2867,9 +2873,14 @@ package body Sem is
-- FIXME: unless the parent is a package declaration library unit, the
-- design unit depends on the body.
- if Get_Need_Body (Pkg) then
- Bod := Libraries.Load_Secondary_Unit
- (Get_Design_Unit (Pkg), Null_Identifier, Decl);
+ if Get_Need_Body (Pkg) and then not Is_Nested_Package (Pkg) then
+ Bod := Get_Package_Body (Pkg);
+ if Is_Null (Bod) then
+ Bod := Libraries.Load_Secondary_Unit
+ (Get_Design_Unit (Pkg), Null_Identifier, Decl);
+ else
+ Bod := Get_Design_Unit (Bod);
+ end if;
if Is_Null (Bod) then
Error_Msg_Sem (+Decl, "cannot find package body of %n", +Pkg);
else
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index af573ae3b..b85050ff3 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -20,6 +20,7 @@ with Errorout; use Errorout;
with Flags; use Flags;
with Types; use Types;
with Iirs_Utils; use Iirs_Utils;
+with Parse;
with Std_Names;
with Sem_Names; use Sem_Names;
with Sem_Types;
@@ -33,20 +34,61 @@ package body Sem_Assocs is
return Iir
is
N_Assoc : Iir;
+ Actual : Iir;
begin
+ Actual := Get_Actual (Assoc);
case Get_Kind (Inter) is
when Iir_Kind_Interface_Package_Declaration =>
N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package);
when Iir_Kind_Interface_Type_Declaration =>
N_Assoc := Create_Iir (Iir_Kind_Association_Element_Type);
+ if Get_Kind (Actual) = Iir_Kind_Parenthesis_Name then
+ -- Convert parenthesis name to array subtype.
+ declare
+ N_Actual : Iir;
+ Sub_Assoc : Iir;
+ Indexes : Iir_List;
+ Old : Iir;
+ begin
+ N_Actual := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+ Location_Copy (N_Actual, Actual);
+ Set_Subtype_Type_Mark (N_Actual, Get_Prefix (Actual));
+ Sub_Assoc := Get_Association_Chain (Actual);
+ Indexes := Create_Iir_List;
+ Set_Index_Constraint_List (N_Actual, Indexes);
+ while Is_Valid (Sub_Assoc) loop
+ if Get_Kind (Sub_Assoc)
+ /= Iir_Kind_Association_Element_By_Expression
+ then
+ Error_Msg_Sem
+ (+Sub_Assoc, "index constraint must be a range");
+ else
+ if Get_Formal (Sub_Assoc) /= Null_Iir then
+ Error_Msg_Sem
+ (+Sub_Assoc, "formal part not allowed");
+ end if;
+ Append_Element (Indexes, Get_Actual (Sub_Assoc));
+ end if;
+ Old := Sub_Assoc;
+ Sub_Assoc := Get_Chain (Sub_Assoc);
+ Free_Iir (Old);
+ end loop;
+ Old := Actual;
+ Free_Iir (Old);
+ Actual := N_Actual;
+ end;
+ end if;
when Iir_Kinds_Interface_Subprogram_Declaration =>
N_Assoc := Create_Iir (Iir_Kind_Association_Element_Subprogram);
+ if Get_Kind (Actual) = Iir_Kind_String_Literal8 then
+ Actual := Parse.String_To_Operator_Symbol (Actual);
+ end if;
when others =>
Error_Kind ("rewrite_non_object_association", Inter);
end case;
Location_Copy (N_Assoc, Assoc);
Set_Formal (N_Assoc, Get_Formal (Assoc));
- Set_Actual (N_Assoc, Get_Actual (Assoc));
+ Set_Actual (N_Assoc, Actual);
Set_Chain (N_Assoc, Get_Chain (Assoc));
Set_Whole_Association_Flag (N_Assoc, True);
Free_Iir (Assoc);
@@ -69,18 +111,20 @@ package body Sem_Assocs is
Res := Null_Iir;
-- Common case: only objects in interfaces.
- while Inter /= Null_Iir loop
+ while Is_Valid (Inter) loop
exit when Get_Kind (Inter)
not in Iir_Kinds_Interface_Object_Declaration;
Inter := Get_Chain (Inter);
end loop;
- if Inter = Null_Iir then
+ if Is_Null (Inter) then
+ -- Only interface object, nothing to to.
return Assoc_Chain;
end if;
+ Inter := Inter_Chain;
loop
-- Don't try to detect errors.
- if Assoc = Null_Iir then
+ if Is_Null (Assoc) then
return Res;
end if;
@@ -97,7 +141,8 @@ package body Sem_Assocs is
Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
end if;
else
- if Get_Kind (Formal) = Iir_Kind_Simple_Name then
+ if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
+ then
-- A candidate. Search the corresponding interface.
Inter := Find_Name_In_Chain
(Inter_Chain, Get_Identifier (Formal));
@@ -120,6 +165,9 @@ package body Sem_Assocs is
end if;
Prev_Assoc := Assoc;
Assoc := Get_Chain (Assoc);
+ if Is_Valid (Inter) then
+ Inter := Get_Chain (Inter);
+ end if;
end loop;
end Extract_Non_Object_Association;
@@ -1288,7 +1336,8 @@ package body Sem_Assocs is
Formal_Type : Iir;
begin
case Get_Kind (Formal) is
- when Iir_Kind_Simple_Name =>
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Operator_Symbol =>
-- Certainly the most common case: FORMAL_NAME => VAL.
-- It is also the easiest. So, handle it completly now.
if Get_Identifier (Formal) = Get_Identifier (Inter) then
@@ -1522,7 +1571,7 @@ package body Sem_Assocs is
-- Can be associated only once
Match := Fully_Compatible;
else
- if Get_Kind (Formal) = Iir_Kind_Simple_Name
+ if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
and then Get_Identifier (Formal) = Get_Identifier (Inter)
then
Match := Fully_Compatible;
@@ -1537,7 +1586,6 @@ package body Sem_Assocs is
Formal : constant Iir := Get_Formal (Assoc);
begin
if Formal /= Null_Iir then
- pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name);
pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter));
Set_Named_Entity (Formal, Inter);
Set_Base_Name (Formal, Inter);
@@ -1610,14 +1658,12 @@ package body Sem_Assocs is
end Sem_Association_Package;
-- Create an implicit association_element_subprogram for the declaration
- -- of function ID for ACTUAL (a name of a type).
+ -- of function ID for ACTUAL_Type (a type/subtype definition).
function Sem_Implicit_Operator_Association
- (Id : Name_Id; Actual : Iir) return Iir
+ (Id : Name_Id; Actual_Type : Iir; Actual_Name : Iir) return Iir
is
use Sem_Scopes;
- Atype : constant Iir := Get_Type (Actual);
-
-- Return TRUE if DECL is a function declaration with a comparaison
-- operator profile.
function Has_Comparaison_Profile (Decl : Iir) return Boolean
@@ -1641,7 +1687,8 @@ package body Sem_Assocs is
if Inter = Null_Iir then
return False;
end if;
- if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Atype) then
+ if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Actual_Type)
+ then
return False;
end if;
Inter := Get_Chain (Inter);
@@ -1661,16 +1708,17 @@ package body Sem_Assocs is
Decl := Get_Declaration (Interp);
if Has_Comparaison_Profile (Decl) then
Res := Create_Iir (Iir_Kind_Association_Element_Subprogram);
- Location_Copy (Res, Actual);
- Set_Actual (Res, Build_Simple_Name (Decl, Get_Location (Actual)));
+ Location_Copy (Res, Actual_Name);
+ Set_Actual
+ (Res, Build_Simple_Name (Decl, Get_Location (Actual_Name)));
Set_Use_Flag (Decl, True);
return Res;
end if;
Interp := Get_Next_Interpretation (Interp);
end loop;
- Error_Msg_Sem (+Actual, "cannot find a %i declaration for type %i",
- (+Id, +Actual));
+ Error_Msg_Sem (+Actual_Name, "cannot find a %i declaration for type %i",
+ (+Id, +Actual_Name));
return Null_Iir;
end Sem_Implicit_Operator_Association;
@@ -1681,6 +1729,7 @@ package body Sem_Assocs is
is
Inter_Def : constant Iir := Get_Type (Inter);
Actual : Iir;
+ Actual_Type : Iir;
Op_Eq, Op_Neq : Iir;
begin
if not Finish then
@@ -1701,15 +1750,21 @@ package body Sem_Assocs is
-- 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));
+ if Get_Kind (Actual) in Iir_Kinds_Subtype_Definition then
+ Actual_Type := Actual;
+ else
+ Actual_Type := Get_Type (Actual);
+ end if;
+ Set_Actual_Type (Assoc, Actual_Type);
+ Set_Associated_Type (Inter_Def, Actual_Type);
-- FIXME: it is not clear at all from the LRM how the implicit
-- associations are done...
Op_Eq := Sem_Implicit_Operator_Association
- (Std_Names.Name_Op_Equality, Actual);
+ (Std_Names.Name_Op_Equality, Actual_Type, Actual);
if Op_Eq /= Null_Iir then
Op_Neq := Sem_Implicit_Operator_Association
- (Std_Names.Name_Op_Inequality, Actual);
+ (Std_Names.Name_Op_Inequality, Actual_Type, Actual);
Set_Chain (Op_Eq, Op_Neq);
Set_Subprogram_Association_Chain (Assoc, Op_Eq);
end if;
@@ -1838,11 +1893,11 @@ package body Sem_Assocs is
end if;
when Iir_Kind_Overload_List =>
declare
- First_Error : Boolean;
+ Nbr_Errors : Natural;
List : Iir_List;
El, R : Iir;
begin
- First_Error := True;
+ Nbr_Errors := 0;
R := Null_Iir;
List := Get_Overload_List (Res);
for I in Natural loop
@@ -1852,18 +1907,18 @@ package body Sem_Assocs is
if Is_Null (R) then
R := El;
else
- if First_Error then
+ if Nbr_Errors = 0 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;
+ Nbr_Errors := Nbr_Errors + 1;
end if;
end if;
end loop;
@@ -1881,7 +1936,7 @@ package body Sem_Assocs is
end loop;
end if;
return;
- elsif First_Error then
+ elsif Nbr_Errors > 0 then
return;
end if;
Free_Overload_List (Res);
@@ -1892,6 +1947,7 @@ package body Sem_Assocs is
end case;
Set_Named_Entity (Actual, Res);
+ Xrefs.Xref_Name (Actual);
Set_Use_Flag (Res, True);
end Sem_Association_Subprogram;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 9fac6d50e..e75092a33 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -444,6 +444,7 @@ package body Sem_Decls is
Set_Return_Type (Operation, Return_Type);
Set_Identifier (Operation, Name);
Set_Visible_Flag (Operation, True);
+ Set_Pure_Flag (Operation, True);
Compute_Subprogram_Hash (Operation);
return Operation;
end Create_Implicit_Interface_Function;
@@ -489,6 +490,7 @@ package body Sem_Decls is
procedure Sem_Interface_Subprogram_Declaration (Inter : Iir) is
begin
Sem_Subprogram_Specification (Inter);
+ Xref_Decl (Inter);
end Sem_Interface_Subprogram_Declaration;
procedure Sem_Interface_Chain (Interface_Chain: Iir;
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 9807fc24a..545d3937a 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -967,8 +967,7 @@ package body Sem_Expr is
-- Check purity rules when SUBPRG calls CALLEE.
-- Both SUBPRG and CALLEE are subprogram declarations.
-- Update purity_state/impure_depth of SUBPRG if it is a procedure.
- procedure Sem_Call_Purity_Check (Subprg : Iir; Callee : Iir; Loc : Iir)
- is
+ procedure Sem_Call_Purity_Check (Subprg : Iir; Callee : Iir; Loc : Iir) is
begin
if Callee = Subprg then
return;
@@ -991,7 +990,8 @@ package body Sem_Expr is
end case;
case Get_Kind (Callee) is
- when Iir_Kind_Function_Declaration =>
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration =>
if Get_Pure_Flag (Callee) then
-- Pure functions may be called anywhere.
return;
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index 147073063..bbe5ad4d7 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -21,6 +21,7 @@ with Types; use Types;
with Files_Map;
with Iirs_Utils; use Iirs_Utils;
with Errorout; use Errorout;
+with Sem;
package body Sem_Inst is
-- Table of origin. This is an extension of vhdl nodes to track the
@@ -573,7 +574,7 @@ package body Sem_Inst is
when Iir_Kind_Interface_Type_Declaration =>
Set_Type (Res, Get_Type (Inter));
when Iir_Kinds_Interface_Subprogram_Declaration =>
- null;
+ Sem.Compute_Subprogram_Hash (Res);
when others =>
Error_Kind ("instantiate_generic_chain", Res);
end case;
@@ -740,7 +741,8 @@ package body Sem_Inst is
if Is_Valid (Formal) then
loop
case Get_Kind (Formal) is
- when Iir_Kind_Simple_Name =>
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Operator_Symbol =>
Set_Named_Entity
(Formal, Get_Instance (Get_Named_Entity (Formal)));
exit;
@@ -782,7 +784,7 @@ package body Sem_Inst is
declare
Inter_Type_Def : constant Iir :=
Get_Type (Get_Association_Interface (Assoc, Inter));
- Actual_Type : constant Iir := Get_Type (Get_Actual (Assoc));
+ Actual_Type : constant Iir := Get_Actual_Type (Assoc);
begin
Set_Instance (Inter_Type_Def, Actual_Type);
end;
@@ -861,8 +863,7 @@ package body Sem_Inst is
function Instantiate_Package_Body (Inst : Iir) return Iir
is
- Inst_Decl : constant Iir := Get_Package_Origin (Inst);
- Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inst_Decl);
+ Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inst);
Prev_Instance_File : constant Source_File_Entry := Instance_File;
Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
Res : Iir;
@@ -877,7 +878,6 @@ package body Sem_Inst is
Set_Instance (Pkg, Inst);
declare
Pkg_Hdr : constant Iir := Get_Package_Header (Pkg);
- Inst_Hdr : constant Iir := Get_Package_Header (Inst);
Pkg_El : Iir;
Inst_El : Iir;
Inter_El : Iir;
@@ -886,7 +886,7 @@ package body Sem_Inst is
-- In the body, references to interface object are redirected to the
-- instantiated interface objects.
Pkg_El := Get_Generic_Chain (Pkg_Hdr);
- Inst_El := Get_Generic_Chain (Inst_Hdr);
+ Inst_El := Get_Generic_Chain (Inst);
while Is_Valid (Pkg_El) loop
if Get_Kind (Pkg_El) in Iir_Kinds_Interface_Object_Declaration then
Set_Instance (Pkg_El, Inst_El);
@@ -897,8 +897,8 @@ package body Sem_Inst is
-- In the body, references to interface type are substitued to the
-- mapped type.
- Inst_El := Get_Generic_Map_Aspect_Chain (Inst_Hdr);
- Inter_El := Get_Generic_Chain (Inst_Hdr);
+ Inst_El := Get_Generic_Map_Aspect_Chain (Inst);
+ Inter_El := Get_Generic_Chain (Inst);
while Is_Valid (Inst_El) loop
case Get_Kind (Inst_El) is
when Iir_Kind_Association_Element_Type =>
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 26672b385..0d03b8d4f 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -386,7 +386,13 @@ package body Sem_Names is
| Iir_Kind_For_Generate_Statement =>
null;
when Iir_Kind_Package_Declaration =>
- null;
+ declare
+ Header : constant Iir := Get_Package_Header (Decl);
+ begin
+ if Is_Valid (Header) then
+ Iterator_Decl_Chain (Get_Generic_Chain (Header), Id);
+ end if;
+ end;
when Iir_Kind_Package_Instantiation_Declaration
| Iir_Kind_Interface_Package_Declaration =>
Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id);
@@ -2116,6 +2122,7 @@ package body Sem_Names is
-- LRM93 §6.3
-- This form of expanded name is only allowed within the
-- construct itself.
+ -- FIXME: LRM08 12.3 Visibility h)
if not Kind_In (Prefix,
Iir_Kind_Package_Declaration,
Iir_Kind_Package_Instantiation_Declaration)
@@ -2645,7 +2652,8 @@ package body Sem_Names is
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Interface_Procedure_Declaration =>
- Error_Msg_Sem (+Name, "function name is a procedure");
+ Error_Msg_Sem (+Name, "cannot call %n in an expression",
+ +Prefix);
when Iir_Kinds_Process_Statement
| Iir_Kind_Component_Declaration
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 015bca20d..6ed07c180 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -755,21 +755,19 @@ package body Trans.Chap2 is
Pop_Instance_Factory (Info.Package_Body_Scope'Access);
end Pop_Package_Instance_Factory;
- procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
+ -- Translate a package declaration or a macro-expanded package
+ -- instantiation. HEADER is the node containing generic and generic_map.
+ procedure Translate_Package (Decl : Iir; Header : Iir)
is
Is_Nested : constant Boolean := Is_Nested_Package (Decl);
- Header : constant Iir := Get_Package_Header (Decl);
+ Is_Uninstantiated : constant Boolean :=
+ Get_Kind (Decl) = Iir_Kind_Package_Declaration
+ and then Is_Uninstantiated_Package (Decl);
Mark : Id_Mark_Type;
Info : Ortho_Info_Acc;
Interface_List : O_Inter_List;
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
- Bod : Iir;
begin
- -- Skip uninstantiated package that have to be macro-expanded.
- if Get_Macro_Expanded_Flag (Decl) then
- return;
- end if;
-
Info := Add_Info (Decl, Kind_Package);
if Is_Nested then
@@ -777,7 +775,7 @@ package body Trans.Chap2 is
end if;
-- Translate declarations.
- if Is_Uninstantiated_Package (Decl) then
+ if Is_Uninstantiated then
-- Create an instance for the spec.
Push_Instance_Factory (Info.Package_Spec_Scope'Access);
Chap4.Translate_Generic_Chain (Header);
@@ -806,10 +804,6 @@ package body Trans.Chap2 is
Chap4.Translate_Generic_Chain (Header);
end if;
Chap4.Translate_Declaration_Chain (Decl);
- Bod := Get_Package_Instantiation_Bodies_Chain (Decl);
- if Is_Valid (Bod) then
- Chap4.Translate_Declaration_Chain (Bod);
- end if;
if not Is_Nested then
Info.Package_Elab_Var := Create_Var
(Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
@@ -821,10 +815,6 @@ package body Trans.Chap2 is
-- For nested package, this will be translated when translating
-- subprograms.
Chap4.Translate_Declaration_Chain_Subprograms (Decl);
- Bod := Get_Package_Instantiation_Bodies_Chain (Decl);
- if Is_Valid (Bod) then
- Chap4.Translate_Declaration_Chain_Subprograms (Bod);
- end if;
end if;
-- Declare elaborator for the body.
@@ -837,7 +827,7 @@ package body Trans.Chap2 is
(Interface_List, Info.Package_Elab_Body_Subprg);
end if;
- if Is_Uninstantiated_Package (Decl) then
+ if Is_Uninstantiated then
Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
-- The spec elaborator has a spec instance argument.
@@ -862,16 +852,16 @@ package body Trans.Chap2 is
if Global_Storage = O_Storage_Public then
-- Create elaboration procedure for the spec
- Elab_Package (Decl);
+ Elab_Package (Decl, Header);
end if;
end if;
- if Is_Uninstantiated_Package (Decl) then
+ if Is_Uninstantiated then
Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
end if;
Save_Local_Identifier (Info.Package_Local_Id);
- if Is_Uninstantiated_Package (Decl)
+ if Is_Uninstantiated
and then not Get_Need_Body (Decl)
and then Get_Package_Body (Decl) = Null_Iir
then
@@ -884,18 +874,58 @@ package body Trans.Chap2 is
if Is_Nested then
Pop_Identifier_Prefix (Mark);
end if;
+ end Translate_Package;
+
+ procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
+ is
+ El : Iir;
+ Bod : Iir;
+ begin
+ -- Skip uninstantiated package that have to be macro-expanded.
+ if Get_Macro_Expanded_Flag (Decl) then
+ return;
+ end if;
+
+ Translate_Package (Decl, Get_Package_Header (Decl));
+
+ if Global_Storage = O_Storage_Public then
+ -- If there are package instances declared that were macro-expanded
+ -- and if the package has (possibly) no body, translate the bodies
+ -- of the instances.
+ if Get_Need_Instance_Bodies (Decl)
+-- and not Get_Need_Body (Decl)
+ then
+ El := Get_Declaration_Chain (Decl);
+ while Is_Valid (El) loop
+ if Get_Kind (El) = Iir_Kind_Package_Instantiation_Declaration
+ then
+ Bod := Get_Package_Body (El);
+ if Is_Valid (Bod) then
+ Translate_Package_Body (Bod);
+ end if;
+ end if;
+ El := Get_Chain (El);
+ end loop;
+ end if;
+ end if;
end Translate_Package_Declaration;
procedure Translate_Package_Body (Bod : Iir_Package_Body)
is
Is_Nested : constant Boolean := Is_Nested_Package (Bod);
Spec : constant Iir_Package_Declaration := Get_Package (Bod);
+
+ -- True if the package spec is a package declaration. It could be a
+ -- package instantiation declaration.
+ Is_Spec_Decl : constant Boolean :=
+ Get_Kind (Spec) = Iir_Kind_Package_Declaration;
+
Info : constant Ortho_Info_Acc := Get_Info (Spec);
Prev_Storage : constant O_Storage := Global_Storage;
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
Mark : Id_Mark_Type;
begin
- if Get_Macro_Expanded_Flag (Spec) then
+ if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then
return;
end if;
@@ -904,7 +934,7 @@ package body Trans.Chap2 is
end if;
-- Translate declarations.
- if Is_Uninstantiated_Package (Spec) then
+ if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
Push_Package_Instance_Factory (Spec);
-- Translate the specifications.
@@ -921,7 +951,7 @@ package body Trans.Chap2 is
return;
end if;
- if not Is_Uninstantiated_Package (Spec) then
+ if not (Is_Spec_Decl and then Is_Uninstantiated_Package (Spec)) then
Restore_Local_Identifier (Info.Package_Local_Id);
Chap4.Translate_Declaration_Chain (Bod);
@@ -935,7 +965,7 @@ package body Trans.Chap2 is
Rtis.Generate_Unit (Bod);
end if;
- if Is_Uninstantiated_Package (Spec) then
+ if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
-- Add access to the specs.
Subprgs.Push_Subprg_Instance
(Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type,
@@ -945,13 +975,13 @@ package body Trans.Chap2 is
Info.Package_Body_Scope'Access);
end if;
- if not Is_Nested then
+ if not Is_Nested or else not Is_Spec_Decl then
-- Translate subprograms. For nested package, this has to be called
-- when translating subprograms.
Chap4.Translate_Declaration_Chain_Subprograms (Bod);
end if;
- if Is_Uninstantiated_Package (Spec) then
+ if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
Clear_Scope (Info.Package_Spec_Scope);
Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
end if;
@@ -967,7 +997,8 @@ package body Trans.Chap2 is
end if;
end Translate_Package_Body;
- procedure Elab_Package (Spec : Iir_Package_Declaration)
+ -- Elaborate a package or a package instantiation.
+ procedure Elab_Package (Spec : Iir; Header : Iir)
is
Is_Nested : constant Boolean := Is_Nested_Package (Spec);
Info : constant Ortho_Info_Acc := Get_Info (Spec);
@@ -982,8 +1013,8 @@ package body Trans.Chap2 is
Elab_Dependence (Get_Design_Unit (Spec));
- if not Is_Uninstantiated_Package (Spec)
- and then Get_Kind (Get_Parent (Spec)) = Iir_Kind_Design_Unit
+ if not (Get_Kind (Spec) = Iir_Kind_Package_Declaration
+ and then Is_Uninstantiated_Package (Spec))
then
-- Register the top level package. This is done dynamically, as
-- we know only during elaboration that the design depends on a
@@ -999,9 +1030,11 @@ package body Trans.Chap2 is
Open_Temp;
end if;
- if Is_Generic_Mapped_Package (Spec) then
+ if Is_Valid (Header)
+ and then Is_Valid (Get_Generic_Map_Aspect_Chain (Header))
+ then
Chap5.Elab_Generic_Map_Aspect
- (Get_Package_Header (Spec), Get_Package_Header (Spec),
+ (Header, Header,
(Info.Package_Spec_Scope'Access, Info.Package_Spec_Scope));
end if;
Chap4.Elab_Declaration_Chain (Spec, Final);
@@ -1017,16 +1050,23 @@ package body Trans.Chap2 is
procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir)
is
+ Is_Spec_Decl : constant Boolean :=
+ Get_Kind (Spec) = Iir_Kind_Package_Declaration;
+
Info : constant Ortho_Info_Acc := Get_Info (Spec);
If_Blk : O_If_Block;
Constr : O_Assoc_List;
Final : Boolean;
begin
+ if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then
+ return;
+ end if;
+
Start_Subprogram_Body (Info.Package_Elab_Body_Subprg);
Push_Local_Factory;
Subprgs.Start_Subprg_Instance_Use (Info.Package_Elab_Body_Instance);
- if Is_Uninstantiated_Package (Spec) then
+ if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
Set_Scope_Via_Field (Info.Package_Spec_Scope,
Info.Package_Spec_Field,
Info.Package_Body_Scope'Access);
@@ -1053,7 +1093,7 @@ package body Trans.Chap2 is
Close_Temp;
end if;
- if Is_Uninstantiated_Package (Spec) then
+ if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
Clear_Scope (Info.Package_Spec_Scope);
end if;
@@ -1346,8 +1386,25 @@ package body Trans.Chap2 is
Info : Ortho_Info_Acc;
Interface_List : O_Inter_List;
begin
- -- Canon must have replaced instatiation by generic-mapped packages.
- pragma Assert (not Get_Macro_Expanded_Flag (Spec));
+ if Get_Macro_Expanded_Flag (Spec) then
+ -- Macro-expanded instantiations are translated like a package.
+ Translate_Package (Inst, Inst);
+
+ -- For top-level package, generate code for the body.
+ if Global_Storage = O_Storage_Public
+ and then not Is_Nested_Package (Inst)
+ then
+ declare
+ Bod : constant Iir := Get_Package_Body (Inst);
+ begin
+ if Is_Valid (Bod) then
+ Translate_Package_Body (Bod);
+ end if;
+ end;
+ end if;
+
+ return;
+ end if;
Instantiate_Info_Package (Inst);
Info := Get_Info (Inst);
@@ -1402,6 +1459,11 @@ package body Trans.Chap2 is
Info : constant Ortho_Info_Acc := Get_Info (Inst);
Constr : O_Assoc_List;
begin
+ if Get_Macro_Expanded_Flag (Spec) then
+ Elab_Package (Inst, Inst);
+ return;
+ end if;
+
Set_Scope_Via_Var (Pkg_Info.Package_Body_Scope,
Info.Package_Instance_Body_Var);
@@ -1423,22 +1485,12 @@ package body Trans.Chap2 is
Clear_Scope (Pkg_Info.Package_Body_Scope);
end Elab_Package_Instantiation_Declaration;
- procedure Elab_Dependence_Package (Pkg : Iir_Package_Declaration)
+ procedure Elab_Dependence_Package (Pkg : Iir)
is
Info : Ortho_Info_Acc;
If_Blk : O_If_Block;
Constr : O_Assoc_List;
begin
- -- Std.Standard is pre-elaborated.
- if Pkg = Standard_Package then
- return;
- end if;
-
- -- Nothing to do for uninstantiated package.
- if Is_Uninstantiated_Package (Pkg) then
- return;
- end if;
-
-- Call the package elaborator only if not already elaborated.
Info := Get_Info (Pkg);
Start_If_Stmt
@@ -1451,13 +1503,36 @@ package body Trans.Chap2 is
Finish_If_Stmt (If_Blk);
end Elab_Dependence_Package;
- procedure Elab_Dependence_Package_Instantiation (Pkg : Iir)
- is
- Info : constant Ortho_Info_Acc := Get_Info (Pkg);
- Constr : O_Assoc_List;
+ procedure Elab_Dependence_Package_Declaration
+ (Pkg : Iir_Package_Declaration) is
begin
- Start_Association (Constr, Info.Package_Instance_Elab_Subprg);
- New_Procedure_Call (Constr);
+ -- Std.Standard is pre-elaborated.
+ if Pkg = Standard_Package then
+ return;
+ end if;
+
+ -- Nothing to do for uninstantiated package.
+ if Is_Uninstantiated_Package (Pkg) then
+ return;
+ end if;
+
+ Elab_Dependence_Package (Pkg);
+ end Elab_Dependence_Package_Declaration;
+
+ procedure Elab_Dependence_Package_Instantiation (Pkg : Iir) is
+ begin
+ if Get_Macro_Expanded_Flag (Get_Uninstantiated_Package_Decl (Pkg)) then
+ -- Handled as a normal package
+ Elab_Dependence_Package (Pkg);
+ else
+ declare
+ Info : constant Ortho_Info_Acc := Get_Info (Pkg);
+ Constr : O_Assoc_List;
+ begin
+ Start_Association (Constr, Info.Package_Instance_Elab_Subprg);
+ New_Procedure_Call (Constr);
+ end;
+ end if;
end Elab_Dependence_Package_Instantiation;
procedure Elab_Dependence (Design_Unit: Iir_Design_Unit)
@@ -1475,7 +1550,7 @@ package body Trans.Chap2 is
Library_Unit := Get_Library_Unit (Design);
case Get_Kind (Library_Unit) is
when Iir_Kind_Package_Declaration =>
- Elab_Dependence_Package (Library_Unit);
+ Elab_Dependence_Package_Declaration (Library_Unit);
when Iir_Kind_Package_Instantiation_Declaration =>
Elab_Dependence_Package_Instantiation (Library_Unit);
when Iir_Kind_Entity_Declaration =>
diff --git a/src/vhdl/translate/trans-chap2.ads b/src/vhdl/translate/trans-chap2.ads
index 74247d6e1..4d81c2bf6 100644
--- a/src/vhdl/translate/trans-chap2.ads
+++ b/src/vhdl/translate/trans-chap2.ads
@@ -35,7 +35,7 @@ package Trans.Chap2 is
procedure Translate_Package_Body (Bod : Iir_Package_Body);
procedure Translate_Package_Instantiation_Declaration (Inst : Iir);
- procedure Elab_Package (Spec : Iir_Package_Declaration);
+ procedure Elab_Package (Spec : Iir; Header : Iir);
procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir);
procedure Elab_Package_Instantiation_Declaration (Inst : Iir);
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 14d04d486..ba5853935 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2388,6 +2388,18 @@ package body Trans.Chap4 is
Translate_Declaration_Chain_Subprograms (El);
Pop_Identifier_Prefix (Mark);
end;
+ when Iir_Kind_Package_Instantiation_Declaration =>
+ if Get_Macro_Expanded_Flag
+ (Get_Uninstantiated_Package_Decl (El))
+ then
+ declare
+ Mark : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark, Get_Identifier (El));
+ Translate_Declaration_Chain_Subprograms (El);
+ Pop_Identifier_Prefix (Mark);
+ end;
+ end if;
when others =>
null;
end case;
@@ -2485,7 +2497,7 @@ package body Trans.Chap4 is
null;
when Iir_Kind_Package_Declaration =>
- Chap2.Elab_Package (Decl);
+ Chap2.Elab_Package (Decl, Get_Package_Header (Decl));
-- FIXME: finalizer
when Iir_Kind_Package_Body =>
declare
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 77c12a358..7623b5032 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -2302,24 +2302,30 @@ package body Trans.Rtis is
| Iir_Kind_Group_Declaration =>
null;
when Iir_Kind_Package_Declaration =>
- declare
- Mark : Id_Mark_Type;
- begin
- Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
- Generate_Block (Decl, Parent_Rti);
- Pop_Identifier_Prefix (Mark);
- end;
+ if Get_Info (Decl) /= null then
+ -- Do not generate RTIs for untranslated packages.
+ declare
+ Mark : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+ Generate_Block (Decl, Parent_Rti);
+ Pop_Identifier_Prefix (Mark);
+ end;
+ end if;
when Iir_Kind_Package_Body =>
- declare
- Mark : Id_Mark_Type;
- Mark1 : Id_Mark_Type;
- begin
- Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
- Push_Identifier_Prefix (Mark1, "BODY");
- Generate_Block (Decl, Parent_Rti);
- Pop_Identifier_Prefix (Mark1);
- Pop_Identifier_Prefix (Mark);
- end;
+ if Get_Info (Get_Package (Decl)) /= null then
+ -- Do not generate RTIs for untranslated packages.
+ declare
+ Mark : Id_Mark_Type;
+ Mark1 : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+ Push_Identifier_Prefix (Mark1, "BODY");
+ Generate_Block (Decl, Parent_Rti);
+ Pop_Identifier_Prefix (Mark1);
+ Pop_Identifier_Prefix (Mark);
+ end;
+ end if;
when Iir_Kind_Package_Instantiation_Declaration =>
-- FIXME: todo
@@ -2600,7 +2606,8 @@ package body Trans.Rtis is
Field_Off := O_Cnode_Null;
case Get_Kind (Blk) is
- when Iir_Kind_Package_Declaration =>
+ when Iir_Kind_Package_Declaration
+ | Iir_Kind_Package_Instantiation_Declaration =>
Kind := Ghdl_Rtik_Package;
Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
when Iir_Kind_Package_Body =>
@@ -2741,7 +2748,8 @@ package body Trans.Rtis is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Info.Process_Rti_Const := Rti;
- when Iir_Kind_Package_Declaration =>
+ when Iir_Kind_Package_Declaration
+ | Iir_Kind_Package_Instantiation_Declaration =>
Info.Package_Rti_Const := Rti;
when Iir_Kind_Package_Body =>
-- Replace package declaration RTI with the body one.
@@ -2855,8 +2863,9 @@ package body Trans.Rtis is
-- Compute parent RTI.
case Get_Kind (Lib_Unit) is
when Iir_Kind_Package_Declaration
- | Iir_Kind_Entity_Declaration
- | Iir_Kind_Configuration_Declaration =>
+ | Iir_Kind_Entity_Declaration
+ | Iir_Kind_Configuration_Declaration
+ | Iir_Kind_Package_Instantiation_Declaration =>
-- The library.
declare
Lib : Iir_Library_Declaration;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 1a4703f95..bc69661bb 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -289,6 +289,12 @@ package body Translation is
New_Debug_Comment_Decl
("package declaration " & Image_Identifier (Lib_Unit));
Chap2.Translate_Package_Declaration (Lib_Unit);
+ if Get_Package_Origin (Lib_Unit) /= Null_Iir
+ and then Get_Package_Body (Lib_Unit) /= Null_Iir
+ then
+ -- Corresponding body for package instantiation.
+ Chap2.Translate_Package_Body (Get_Package_Body (Lib_Unit));
+ end if;
when Iir_Kind_Package_Body =>
New_Debug_Comment_Decl
("package body " & Image_Identifier (Lib_Unit));
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:02:53 +0000