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 | |
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')
-rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 26 | ||||
-rw-r--r-- | src/libraries.adb | 106 | ||||
-rw-r--r-- | src/synth/synth-insts.adb | 5 | ||||
-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 |
7 files changed, 237 insertions, 124 deletions
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 8a21169bc..0954d3f8e 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -379,18 +379,20 @@ package body Ghdlsynth is Vhdl.Configuration.Add_Verification_Units; - -- Check (and possibly abandon) if entity can be at the top of the - -- hierarchy. - declare - Entity : constant Iir := - Vhdl.Utils.Get_Entity_From_Configuration (Config); - begin - Vhdl.Configuration.Apply_Generic_Override (Entity); - Vhdl.Configuration.Check_Entity_Declaration_Top (Entity, False); - if Nbr_Errors > 0 then - return Null_Iir; - end if; - end; + if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then + -- Check (and possibly abandon) if entity can be at the top of the + -- hierarchy. + declare + Entity : constant Iir := + Vhdl.Utils.Get_Entity_From_Configuration (Config); + begin + Vhdl.Configuration.Apply_Generic_Override (Entity); + Vhdl.Configuration.Check_Entity_Declaration_Top (Entity, False); + if Nbr_Errors > 0 then + return Null_Iir; + end if; + end; + end if; -- Annotate all units. Vhdl.Annotations.Initialize_Annotate; diff --git a/src/libraries.adb b/src/libraries.adb index dada45c9b..0c79d77d9 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -225,15 +225,19 @@ package body Libraries is Lib_Unit : Iir; Id : Name_Id; begin - Lib_Unit := Get_Library_Unit (Design_Unit); - case Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is - when Iir_Kinds_Primary_Unit - | Iir_Kind_Package_Body => - Id := Get_Identifier (Lib_Unit); - when Iir_Kind_Architecture_Body => - -- Architectures are put with the entity identifier. - Id := Get_Entity_Identifier_Of_Architecture (Lib_Unit); - end case; + if Get_Kind (Design_Unit) = Iir_Kind_Foreign_Module then + Id := Get_Identifier (Design_Unit); + else + Lib_Unit := Get_Library_Unit (Design_Unit); + case Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is + when Iir_Kinds_Primary_Unit + | Iir_Kind_Package_Body => + Id := Get_Identifier (Lib_Unit); + when Iir_Kind_Architecture_Body => + -- Architectures are put with the entity identifier. + Id := Get_Entity_Identifier_Of_Architecture (Lib_Unit); + end case; + end if; return Id mod Unit_Hash_Length; end Get_Hash_Id_For_Unit; @@ -882,7 +886,8 @@ package body Libraries is function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit is begin case Get_Kind (Unit) is - when Iir_Kind_Design_Unit => + when Iir_Kind_Design_Unit + | Iir_Kind_Foreign_Module => return Unit; when Iir_Kind_Selected_Name => declare @@ -1053,7 +1058,14 @@ package body Libraries is pragma Assert (Get_Date_State (Unit) = Date_Extern); -- Mark this design unit as being loaded. - New_Library_Unit := Get_Library_Unit (Unit); + case Get_Kind (Unit) is + when Iir_Kind_Design_Unit => + New_Library_Unit := Get_Library_Unit (Unit); + when Iir_Kind_Foreign_Module => + New_Library_Unit := Unit; + when others => + raise Internal_Error; + end case; Unit_Id := Get_Identifier (New_Library_Unit); -- Set the date of the design unit as the most recently analyzed @@ -1532,16 +1544,18 @@ package body Libraries is while Design_File /= Null_Iir loop Design_Unit := Get_First_Design_Unit (Design_File); while Design_Unit /= Null_Iir loop - Library_Unit := Get_Library_Unit (Design_Unit); + if Get_Kind (Design_Unit) = Iir_Kind_Design_Unit then + Library_Unit := Get_Library_Unit (Design_Unit); - if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body - and then - Get_Entity_Identifier_Of_Architecture (Library_Unit) = Entity_Id - then - if Res = Null_Iir then - Res := Design_Unit; - elsif Get_Date (Design_Unit) > Get_Date (Res) then - Res := Design_Unit; + if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body + and then (Get_Entity_Identifier_Of_Architecture (Library_Unit) + = Entity_Id) + then + if Res = Null_Iir then + Res := Design_Unit; + elsif Get_Date (Design_Unit) > Get_Date (Res) then + Res := Design_Unit; + end if; end if; end if; Design_Unit := Get_Chain (Design_Unit); @@ -1557,22 +1571,28 @@ package body Libraries is -- Return the declaration of primary unit NAME of LIBRARY. function Find_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id) - return Iir_Design_Unit + (Library: Iir_Library_Declaration; Name: Name_Id) return Iir_Design_Unit is Unit : Iir_Design_Unit; + Lib_Unit : Iir; begin Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); while Unit /= Null_Iir loop if Get_Identifier (Unit) = Name and then Get_Library (Get_Design_File (Unit)) = Library then - case Iir_Kinds_Library_Unit (Get_Kind (Get_Library_Unit (Unit))) is - when Iir_Kinds_Primary_Unit => - -- Only return a primary unit. + case Iir_Kinds_Design_Unit (Get_Kind (Unit)) is + when Iir_Kind_Foreign_Module => return Unit; - when Iir_Kinds_Secondary_Unit => - null; + when Iir_Kind_Design_Unit => + Lib_Unit := Get_Library_Unit (Unit); + case Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is + when Iir_Kinds_Primary_Unit => + -- Only return a primary unit. + return Unit; + when Iir_Kinds_Secondary_Unit => + null; + end case; end case; end if; Unit := Get_Hash_Chain (Unit); @@ -1633,18 +1653,32 @@ package body Libraries is is Res : Iir_Design_Unit := Null_Iir; Unit : Iir_Design_Unit; + Unit1 : Iir; + begin + Res := Null_Iir; Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); while Unit /= Null_Iir loop - if Get_Identifier (Unit) = Name - and then (Get_Kind (Get_Library_Unit (Unit)) - = Iir_Kind_Entity_Declaration) - then - if Res = Null_Iir then - Res := Unit; - else - -- Many entities. - return Null_Iir; + if Get_Identifier (Unit) = Name then + case Iir_Kinds_Design_Unit (Get_Kind (Unit)) is + when Iir_Kind_Foreign_Module => + Unit1 := Unit; + when Iir_Kind_Design_Unit => + if Get_Kind (Get_Library_Unit (Unit)) + = Iir_Kind_Entity_Declaration + then + Unit1 := Unit; + else + Unit1 := Null_Iir; + end if; + end case; + if Unit1 /= Null_Iir then + if Res = Null_Iir then + Res := Unit; + else + -- Many entities. + return Null_Iir; + end if; end if; end if; Unit := Get_Hash_Chain (Unit); diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 1f399a6ee..5937a793e 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -1269,6 +1269,11 @@ package body Synth.Insts is ("Synth_Component_Instantiation_Statement(2)", Aspect); end case; + if Get_Kind (Ent) = Iir_Kind_Foreign_Module then + -- TODO. + raise Internal_Error; + end if; + if Arch = Null_Node then Arch := Libraries.Get_Latest_Architecture (Ent); else 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 |