diff options
| -rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 15 | ||||
| -rw-r--r-- | src/synth/synth-flags.ads | 20 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 161 | ||||
| -rw-r--r-- | src/synth/synth-insts.ads | 2 | ||||
| -rw-r--r-- | src/synth/synthesis.adb | 14 | ||||
| -rw-r--r-- | src/synth/synthesis.ads | 9 |
6 files changed, 138 insertions, 83 deletions
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 739bd778f..3f2792f6a 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -55,9 +55,15 @@ package body Ghdlsynth is -- Command --synth type Command_Synth is new Command_Lib with record + -- Control format of the output. Disp_Inline : Boolean := True; Disp_Id : Boolean := True; Oformat : Out_Format := Format_Default; + + -- Control name encoding of the top-entity. + Top_Encoding : Name_Encoding := Name_Asis; + + -- If True, a failure is expected. For tests. Expect_Failure : Boolean := False; end record; function Decode_Command (Cmd : Command_Synth; Name : String) @@ -97,6 +103,10 @@ package body Ghdlsynth is and then Is_Generic_Override_Option (Option) then Res := Decode_Generic_Override_Option (Option); + elsif Option = "--top-name=hash" then + Cmd.Top_Encoding := Name_Hash; + elsif Option = "--top-name=asis" then + Cmd.Top_Encoding := Name_Asis; elsif Option = "--expect-failure" then Cmd.Expect_Failure := True; Res := Option_Ok; @@ -336,7 +346,8 @@ package body Ghdlsynth is return No_Module; end if; - Synthesis.Synth_Design (Config, Res, Inst); + Synthesis.Synth_Design + (Config, Command_Synth (Cmd.all).Top_Encoding, Res, Inst); if Res = No_Module then return No_Module; end if; @@ -383,7 +394,7 @@ package body Ghdlsynth is Netlists.Errors.Initialize; - Synthesis.Synth_Design (Config, Res, Inst); + Synthesis.Synth_Design (Config, Cmd.Top_Encoding, Res, Inst); if Res = No_Module then if Cmd.Expect_Failure then return; diff --git a/src/synth/synth-flags.ads b/src/synth/synth-flags.ads index ac5f9d072..a3bb102e4 100644 --- a/src/synth/synth-flags.ads +++ b/src/synth/synth-flags.ads @@ -19,6 +19,26 @@ -- MA 02110-1301, USA. package Synth.Flags is + -- Control name generation. The same entity can be synthesized in very + -- different designs because of the generics. We need to give unique names + -- to these designs. + type Name_Encoding is + ( + -- Use the entity name as is for the design name. Possible for the + -- top entity (and also for entities without generics and one config). + Name_Asis, + + -- Add generic values or/and an hash. Results in unique but long names. + -- This allows partial synthesis: black-boxes can be synthesized later. + Name_Hash, + + -- Just append a unique index. Create shorter names than Name_Hash, + -- but the names depend on the whole design. So it won't be possible + -- to do partial synthesis (ie synthesizing a sub-module, and then its + -- parent considering the sub-module as a black-box). + Name_Index + ); + Flag_Debug_Noinference : Boolean := False; Flag_Debug_Nocleanup : Boolean := False; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index d871b1a11..e2320aa9f 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -42,7 +42,6 @@ with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Errors; with Vhdl.Ieee.Math_Real; -with Synth.Flags; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Stmts; use Synth.Stmts; @@ -90,6 +89,8 @@ package body Synth.Insts is Config : Node; -- Values of generics. Syn_Inst : Synth_Instance_Acc; + -- Encoding if the instance name. + Encoding : Name_Encoding; end record; type Inst_Object is record @@ -224,7 +225,7 @@ package body Synth.Insts is Ports : constant Node := Get_Port_Chain (Decl); Ctxt : GNAT.SHA1.Context; Has_Hash : Boolean; - begin + -- Create a buffer, store the entity name. -- For each generic: -- * write the value for integers. @@ -232,80 +233,90 @@ package body Synth.Insts is -- identifiers. -- * hash all other values -- Append the hash if any. - declare - use Name_Table; - Id_Len : constant Natural := Get_Name_Length (Id); - Str_Len : constant Natural := Id_Len + 512; - pragma Assert (GNAT.SHA1.Hash_Length = 20); - Str : String (1 .. Str_Len + 41); - Len : Natural; - - Gen_Decl : Node; - Gen : Value_Acc; - begin - Len := Id_Len; - Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len); - - Has_Hash := False; - Ctxt := GNAT.SHA1.Initial_Context; + use Name_Table; + Id_Len : constant Natural := Get_Name_Length (Id); + Str_Len : constant Natural := Id_Len + 512; + pragma Assert (GNAT.SHA1.Hash_Length = 20); + Str : String (1 .. Str_Len + 41); + Len : Natural; + + Gen_Decl : Node; + Gen : Value_Acc; + begin + Len := Id_Len; + Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len); + + Has_Hash := False; + + case Params.Encoding is + when Name_Hash => + Ctxt := GNAT.SHA1.Initial_Context; + + Gen_Decl := Generics; + while Gen_Decl /= Null_Node loop + Gen := Get_Value (Params.Syn_Inst, Gen_Decl); + case Gen.Kind is + when Value_Discrete => + declare + S : constant String := + Uns64'Image (To_Uns64 (Gen.Scal)); + begin + if Len + S'Length > Str_Len then + Has_Hash := True; + Hash_Const (Ctxt, Gen); + else + Str (Len + 1 .. Len + S'Length) := S; + pragma Assert (Str (Len + 1) = ' '); + Str (Len + 1) := '_'; -- Overwrite the space. + Len := Len + S'Length; + end if; + end; + when others => + Has_Hash := True; + Hash_Const (Ctxt, Gen); + end case; + Gen_Decl := Get_Chain (Gen_Decl); + end loop; - Gen_Decl := Generics; - while Gen_Decl /= Null_Node loop - Gen := Get_Value (Params.Syn_Inst, Gen_Decl); - case Gen.Kind is - when Value_Discrete => - declare - S : constant String := Uns64'Image (To_Uns64 (Gen.Scal)); - begin - if Len + S'Length > Str_Len then - Has_Hash := True; - Hash_Const (Ctxt, Gen); - else - Str (Len + 1 .. Len + S'Length) := S; - pragma Assert (Str (Len + 1) = ' '); - Str (Len + 1) := '_'; -- Overwrite the space. - Len := Len + S'Length; - end if; - end; - when others => - Has_Hash := True; - Hash_Const (Ctxt, Gen); - end case; - Gen_Decl := Get_Chain (Gen_Decl); - end loop; + declare + Port_Decl : Node; + Port_Typ : Type_Acc; + begin + Port_Decl := Ports; + while Port_Decl /= Null_Node loop + if not Is_Fully_Constrained_Type (Get_Type (Port_Decl)) then + Port_Typ := Get_Value (Params.Syn_Inst, Port_Decl).Typ; + Has_Hash := True; + Hash_Bounds (Ctxt, Port_Typ); + end if; + Port_Decl := Get_Chain (Port_Decl); + end loop; + end; + if not Has_Hash and then Generics = Null_Node then + -- Simple case: same name. + -- TODO: what about two entities with the same identifier but + -- declared in two different libraries ? + -- TODO: what about extended identifiers ? + return New_Sname_User (Id, No_Sname); + end if; - declare - Port_Decl : Node; - Port_Typ : Type_Acc; - begin - Port_Decl := Ports; - while Port_Decl /= Null_Node loop - if not Is_Fully_Constrained_Type (Get_Type (Port_Decl)) then - Port_Typ := Get_Value (Params.Syn_Inst, Port_Decl).Typ; - Has_Hash := True; - Hash_Bounds (Ctxt, Port_Typ); - end if; - Port_Decl := Get_Chain (Port_Decl); - end loop; - end; + if Has_Hash then + Str (Len + 1) := '_'; + Len := Len + 1; + Str (Len + 1 .. Len + 40) := GNAT.SHA1.Digest (Ctxt); + Len := Len + 40; + end if; - if not Has_Hash and then Generics = Null_Node then - -- Simple case: same name. - -- TODO: what about two entities with the same identifier but - -- declared in two different libraries ? - -- TODO: what about extended identifiers ? + when Name_Asis => return New_Sname_User (Id, No_Sname); - end if; - if Has_Hash then - Str (Len + 1) := '_'; - Len := Len + 1; - Str (Len + 1 .. Len + 40) := GNAT.SHA1.Digest (Ctxt); - Len := Len + 40; - end if; + when Name_Index => + -- TODO. + raise Internal_Error; + end case; - return New_Sname_User (Get_Identifier (Str (1 .. Len)), No_Sname); - end; + + return New_Sname_User (Get_Identifier (Str (1 .. Len)), No_Sname); end Create_Module_Name; function Build (Params : Inst_Params) return Inst_Object @@ -894,7 +905,8 @@ package body Synth.Insts is Inst_Obj := Insts_Interning.Get ((Decl => Ent, Arch => Arch, Config => Config, - Syn_Inst => Sub_Inst)); + Syn_Inst => Sub_Inst, + Encoding => Name_Hash)); -- TODO: free sub_inst. @@ -1081,7 +1093,8 @@ package body Synth.Insts is Inst_Obj := Insts_Interning.Get ((Decl => Ent, Arch => Arch, Config => Sub_Config, - Syn_Inst => Sub_Inst)); + Syn_Inst => Sub_Inst, + Encoding => Name_Hash)); -- TODO: free sub_inst. @@ -1194,6 +1207,7 @@ package body Synth.Insts is procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc; Arch : Node; Config : Node; + Encoding : Name_Encoding; Inst : out Synth_Instance_Acc) is Entity : constant Node := Get_Entity (Arch); @@ -1266,7 +1280,8 @@ package body Synth.Insts is ((Decl => Entity, Arch => Arch, Config => Get_Block_Configuration (Config), - Syn_Inst => Syn_Inst)); + Syn_Inst => Syn_Inst, + Encoding => Encoding)); Inst := Inst_Obj.Syn_Inst; end Synth_Top_Entity; diff --git a/src/synth/synth-insts.ads b/src/synth/synth-insts.ads index 91608ff62..d90df3183 100644 --- a/src/synth/synth-insts.ads +++ b/src/synth/synth-insts.ads @@ -21,12 +21,14 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; +with Synth.Flags; use Synth.Flags; package Synth.Insts is -- Create the declaration of the top entity. procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc; Arch : Node; Config : Node; + Encoding : Name_Encoding; Inst : out Synth_Instance_Acc); -- Synthesize the top entity and all the sub-modules. diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 742f2e8b4..6e7157a53 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -18,18 +18,20 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Errorout; use Errorout; +with Vhdl.Errors; use Vhdl.Errors; + with Synth.Values; with Synth.Insts; use Synth.Insts; with Synth.Environment.Debug; pragma Unreferenced (Synth.Environment.Debug); -with Errorout; use Errorout; -with Vhdl.Errors; use Vhdl.Errors; - package body Synthesis is - procedure Synth_Design - (Design : Node; M : out Module; Inst : out Synth_Instance_Acc) + procedure Synth_Design (Design : Node; + Encoding : Name_Encoding; + M : out Module; + Inst : out Synth_Instance_Acc) is Unit : constant Node := Get_Library_Unit (Design); Arch : Node; @@ -54,7 +56,7 @@ package body Synthesis is Synth.Values.Init; - Synth_Top_Entity (Global_Instance, Arch, Config, Inst); + Synth_Top_Entity (Global_Instance, Arch, Config, Encoding, Inst); Synth_All_Instances; if Errorout.Nbr_Errors > 0 then M := No_Module; diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads index abf564ba9..661376979 100644 --- a/src/synth/synthesis.ads +++ b/src/synth/synthesis.ads @@ -19,12 +19,17 @@ -- MA 02110-1301, USA. with Vhdl.Nodes; use Vhdl.Nodes; + with Netlists; use Netlists; + with Synth.Context; use Synth.Context; +with Synth.Flags; use Synth.Flags; package Synthesis is - procedure Synth_Design - (Design : Iir; M : out Module; Inst : out Synth_Instance_Acc); + procedure Synth_Design (Design : Iir; + Encoding : Name_Encoding; + M : out Module; + Inst : out Synth_Instance_Acc); Synth_Error : exception; end Synthesis; |