diff options
-rw-r--r-- | src/synth/synth-insts.adb | 156 | ||||
-rw-r--r-- | src/synth/types_utils.ads | 3 |
2 files changed, 155 insertions, 4 deletions
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 8b1edaf7d..d524e5037 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -18,7 +18,11 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with GNAT.SHA1; + with Types; use Types; +with Types_Utils; use Types_Utils; +with Name_Table; with Libraries; with Hash; use Hash; with Dyn_Tables; @@ -131,6 +135,151 @@ package body Synth.Insts is return True; end Equal; + procedure Hash_Uns64 (C : in out GNAT.SHA1.Context; Val : Uns64) + is + V : Uns64; + S : String (1 .. 8); + begin + -- Store to S using little endianness. + V := Val; + for I in S'Range loop + S (I) := Character'Val (V and 16#ff#); + V := Shift_Right (V, 8); + end loop; + + GNAT.SHA1.Update (C, S); + end Hash_Uns64; + + procedure Hash_Bound (C : in out GNAT.SHA1.Context; B : Bound_Type) is + begin + Hash_Uns64 (C, Iir_Direction'Pos (B.Dir)); + Hash_Uns64 (C, To_Uns64 (Int64 (B.Left))); + Hash_Uns64 (C, To_Uns64 (Int64 (B.Right))); + end Hash_Bound; + + procedure Hash_Bounds (C : in out GNAT.SHA1.Context; Typ : Type_Acc) is + begin + case Typ.Kind is + when Type_Vector => + Hash_Bound (C, Typ.Vbound); + when Type_Array => + for I in Typ.Abounds.D'Range loop + Hash_Bound (C, Typ.Abounds.D (I)); + end loop; + when others => + raise Internal_Error; + end case; + end Hash_Bounds; + + procedure Hash_Const (C : in out GNAT.SHA1.Context; Val : Value_Acc) is + begin + case Val.Kind is + when Value_Discrete => + Hash_Uns64 (C, To_Uns64 (Val.Scal)); + when Value_Float => + Hash_Uns64 (C, To_Uns64 (Val.Fp)); + when Value_Const_Array => + -- Bounds. + Hash_Bounds (C, Val.Typ); + -- Values. + for I in Val.Arr.V'Range loop + Hash_Const (C, Val.Arr.V (I)); + end loop; + when Value_Const_Record => + for I in Val.Rec.V'Range loop + Hash_Const (C, Val.Rec.V (I)); + end loop; + when Value_Const => + Hash_Const (C, Val.C_Val); + when Value_Net + | Value_Wire + | Value_Array + | Value_Record + | Value_Access + | Value_File + | Value_Instance + | Value_Alias + | Value_Subtype => + raise Internal_Error; + end case; + end Hash_Const; + + function Create_Module_Name (Params : Inst_Params) return Sname + is + use GNAT.SHA1; + Decl : constant Node := Params.Decl; + Id : constant Name_Id := Get_Identifier (Decl); + Generics : constant Node := Get_Generic_Chain (Decl); + Gen_Decl : Node; + Gen : Value_Acc; + Ctxt : GNAT.SHA1.Context; + Has_Hash : Boolean; + begin + -- Easy case: no generics, so simply use the name of the entity. + -- TODO: what about two entities with the same identifier but declared + -- in two different libraries ? + -- TODO: what about extended identifiers ? + if Generics = Null_Node then + return New_Sname_User (Id, No_Sname); + end if; + + -- Create a buffer, store the entity name. + -- For each generic: + -- * write the value for integers. + -- * write the identifier for enumerated type with only non-extended + -- 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; + begin + Len := Id_Len; + Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len); + + Has_Hash := False; + 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; + + if Has_Hash then + Str (Len + 1) := '_'; + Len := Len + 1; + Str (Len + 1 .. Len + 40) := GNAT.SHA1.Digest (Ctxt); + Len := Len + 40; + end if; + + return New_Sname_User (Get_Identifier (Str (1 .. Len)), No_Sname); + end; + end Create_Module_Name; + function Build (Params : Inst_Params) return Inst_Object is Decl : constant Node := Params.Decl; @@ -207,10 +356,9 @@ package body Synth.Insts is -- Declare module. -- Build it now because it may be referenced for instantiations before -- being synthetized. - Cur_Module := New_User_Module - (Get_Top_Module (Root_Instance), - New_Sname_User (Get_Identifier (Decl), No_Sname), - Id_User_None, Nbr_Inputs, Nbr_Outputs, 0); + Cur_Module := New_User_Module (Get_Top_Module (Root_Instance), + Create_Module_Name (Params), + Id_User_None, Nbr_Inputs, Nbr_Outputs, 0); -- Add ports to module. declare diff --git a/src/synth/types_utils.ads b/src/synth/types_utils.ads index 4e01d89fc..71bdf5399 100644 --- a/src/synth/types_utils.ads +++ b/src/synth/types_utils.ads @@ -32,4 +32,7 @@ package Types_Utils is function To_Int64 is new Ada.Unchecked_Conversion (Uns64, Int64); + + function To_Uns64 is new Ada.Unchecked_Conversion + (Fp64, Uns64); end Types_Utils; |