diff options
-rw-r--r-- | src/synth/elab-vhdl_insts.adb | 21 | ||||
-rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 32 | ||||
-rw-r--r-- | src/vhdl/vhdl-annotations.adb | 21 | ||||
-rw-r--r-- | src/vhdl/vhdl-canon.adb | 3 | ||||
-rw-r--r-- | src/vhdl/vhdl-parse.adb | 12 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_psl.adb | 93 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_scopes.adb | 22 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_scopes.ads | 3 |
8 files changed, 143 insertions, 64 deletions
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index 4a1eb7331..f2f53bb68 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -360,7 +360,8 @@ package body Elab.Vhdl_Insts is while Item /= Null_Node loop case Get_Kind (Item) is when Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration => + | Iir_Kind_Psl_Declaration + | Iir_Kind_PSL_Inherit_Spec => null; when Iir_Kind_Psl_Assert_Directive | Iir_Kind_Psl_Assume_Directive @@ -368,15 +369,15 @@ package body Elab.Vhdl_Insts is | Iir_Kind_Psl_Restrict_Directive => null; when Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Attribute_Specification - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Non_Object_Alias_Declaration => + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Attribute_Specification + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration => Elab_Declaration (Unit_Inst, Item, Last_Type); when Iir_Kinds_Concurrent_Signal_Assignment | Iir_Kinds_Process_Statement diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index d26b24f73..5f1d4a3fd 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -3769,7 +3769,8 @@ package body Synth.Vhdl_Stmts is while Item /= Null_Node loop case Get_Kind (Item) is when Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration => + | Iir_Kind_Psl_Declaration + | Iir_Kind_PSL_Inherit_Spec => null; when Iir_Kind_Psl_Assert_Directive => Synth_Psl_Assert_Directive (Syn_Inst, Item); @@ -3810,11 +3811,12 @@ package body Synth.Vhdl_Stmts is while Item /= Null_Node loop case Get_Kind (Item) is when Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Directive - | Iir_Kind_Psl_Assume_Directive - | Iir_Kind_Psl_Restrict_Directive - | Iir_Kind_Psl_Cover_Directive - | Iir_Kind_Psl_Declaration => + | Iir_Kind_Psl_Assert_Directive + | Iir_Kind_Psl_Assume_Directive + | Iir_Kind_Psl_Restrict_Directive + | Iir_Kind_Psl_Cover_Directive + | Iir_Kind_Psl_Declaration + | Iir_Kind_PSL_Inherit_Spec => null; when Iir_Kinds_Concurrent_Signal_Assignment | Iir_Kinds_Process_Statement @@ -3824,15 +3826,15 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Component_Instantiation_Statement => null; when Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Attribute_Specification - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Non_Object_Alias_Declaration => + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Attribute_Specification + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration => Finalize_Declaration (Syn_Inst, Item, False); when others => Error_Kind ("synth_verification_unit(2)", Item); diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb index a1d8c7611..93dbaf342 100644 --- a/src/vhdl/vhdl-annotations.adb +++ b/src/vhdl/vhdl-annotations.adb @@ -1153,7 +1153,8 @@ package body Vhdl.Annotations is while Item /= Null_Iir loop case Get_Kind (Item) is when Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration => + | Iir_Kind_Psl_Declaration + | Iir_Kind_PSL_Inherit_Spec => null; when Iir_Kind_Psl_Assert_Directive | Iir_Kind_Psl_Assume_Directive @@ -1161,15 +1162,15 @@ package body Vhdl.Annotations is | Iir_Kind_Psl_Restrict_Directive => null; when Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Attribute_Specification - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Non_Object_Alias_Declaration => + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Attribute_Specification + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration => Annotate_Declaration (Vunit_Info, Item); when Iir_Kinds_Concurrent_Signal_Assignment | Iir_Kinds_Process_Statement diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index aba586eae..fb3759991 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -3412,7 +3412,8 @@ package body Vhdl.Canon is Item := Get_Vunit_Item_Chain (Decl); while Item /= Null_Iir loop case Get_Kind (Item) is - when Iir_Kind_Psl_Default_Clock => + when Iir_Kind_Psl_Default_Clock + | Iir_Kind_PSL_Inherit_Spec => null; when Iir_Kind_Psl_Assert_Directive => Canon_Psl_Assert_Directive (Item); diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index a5c62bb79..c04df340b 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -11233,11 +11233,19 @@ package body Vhdl.Parse is First, Last : Iir; Name : Iir; begin - Chain_Init (First, Last); + First := Null_Iir; + Last := Null_Iir; loop N := Create_Iir (Iir_Kind_PSL_Inherit_Spec); Set_Location (N); - Chain_Append (First, Last, N); + + -- Append. + if First = Null_Iir then + First := N; + else + Set_Inherit_Spec_Chain (Last, N); + end if; + Last := N; -- Skip 'inherit' or ','. Scan; diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index 058d4a393..9cd7b52fb 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -16,6 +16,7 @@ with Types; use Types; with Errorout; use Errorout; +with Libraries; with PSL.Types; use PSL.Types; with PSL.Nodes; use PSL.Nodes; @@ -988,6 +989,37 @@ package body Vhdl.Sem_Psl is Current_Psl_Default_Clock := Stmt; end Sem_Psl_Default_Clock; + procedure Sem_Psl_Inherit_Spec (Item : Iir) + is + Name : Iir; + Unit : Iir; + begin + -- Resolve name + Name := Get_Name (Item); + if Get_Kind (Name) = Iir_Kind_Simple_Name then + Unit := Sem_Lib.Load_Primary_Unit + (Libraries.Work_Library, Get_Identifier (Name), Item); + if Unit = Null_Iir then + Error_Msg_Sem (+Name, "unit %n was not analyzed", +Name); + return; + end if; + Unit := Get_Library_Unit (Unit); + Set_Named_Entity (Name, Unit); + else + Name := Sem_Names.Sem_Denoting_Name (Name); + Unit := Get_Named_Entity (Name); + end if; + + if Get_Kind (Unit) not in Iir_Kinds_Verification_Unit then + Error_Msg_Sem (+Name, "%n must denote a verification unit", +Name); + Set_Named_Entity (Name, Null_Iir); + return; + end if; + + -- Add items. + Sem_Scopes.Add_Inherit_Spec (Item); + end Sem_Psl_Inherit_Spec; + function Sem_Psl_Instance_Name (Name : Iir) return Iir is Prefix : constant Iir := Get_Prefix (Name); @@ -1128,40 +1160,45 @@ package body Vhdl.Sem_Psl is Prev_Item : Iir; Attr_Spec_Chain : Iir; begin - if Hier_Name = Null_Iir then + if Hier_Name /= Null_Iir then -- Hierarchical name is optional. -- If the unit is not bound, the names are not bound too. - return; - end if; - Sem_Hierarchical_Name (Hier_Name, Unit); - - -- Import declarations. - Entity := Get_Entity_Name (Hier_Name); - if Entity = Null_Iir then - return; - end if; - Entity := Get_Named_Entity (Entity); - if Entity = Null_Iir then - return; - end if; + Sem_Hierarchical_Name (Hier_Name, Unit); - Arch := Get_Architecture (Hier_Name); - if Arch /= Null_Iir then - Arch := Get_Named_Entity (Arch); - if Arch = Null_Iir then + -- Import declarations. + Entity := Get_Entity_Name (Hier_Name); + if Entity = Null_Iir then + return; + end if; + Entity := Get_Named_Entity (Entity); + if Entity = Null_Iir then return; end if; - end if; - Sem_Scopes.Add_Context_Clauses (Get_Design_Unit (Entity)); + Arch := Get_Architecture (Hier_Name); + if Arch /= Null_Iir then + Arch := Get_Named_Entity (Arch); + if Arch = Null_Iir then + return; + end if; + end if; + + Sem_Scopes.Add_Context_Clauses (Get_Design_Unit (Entity)); + else + Entity := Null_Iir; + Arch := Null_Iir; + end if; Sem_Scopes.Open_Declarative_Region; - Set_Is_Within_Flag (Entity, True); - Sem_Scopes.Add_Entity_Declarations (Entity); - if Arch /= Null_Iir then - Sem_Scopes.Open_Scope_Extension; - Sem_Scopes.Extend_Scope_Of_Block_Declarations (Arch); + if Entity /= Null_Iir then + Set_Is_Within_Flag (Entity, True); + Sem_Scopes.Add_Entity_Declarations (Entity); + + if Arch /= Null_Iir then + Sem_Scopes.Open_Scope_Extension; + Sem_Scopes.Extend_Scope_Of_Block_Declarations (Arch); + end if; end if; Attr_Spec_Chain := Null_Iir; @@ -1169,6 +1206,8 @@ package body Vhdl.Sem_Psl is Item := Get_Vunit_Item_Chain (Unit); while Item /= Null_Iir loop case Get_Kind (Item) is + when Iir_Kind_PSL_Inherit_Spec => + Sem_Psl_Inherit_Spec (Item); when Iir_Kind_Psl_Default_Clock => Sem_Psl_Default_Clock (Item); when Iir_Kind_Psl_Assert_Directive => @@ -1220,7 +1259,9 @@ package body Vhdl.Sem_Psl is end if; Sem_Scopes.Close_Declarative_Region; - Set_Is_Within_Flag (Entity, False); + if Entity /= Null_Iir then + Set_Is_Within_Flag (Entity, False); + end if; end Sem_Psl_Verification_Unit; end Vhdl.Sem_Psl; diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb index 7bb047e37..29c355f9a 100644 --- a/src/vhdl/vhdl-sem_scopes.adb +++ b/src/vhdl/vhdl-sem_scopes.adb @@ -1560,6 +1560,28 @@ package body Vhdl.Sem_Scopes is end loop; end Add_Use_Clause; + procedure Add_Inherit_Spec (Spec : Iir) + is + Name : constant Iir := Get_Name (Spec); + Unit : Iir; + Item : Iir; + begin + if Name = Null_Iir then + return; + end if; + Unit := Get_Named_Entity (Name); + Item := Get_Vunit_Item_Chain (Unit); + while Item /= Null_Iir loop + case Get_Kind (Item) is + when Iir_Kind_Psl_Declaration => + Potentially_Add_Name (Item); + when others => + Error_Kind ("add_inherit_spec", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Add_Inherit_Spec; + -- Debugging subprograms. procedure Disp_All_Names; pragma Unreferenced (Disp_All_Names); diff --git a/src/vhdl/vhdl-sem_scopes.ads b/src/vhdl/vhdl-sem_scopes.ads index 8fdd88b5c..b20e224b0 100644 --- a/src/vhdl/vhdl-sem_scopes.ads +++ b/src/vhdl/vhdl-sem_scopes.ads @@ -136,6 +136,9 @@ package Vhdl.Sem_Scopes is -- regions. procedure Add_Context_Clauses (Unit : Iir_Design_Unit); + -- Handle PSL inherit spec. + procedure Add_Inherit_Spec (Spec : Iir); + -- Add declarations from an entity into the current declarative region. -- This is needed when an architecture is analysed. procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration); |