diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-01-01 12:30:20 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-01-01 12:30:20 +0100 |
commit | f171b7a717b3cb576a36a87bdd72eb8169e24f91 (patch) | |
tree | f71063a3db82fb868d179369f296c76d5a636e46 /src | |
parent | 02180694190081362a013e96ab18e22d49600600 (diff) | |
download | ghdl-f171b7a717b3cb576a36a87bdd72eb8169e24f91.tar.gz ghdl-f171b7a717b3cb576a36a87bdd72eb8169e24f91.tar.bz2 ghdl-f171b7a717b3cb576a36a87bdd72eb8169e24f91.zip |
vhdl: handle -gGEN=VAL for --synth. Fix #1062
Diffstat (limited to 'src')
-rw-r--r-- | src/ghdldrv/ghdllocal.adb | 71 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.ads | 8 | ||||
-rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 12 | ||||
-rw-r--r-- | src/vhdl/vhdl-configuration.adb | 110 | ||||
-rw-r--r-- | src/vhdl/vhdl-configuration.ads | 6 | ||||
-rw-r--r-- | src/vhdl/vhdl-scanner.adb | 29 |
6 files changed, 213 insertions, 23 deletions
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 08307d7eb..79a6d0006 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -56,6 +56,68 @@ package body Ghdllocal is Compile_Init; end Init; + function Is_Generic_Override_Option (Opt : String) return Boolean + is + pragma Assert (Opt'First = 1); + begin + if Opt (1 .. 2) /= "-g" then + return False; + end if; + -- Look for '='. + for I in 3 .. Opt'Last loop + if Opt (I) = '=' then + -- Ideally, OPT must be of the form -gGEN=VAL, where GEN is + -- a generic name, and VAL a literal. + return True; + end if; + end loop; + return False; + end Is_Generic_Override_Option; + + function Decode_Generic_Override_Option (Opt : String) return Option_State + is + use Errorout; + 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 + if Opt (I) = '=' then + Eq_Pos := I; + exit; + end if; + end loop; + if Eq_Pos = 0 then + Error_Msg_Option ("missing '=' in generic override option"); + return Option_Err; + elsif Eq_Pos < 3 then + Error_Msg_Option ("missing generic name in generic override option"); + return Option_Err; + elsif Eq_Pos = Opt'Last then + Error_Msg_Option ("missing value in generic override option"); + 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)); + return Option_Ok; + end Decode_Generic_Override_Option; + function Decode_Driver_Option (Opt : String) return Option_State is pragma Assert (Opt'First = 1); @@ -74,10 +136,13 @@ package body Ghdllocal is Flag_Ieee := Lib_Standard; elsif Opt = "-m32" then Flag_32bit := True; - elsif Opt'Length >= 2 - and then (Opt (2) = 'g' or Opt (2) = 'O') + elsif Opt'Length >= 2 and then Opt (2) = 'O' then + -- Silently accept -O + null; + elsif Opt'Length >= 2 and then Opt (2) = 'g' + and then not Is_Generic_Override_Option (Opt) then - -- Silently accept -g and -O. + -- Silently accept -g (if this is not a generic override option). null; else return Options.Parse_Option (Opt); diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index ffaceabf9..042c51d87 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -148,5 +148,13 @@ package Ghdllocal is Prim_Id : out Name_Id; Sec_Id : out Name_Id); + -- Report true iff OPT has the form '-gGEN=VAL'. Used to distingish from + -- debugging (like '-g' or '-ggdb' or '-g2') options. + function Is_Generic_Override_Option (Opt : String) return Boolean; + + -- Handle generic override option OPT. Return Option_Err if the generic + -- name is incorrect. + function Decode_Generic_Override_Option (Opt : String) return Option_State; + procedure Register_Commands; end Ghdllocal; diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 31ab180ab..c87405ca3 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -87,9 +87,16 @@ package body Ghdlsynth is procedure Decode_Option (Cmd : in out Command_Synth; Option : String; Arg : String; - Res : out Option_State) is + Res : out Option_State) + is + pragma Assert (Option'First = 1); begin - if Option = "--disp-noinline" then + if Option'Last > 3 + and then Option (2) = 'g' + and then Is_Generic_Override_Option (Option) + then + Res := Decode_Generic_Override_Option (Option); + elsif Option = "--disp-noinline" then Cmd.Disp_Inline := False; Res := Option_Ok; elsif Option = "--disp-noid" then @@ -237,6 +244,7 @@ package body Ghdlsynth is 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; diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index 07a98400c..dcb2d2f59 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -16,17 +16,19 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Libraries; +with Name_Table; use Name_Table; +with Str_Table; +with Flags; with Errorout; use Errorout; +with Libraries; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Std_Package; -with Name_Table; use Name_Table; -with Flags; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Nodes_Walk; with Vhdl.Sem_Scopes; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; with Vhdl.Canon; +with Vhdl.Evaluation; package body Vhdl.Configuration is procedure Add_Design_Concurrent_Stmts (Parent : Iir); @@ -1032,4 +1034,106 @@ package body Vhdl.Configuration is end if; end Find_Top_Entity; + type Override_Entry is record + Gen : Name_Id; + Value : String_Acc; + end record; + + package Override_Table is new Tables + (Table_Component_Type => Override_Entry, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 16); + + procedure Add_Generic_Override (Id : Name_Id; Value : String) is + begin + Override_Table.Append (Override_Entry'(Gen => Id, + Value => new String'(Value))); + end Add_Generic_Override; + + procedure Override_Generic (Gen : Iir; Value : String_Acc) + is + use Vhdl.Evaluation; + Formal_Type : constant Iir := Get_Type (Gen); + Formal_Btype : constant Iir := Get_Base_Type (Formal_Type); + Res : Iir; + begin + case Get_Kind (Formal_Btype) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition => + Res := Eval_Value_Attribute (Value.all, Formal_Type, Gen); + if not Eval_Is_In_Bound (Res, Formal_Type) then + Error_Msg_Elab ("override for %n is out of bounds", +Gen); + return; + end if; + Set_Literal_Origin (Res, Null_Iir); + when Iir_Kind_Array_Type_Definition => + if Is_One_Dimensional_Array_Type (Formal_Btype) then + declare + use Str_Table; + Str8 : String8_Id; + Ntype : Iir; + begin + Str8 := Create_String8; + Append_String8_String (Value.all); + Res := Create_Iir (Iir_Kind_String_Literal8); + Set_String8_Id (Res, Str8); + -- FIXME: check characters are in the type. + Set_String_Length (Res, Value'Length); + Set_Expr_Staticness (Res, Locally); + Ntype := Create_Unidim_Array_By_Length + (Get_Base_Type (Formal_Type), Value'Length, Res); + Set_Type (Res, Ntype); + Set_Literal_Subtype (Res, Ntype); + end; + else + Res := Null_Iir; + end if; + when others => + Res := Null_Iir; + end case; + if Res = Null_Iir then + Error_Msg_Elab ("unhandled override for %n", +Gen); + end if; + + if Get_Is_Ref (Gen) then + Set_Is_Ref (Gen, False); + else + if Get_Has_Identifier_List (Gen) then + -- Transfer ownership to the next interface. + Set_Is_Ref (Get_Chain (Gen), False); + end if; + end if; + Set_Location (Res, No_Location); + Set_Default_Value (Gen, Res); + end Override_Generic; + + 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; + + 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; + end; + end loop; + end Apply_Generic_Override; end Vhdl.Configuration; diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index c9f1d1194..f31750a1d 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -61,4 +61,10 @@ package Vhdl.Configuration is -- a design file): mark all instantiated units and return the unmarked -- one if there is only one. function Find_Top_Entity (From : Iir) return Iir; + + -- Add an override for generic ID. + procedure Add_Generic_Override (Id : Name_Id; Value : String); + + -- Apply generic overrides to entity ENT. + procedure Apply_Generic_Override (Ent : Iir); end Vhdl.Configuration; diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb index aadb0d538..55a98e03f 100644 --- a/src/vhdl/vhdl-scanner.adb +++ b/src/vhdl/vhdl-scanner.adb @@ -1537,6 +1537,7 @@ package body Vhdl.Scanner is procedure Convert_Identifier (Str : in out String; Err : out Boolean) is + pragma Assert (Str'First = 1); procedure Error_Bad is begin Error_Msg_Option ("bad character in identifier"); @@ -1548,41 +1549,39 @@ package body Vhdl.Scanner is end Error_8bit; C : Character; - subtype Id_Subtype is String (1 .. Str'Length); - Id : Id_Subtype renames Str; begin Err := True; - if Id'Length = 0 then + if Str'Length = 0 then Error_Msg_Option ("identifier required"); return; end if; - if Id (1) = '\' then + if Str (1) = '\' then -- Extended identifier. if Vhdl_Std = Vhdl_87 then Error_Msg_Option ("extended identifiers not allowed in vhdl87"); return; end if; - if Id'Length < 3 then + if Str'Length < 3 then Error_Msg_Option ("extended identifier is too short"); return; end if; - if Id (Id'Last) /= '\' then + if Str (Str'Last) /= '\' then Error_Msg_Option ("extended identifier must finish with a '\'"); return; end if; - for I in 2 .. Id'Last - 1 loop - C := Id (I); + for I in 2 .. Str'Last - 1 loop + C := Str (I); case Characters_Kind (C) is when Format_Effector => Error_Msg_Option ("format effector in extended identifier"); return; when Graphic_Character => if C = '\' then - if Id (I + 1) /= '\' - or else I = Id'Last - 1 + if Str (I + 1) /= '\' + or else I = Str'Last - 1 then Error_Msg_Option ("anti-slash must be doubled " & "in extended identifier"); @@ -1596,15 +1595,15 @@ package body Vhdl.Scanner is end loop; else -- Identifier - for I in 1 .. Id'Length loop - C := Id (I); + for I in 1 .. Str'Length loop + C := Str (I); case Characters_Kind (C) is when Upper_Case_Letter => if Vhdl_Std = Vhdl_87 and C > 'Z' then Error_8bit; return; end if; - Id (I) := To_Lower_Map (C); + Str (I) := To_Lower_Map (C); when Lower_Case_Letter | Digit => if Vhdl_Std = Vhdl_87 and C > 'z' then Error_8bit; @@ -1618,12 +1617,12 @@ package body Vhdl.Scanner is ("an identifier cannot start with an underscore"); return; end if; - if Id (I - 1) = '_' then + if Str (I - 1) = '_' then Error_Msg_Option ("two underscores can't be consecutive"); return; end if; - if I = Id'Last then + if I = Str'Last then Error_Msg_Option ("an identifier cannot finish with an underscore"); return; |