diff options
Diffstat (limited to 'src/vhdl/vhdl-sem_specs.adb')
| -rw-r--r-- | src/vhdl/vhdl-sem_specs.adb | 156 |
1 files changed, 81 insertions, 75 deletions
diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index 29c13b7a9..810e390cc 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -1256,57 +1256,71 @@ package body Vhdl.Sem_Specs is end if; end Sem_Step_Limit_Specification; + function Sem_Entity_Aspect_Entity (Aspect : Iir) return Iir + is + Entity_Name : Iir; + Entity : Iir; + Arch_Name : Iir; + Arch_Unit : Iir; + begin + -- The entity. + Entity_Name := Get_Entity_Name (Aspect); + if Is_Error (Entity_Name) then + return Null_Iir; + end if; + Entity_Name := Sem_Denoting_Name (Get_Entity_Name (Aspect)); + Set_Entity_Name (Aspect, Entity_Name); + Entity := Get_Named_Entity (Entity_Name); + if Entity = Error_Mark then + return Null_Iir; + end if; + Arch_Name := Get_Architecture (Aspect); + case Get_Kind (Entity) is + when Iir_Kind_Entity_Declaration => + -- Continue below. + null; + when Iir_Kind_Foreign_Module => + -- There is no architecture. + if Arch_Name /= Null_Iir then + Error_Msg_Sem (+Aspect, "architecture not allowed for %n", + +Entity); + end if; + return Entity; + when others => + Error_Class_Match (Entity_Name, "entity"); + return Null_Iir; + end case; + -- Note: dependency is added by Sem_Denoting_Name. + + -- Check architecture. + if Arch_Name /= Null_Iir then + Arch_Unit := Libraries.Find_Secondary_Unit + (Get_Design_Unit (Entity), Get_Identifier (Arch_Name)); + if Arch_Unit /= Null_Iir then + -- The architecture is known. + if Get_Date_State (Arch_Unit) >= Date_Parse then + -- And loaded! + Arch_Unit := Get_Library_Unit (Arch_Unit); + end if; + Set_Named_Entity (Arch_Name, Arch_Unit); + Xref_Ref (Arch_Name, Arch_Unit); + end if; + + -- FIXME: may emit a warning if the architecture does not + -- exist. + -- Note: the design needs the architecture. + Add_Dependence (Aspect); + end if; + return Entity; + end Sem_Entity_Aspect_Entity; + -- Analyze entity aspect ASPECT and return the entity declaration. -- Return NULL_IIR if not found. function Sem_Entity_Aspect (Aspect : Iir) return Iir is begin case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => - declare - Entity_Name : Iir; - Entity : Iir; - Arch_Name : Iir; - Arch_Unit : Iir; - begin - -- The entity. - Entity_Name := Get_Entity_Name (Aspect); - if Is_Error (Entity_Name) then - return Null_Iir; - end if; - Entity_Name := Sem_Denoting_Name (Get_Entity_Name (Aspect)); - Set_Entity_Name (Aspect, Entity_Name); - Entity := Get_Named_Entity (Entity_Name); - if Entity = Error_Mark then - return Null_Iir; - end if; - if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then - Error_Class_Match (Entity_Name, "entity"); - return Null_Iir; - end if; - -- Note: dependency is added by Sem_Denoting_Name. - - -- Check architecture. - Arch_Name := Get_Architecture (Aspect); - if Arch_Name /= Null_Iir then - Arch_Unit := Libraries.Find_Secondary_Unit - (Get_Design_Unit (Entity), Get_Identifier (Arch_Name)); - if Arch_Unit /= Null_Iir then - -- The architecture is known. - if Get_Date_State (Arch_Unit) >= Date_Parse then - -- And loaded! - Arch_Unit := Get_Library_Unit (Arch_Unit); - end if; - Set_Named_Entity (Arch_Name, Arch_Unit); - Xref_Ref (Arch_Name, Arch_Unit); - end if; - - -- FIXME: may emit a warning if the architecture does not - -- exist. - -- Note: the design needs the architecture. - Add_Dependence (Aspect); - end if; - return Entity; - end; + return Sem_Entity_Aspect_Entity (Aspect); when Iir_Kind_Entity_Aspect_Configuration => declare @@ -1815,19 +1829,13 @@ package body Vhdl.Sem_Specs is null; end if; - case Iir_Kinds_Design_Unit (Get_Kind (Entity_Unit)) is - when Iir_Kind_Design_Unit => - Design_Unit := Load_Primary_Unit - (Get_Library (Get_Design_File (Entity_Unit)), - Get_Identifier (Get_Library_Unit (Entity_Unit)), - Parent); - -- Found an entity which is not in the library. - pragma Assert (Design_Unit /= Null_Iir); - Entity := Get_Library_Unit (Design_Unit); - - when Iir_Kind_Foreign_Module => - Entity := Entity_Unit; - end case; + Design_Unit := Load_Primary_Unit + (Get_Library (Get_Design_File (Entity_Unit)), + Get_Identifier (Get_Library_Unit (Entity_Unit)), + Parent); + -- Found an entity which is not in the library. + pragma Assert (Design_Unit /= Null_Iir); + Entity := Get_Library_Unit (Design_Unit); Res := Create_Iir (Iir_Kind_Binding_Indication); Location_Copy (Res, Parent); @@ -1843,10 +1851,7 @@ package body Vhdl.Sem_Specs is Set_Entity_Name (Aspect, Entity_Name); Set_Entity_Aspect (Res, Aspect); - -- No aspect for foreign modules. - if Create_Map_Aspect - and then Get_Kind (Entity) = Iir_Kind_Entity_Declaration - then + if Create_Map_Aspect then -- LRM 5.2.2 -- The default binding indication includes a default generic map -- aspect if the design entity implied by the entity aspect contains @@ -1936,7 +1941,7 @@ package body Vhdl.Sem_Specs is Assoc := Create_Iir (Iir_Kind_Association_Element_Open); Location_Copy (Assoc, Parent); else - if Are_Nodes_Compatible (Comp_El, Ent_El) = Not_Compatible then + if Are_Nodes_Compatible (Ent_El, Comp_El) = Not_Compatible then Report_Start_Group; Error_Header; Error_Msg_Sem @@ -2026,18 +2031,22 @@ package body Vhdl.Sem_Specs is -- Return the design_unit if DECL is an entity declaration or the -- design unit of an entity declaration. Otherwise return Null_Iir. -- This double check is needed as the interpretation may be both. - function Is_Entity_Declaration (Decl : Iir) return Iir is + function Is_Entity_Declaration (Decl : Iir) return Iir + is + Lib_Unit : Iir; begin - if Get_Kind (Decl) = Iir_Kind_Entity_Declaration then - return Get_Design_Unit (Decl); - elsif Get_Kind (Decl) = Iir_Kind_Design_Unit - and then - Get_Kind (Get_Library_Unit (Decl)) = Iir_Kind_Entity_Declaration - then - return Decl; + if Get_Kind (Decl) = Iir_Kind_Design_Unit then + Lib_Unit := Get_Library_Unit (Decl); else - return Null_Iir; + Lib_Unit := Decl; end if; + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Foreign_Module => + return Get_Design_Unit (Lib_Unit); + when others => + return Null_Iir; + end case; end Is_Entity_Declaration; Name : constant Name_Id := Get_Identifier (Comp); @@ -2096,9 +2105,6 @@ package body Vhdl.Sem_Specs is Decl := Libraries.Find_Primary_Unit (Target_Lib, Name); if Decl /= Null_Iir then - if Get_Kind (Decl) = Iir_Kind_Foreign_Module then - return Decl; - end if; Res := Is_Entity_Declaration (Decl); if Res /= Null_Iir then return Res; |