diff options
author | Tristan Gingold <tgingold@free.fr> | 2021-04-05 09:20:04 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2021-04-05 10:47:39 +0200 |
commit | 3c9c6023c38ed1272634a7d2aed5dbe1c318842a (patch) | |
tree | 9b0c80f87645a14fbcea51e05ecccaeb02ca6aeb /src/vhdl | |
parent | f3e936f0ca532fb57f2700a46ba1ff84557f7305 (diff) | |
download | ghdl-3c9c6023c38ed1272634a7d2aed5dbe1c318842a.tar.gz ghdl-3c9c6023c38ed1272634a7d2aed5dbe1c318842a.tar.bz2 ghdl-3c9c6023c38ed1272634a7d2aed5dbe1c318842a.zip |
vhdl and libraries: add support for binding to a foreign module
Diffstat (limited to 'src/vhdl')
-rw-r--r-- | src/vhdl/vhdl-canon.adb | 25 | ||||
-rw-r--r-- | src/vhdl/vhdl-configuration.adb | 155 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_specs.adb | 31 | ||||
-rw-r--r-- | src/vhdl/vhdl-utils.adb | 13 |
4 files changed, 148 insertions, 76 deletions
diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index 7fb55f601..3845b8d0f 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -2335,6 +2335,7 @@ package body Vhdl.Canon is Binding : Iir) is Aspect : Iir; + Ent : Iir; begin if Binding = Null_Iir then return; @@ -2348,7 +2349,12 @@ package body Vhdl.Canon is if Get_Architecture (Aspect) /= Null_Iir then Add_Dependence (Top, Aspect); else - Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect))); + Ent := Get_Entity (Aspect); + pragma Assert (Ent /= Null_Iir); + if Get_Kind (Ent) = Iir_Kind_Entity_Declaration then + Ent := Get_Design_Unit (Ent); + end if; + Add_Dependence (Top, Ent); end if; when Iir_Kind_Entity_Aspect_Configuration => Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect))); @@ -2396,11 +2402,18 @@ package body Vhdl.Canon is if Is_Config then Entity_Aspect := Get_Entity_Aspect (Bind); Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); - Sem_Specs.Sem_Check_Missing_Generic_Association - (Get_Generic_Chain (Entity), - Get_Generic_Map_Aspect_Chain (Bind), - Null_Iir, - Cfg); + case Get_Kind (Entity) is + when Iir_Kind_Entity_Declaration => + Sem_Specs.Sem_Check_Missing_Generic_Association + (Get_Generic_Chain (Entity), + Get_Generic_Map_Aspect_Chain (Bind), + Null_Iir, + Cfg); + when Iir_Kind_Foreign_Module => + null; + when others => + raise Internal_Error; + end case; end if; return; else diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index e84e3f7f0..395888d69 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -114,7 +114,9 @@ package body Vhdl.Configuration is while Is_Valid (It) loop El := Get_Element (It); El := Libraries.Find_Design_Unit (El); - if El /= Null_Iir then + if El /= Null_Iir + and then Get_Kind (El) = Iir_Kind_Design_Unit + then Lib_Unit := Get_Library_Unit (El); if Flag_Build_File_Dependence then Add_Design_Unit (El, Loc); @@ -305,6 +307,9 @@ package body Vhdl.Configuration is -- In case of error (using -c). return; end if; + if Get_Kind (Entity_Lib) = Iir_Kind_Foreign_Module then + return; + end if; Entity := Get_Design_Unit (Entity_Lib); Add_Design_Unit (Entity, Loc); @@ -425,7 +430,7 @@ package body Vhdl.Configuration is Aspect : constant Iir := Get_Entity_Aspect (Bind); Ent : constant Iir := Get_Entity_From_Entity_Aspect (Aspect); Assoc_Chain : constant Iir := Get_Port_Map_Aspect_Chain (Bind); - Inter_Chain : constant Iir := Get_Port_Chain (Ent); + Inter_Chain : Iir; Assoc : Iir; Inter : Iir; Inst_Assoc_Chain : Iir; @@ -438,6 +443,11 @@ package body Vhdl.Configuration is Inter_1 : Iir; Actual : Iir; begin + if Get_Kind (Ent) = Iir_Kind_Foreign_Module then + return; + end if; + + Inter_Chain := Get_Port_Chain (Ent); Err := False; -- Note: the assoc chain is already canonicalized. @@ -643,6 +653,10 @@ package body Vhdl.Configuration is & Name_Table.Image (Primary_Id)); return Null_Iir; end if; + if Get_Kind (Unit) = Iir_Kind_Foreign_Module then + return Unit; + end if; + Lib_Unit := Get_Library_Unit (Unit); case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration => @@ -747,12 +761,14 @@ package body Vhdl.Configuration is while File /= Null_Iir loop Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop - Lib := Get_Library_Unit (Unit); - if Get_Kind (Lib) = Iir_Kind_Vunit_Declaration then - -- Load it. - Load_Design_Unit (Unit, Unit); + if Get_Kind (Unit) = Iir_Kind_Design_Unit then + Lib := Get_Library_Unit (Unit); + if Get_Kind (Lib) = Iir_Kind_Vunit_Declaration then + -- Load it. + Load_Design_Unit (Unit, Unit); - Add_Verification_Unit (Get_Library_Unit (Unit)); + Add_Verification_Unit (Get_Library_Unit (Unit)); + end if; end if; Unit := Get_Chain (Unit); end loop; @@ -873,7 +889,7 @@ package body Vhdl.Configuration is -- Add entities to the name table (so that they easily could be found). function Add_Entity_Cb (Design : Iir) return Walk_Status is - Kind : constant Iir_Kind := Get_Kind (Get_Library_Unit (Design)); + Lib_Unit : Iir; begin if not Flags.Flag_Elaborate_With_Outdated then -- Discard obsolete or non-analyzed units. @@ -882,20 +898,29 @@ package body Vhdl.Configuration is end if; end if; - case Iir_Kinds_Library_Unit (Kind) is - when Iir_Kind_Architecture_Body - | Iir_Kind_Configuration_Declaration => - Load_Design_Unit (Design, Loc_Err); - when Iir_Kind_Entity_Declaration => - Load_Design_Unit (Design, Loc_Err); - Vhdl.Sem_Scopes.Add_Name (Get_Library_Unit (Design)); - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kinds_Verification_Unit - | Iir_Kind_Context_Declaration => - null; + case Iir_Kinds_Design_Unit (Get_Kind (Design)) is + when Iir_Kind_Design_Unit => + Lib_Unit := Get_Library_Unit (Design); + case Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is + when Iir_Kind_Architecture_Body + | Iir_Kind_Configuration_Declaration => + Load_Design_Unit (Design, Loc_Err); + when Iir_Kind_Entity_Declaration => + Load_Design_Unit (Design, Loc_Err); + -- Library unit has changed (loaded). + Lib_Unit := Get_Library_Unit (Design); + Vhdl.Sem_Scopes.Add_Name (Lib_Unit); + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kinds_Verification_Unit + | Iir_Kind_Context_Declaration => + null; + end case; + when Iir_Kind_Foreign_Module => + Vhdl.Sem_Scopes.Add_Name (Design); end case; + return Walk_Continue; end Add_Entity_Cb; @@ -951,9 +976,14 @@ package body Vhdl.Configuration is Interp := Get_Interpretation (Get_Identifier (Comp)); if Valid_Interpretation (Interp) then Decl := Get_Declaration (Interp); - pragma Assert - (Get_Kind (Decl) = Iir_Kind_Entity_Declaration); - Set_Elab_Flag (Get_Design_Unit (Decl), True); + case Get_Kind (Decl) is + when Iir_Kind_Entity_Declaration => + Set_Elab_Flag (Get_Design_Unit (Decl), True); + when Iir_Kind_Foreign_Module => + Set_Elab_Flag (Decl, True); + when others => + raise Internal_Error; + end case; else -- If there is no corresponding entity name for the -- component name, assume it belongs to a different @@ -972,7 +1002,7 @@ package body Vhdl.Configuration is function Mark_Units_Cb (Design : Iir) return Walk_Status is - Unit : constant Iir := Get_Library_Unit (Design); + Unit : Iir; Status : Walk_Status; begin if not Flags.Flag_Elaborate_With_Outdated then @@ -982,23 +1012,29 @@ package body Vhdl.Configuration is end if; end if; - case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is - when Iir_Kind_Architecture_Body => - Status := Walk_Concurrent_Statements_Chain - (Get_Concurrent_Statement_Chain (Unit), - Mark_Instantiation_Cb'Access); - pragma Assert (Status = Walk_Continue); - when Iir_Kind_Configuration_Declaration => - -- Just ignored. - null; - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Entity_Declaration - | Iir_Kinds_Verification_Unit - | Iir_Kind_Context_Declaration => - null; - end case; + if Get_Kind (Design) = Iir_Kind_Design_Unit then + Unit := Get_Library_Unit (Design); + case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is + when Iir_Kind_Architecture_Body => + Status := Walk_Concurrent_Statements_Chain + (Get_Concurrent_Statement_Chain (Unit), + Mark_Instantiation_Cb'Access); + pragma Assert (Status = Walk_Continue); + when Iir_Kind_Configuration_Declaration => + -- Just ignored. + null; + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Entity_Declaration + | Iir_Kinds_Verification_Unit + | Iir_Kind_Context_Declaration => + null; + end case; + else + -- TODO: also traverse foreign units + null; + end if; return Walk_Continue; end Mark_Units_Cb; @@ -1029,21 +1065,30 @@ package body Vhdl.Configuration is function Extract_Entity_Cb (Design : Iir) return Walk_Status is - Unit : constant Iir := Get_Library_Unit (Design); + Unit : Iir; begin - if Get_Kind (Unit) = Iir_Kind_Entity_Declaration then - if Get_Elab_Flag (Design) then - -- Clean elab flag. - Set_Elab_Flag (Design, False); - else - if Flags.Verbose then - Report_Msg (Msgid_Note, Elaboration, +Unit, - "candidate for top entity: %n", (1 => +Unit)); - end if; - Nbr_Top_Entities := Nbr_Top_Entities + 1; - if Nbr_Top_Entities = 1 then - First_Top_Entity := Unit; + case Iir_Kinds_Design_Unit (Get_Kind (Design)) is + when Iir_Kind_Foreign_Module => + Unit := Design; + when Iir_Kind_Design_Unit => + Unit := Get_Library_Unit (Design); + + if Get_Kind (Unit) /= Iir_Kind_Entity_Declaration then + return Walk_Continue; end if; + end case; + + if Get_Elab_Flag (Design) then + -- Clean elab flag. + Set_Elab_Flag (Design, False); + else + if Flags.Verbose then + Report_Msg (Msgid_Note, Elaboration, +Unit, + "candidate for top entity: %n", (1 => +Unit)); + end if; + Nbr_Top_Entities := Nbr_Top_Entities + 1; + if Nbr_Top_Entities = 1 then + First_Top_Entity := Unit; end if; end if; return Walk_Continue; diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index a005f4214..456b0b055 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -1813,16 +1813,19 @@ package body Vhdl.Sem_Specs is null; end if; - Design_Unit := Load_Primary_Unit - (Get_Library (Get_Design_File (Entity_Unit)), - Get_Identifier (Get_Library_Unit (Entity_Unit)), - Parent); - if Design_Unit = Null_Iir then - -- Found an entity which is not in the library. - raise Internal_Error; - end if; - - Entity := Get_Library_Unit (Design_Unit); + 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; Res := Create_Iir (Iir_Kind_Binding_Indication); Location_Copy (Res, Parent); @@ -1838,7 +1841,10 @@ package body Vhdl.Sem_Specs is Set_Entity_Name (Aspect, Entity_Name); Set_Entity_Aspect (Res, Aspect); - if Create_Map_Aspect then + -- No aspect for foreign modules. + if Create_Map_Aspect + and then Get_Kind (Entity) = Iir_Kind_Entity_Declaration + 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 @@ -2085,6 +2091,9 @@ 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; diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 70596c929..578576e1e 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -712,6 +712,7 @@ package body Vhdl.Utils is end if; pragma Assert (Kind_In (Unit, Iir_Kind_Design_Unit, + Iir_Kind_Foreign_Module, Iir_Kind_Entity_Aspect_Entity)); Add_Element (Get_Dependence_List (Target), Unit); @@ -1503,13 +1504,17 @@ package body Vhdl.Utils is Name : constant Iir := Get_Entity_Name (Decl); Res : constant Iir := Get_Named_Entity (Name); begin - if Res = Vhdl.Std_Package.Error_Mark then + if Res = Null_Iir or else Res = Vhdl.Std_Package.Error_Mark then return Null_Iir; end if; - pragma Assert (Res = Null_Iir - or else Get_Kind (Res) = Iir_Kind_Entity_Declaration); - return Res; + case Get_Kind (Res) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Foreign_Module => + return Res; + when others => + raise Internal_Error; + end case; end Get_Entity; function Get_Configuration (Aspect : Iir) return Iir |