diff options
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 17 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 33 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.adb | 69 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.ads | 6 |
4 files changed, 75 insertions, 50 deletions
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 4e0b0b05b..722c1a26f 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -86,7 +86,6 @@ package body Ghdllocal is pragma Assert (Opt'First = 1); pragma Assert (Opt'Last >= 5); Eq_Pos : Natural; - Id : Name_Id; begin Eq_Pos := 0; for I in 3 .. Opt'Last loop @@ -106,21 +105,9 @@ package body Ghdllocal is return Option_Err; end if; - declare - Res : String (1 .. Eq_Pos - 3) := Opt (3 .. Eq_Pos - 1); - Err : Boolean; - begin - Vhdl.Scanner.Convert_Identifier (Res, Err); - if Err then - Error_Msg_Option - ("incorrect generic name in generic override option"); - return Option_Err; - end if; - Id := Name_Table.Get_Identifier (Res); - end; - Vhdl.Configuration.Add_Generic_Override - (Id, Opt (Eq_Pos + 1 .. Opt'Last)); + (Opt (3 .. Eq_Pos - 1), Opt (Eq_Pos + 1 .. Opt'Last)); + return Option_Ok; end Decode_Generic_Override_Option; diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index cfc5f281b..ced5b71c9 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -378,20 +378,25 @@ package body Ghdlsynth is Foreign_Resolve_Instances.all; end if; - if Get_Kind (Get_Library_Unit (Config)) /= Iir_Kind_Foreign_Module 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; + -- Check (and possibly abandon) if entity can be at the top of the + -- hierarchy. + declare + Config_Unit : constant Iir := Get_Library_Unit (Config); + Top : Iir; + begin + if Get_Kind (Config_Unit) = Iir_Kind_Foreign_Module then + Top := Config_Unit; + Vhdl.Configuration.Apply_Generic_Override (Top); + -- No Check_Entity_Declaration (yet). + else + Top := Vhdl.Utils.Get_Entity_From_Configuration (Config); + Vhdl.Configuration.Apply_Generic_Override (Top); + Vhdl.Configuration.Check_Entity_Declaration_Top (Top, False); + end if; + if Nbr_Errors > 0 then + return Null_Iir; + end if; + end; return Config; end Ghdl_Synth_Configure; diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index aeb737028..64a615bfb 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -27,6 +27,7 @@ with Vhdl.Sem_Scopes; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; with Vhdl.Canon; with Vhdl.Evaluation; +with Vhdl.Scanner; package body Vhdl.Configuration is procedure Add_Design_Concurrent_Stmts (Parent : Iir); @@ -1167,7 +1168,7 @@ package body Vhdl.Configuration is end Find_Top_Entity; type Override_Entry is record - Gen : Name_Id; + Gen : String_Acc; Value : String_Acc; end record; @@ -1177,9 +1178,9 @@ package body Vhdl.Configuration is Table_Low_Bound => 1, Table_Initial => 16); - procedure Add_Generic_Override (Id : Name_Id; Value : String) is + procedure Add_Generic_Override (Name : String; Value : String) is begin - Override_Table.Append (Override_Entry'(Gen => Id, + Override_Table.Append (Override_Entry'(Gen => new String'(Name), Value => new String'(Value))); end Add_Generic_Override; @@ -1325,29 +1326,57 @@ package body Vhdl.Configuration is procedure Apply_Generic_Override (Ent : Iir) is - Inter_Chain : constant Iir := Get_Generic_Chain (Ent); - Inter : Iir; begin for I in Override_Table.First .. Override_Table.Last loop declare Over : constant Override_Entry := Override_Table.Table (I); begin - Inter := Inter_Chain; - while Inter /= Null_Iir loop - exit when Get_Identifier (Inter) = Over.Gen; - Inter := Get_Chain (Inter); - end loop; + case Get_Kind (Ent) is + when Iir_Kind_Entity_Declaration => + declare + Inter_Chain : constant Iir := Get_Generic_Chain (Ent); + Gen_Name : String := Over.Gen.all; + Gen_Id : Name_Id; + Inter : Iir; + Err : Boolean; + begin + Vhdl.Scanner.Convert_Identifier (Gen_Name, Err); + if Err then + Error_Msg_Option + ("incorrect name in generic override option"); + Gen_Id := Null_Identifier; + else + Gen_Id := Name_Table.Get_Identifier (Gen_Name); - if Inter = Null_Iir then - Error_Msg_Elab ("no generic %i for -g", +Over.Gen); - elsif Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration - then - Error_Msg_Elab - ("generic %n cannot be overriden (not a constant)", - +Over.Gen); - else - Override_Generic (Inter, Over.Value); - end if; + Inter := Inter_Chain; + while Inter /= Null_Iir loop + exit when Get_Identifier (Inter) = Gen_Id; + Inter := Get_Chain (Inter); + end loop; + end if; + + if Gen_Id = Null_Identifier then + -- Skip it + null; + elsif Inter = Null_Iir then + Error_Msg_Elab ("no generic %i for -g", +Gen_Id); + elsif (Get_Kind (Inter) + /= Iir_Kind_Interface_Constant_Declaration) + then + -- Could be a generic package, a generic type... + Error_Msg_Elab + ("generic %n cannot be overriden (not a constant)", + +Gen_Id); + else + Override_Generic (Inter, Over.Value); + end if; + end; + when Iir_Kind_Foreign_Module => + Apply_Foreign_Override + (Get_Foreign_Node (Ent), Over.Gen.all, Over.Value.all); + when others => + raise Internal_Error; + end case; end; end loop; end Apply_Generic_Override; diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index d272d23e9..dfd59c516 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -69,8 +69,12 @@ package Vhdl.Configuration is type Mark_Instantiated_Units_Access is access procedure (N : Int32); Mark_Foreign_Module : Mark_Instantiated_Units_Access; + type Apply_Foreign_Override_Access is access procedure + (Top : Int32; Gen : String; Value : String); + Apply_Foreign_Override : Apply_Foreign_Override_Access; + -- Add an override for generic ID. - procedure Add_Generic_Override (Id : Name_Id; Value : String); + procedure Add_Generic_Override (Name : String; Value : String); -- Apply generic overrides to entity ENT. procedure Apply_Generic_Override (Ent : Iir); |