synth: consider ports size to create unique instances.

3 files changed, 143 insertions, 49 deletions

diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 60db8d921..46616484a 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -131,7 +131,18 @@ package body Synth.Insts is
          Inter := Get_Chain (Inter);
       end loop;
 
-      --  TODO: ports size ?
+      Inter := Get_Port_Chain (Params.Decl);
+      while Inter /= Null_Node loop
+         if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
+            if not Are_Types_Equal (Get_Value (Obj.Syn_Inst, Inter).Typ,
+                                    Get_Value (Params.Syn_Inst, Inter).Typ)
+            then
+               return False;
+            end if;
+         end if;
+         Inter := Get_Chain (Inter);
+      end loop;
+
       return True;
    end Equal;
 
@@ -210,19 +221,10 @@ package body Synth.Insts is
       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;
+      Ports : constant Node := Get_Port_Chain (Decl);
       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.
@@ -237,6 +239,9 @@ package body Synth.Insts is
          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);
@@ -269,6 +274,29 @@ package body Synth.Insts is
             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;
+
          if Has_Hash then
             Str (Len + 1) := '_';
             Len := Len + 1;
@@ -736,55 +764,35 @@ package body Synth.Insts is
       return null;
    end Synth_Type_Of_Object;
 
-   procedure Synth_Direct_Instantiation_Statement
-     (Syn_Inst : Synth_Instance_Acc;
-      Stmt : Node;
-      Ent : Node;
-      Arch : Node;
-      Config : Node)
+   procedure Synth_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc;
+                                           Syn_Inst : Synth_Instance_Acc;
+                                           Inter_Chain : Node;
+                                           Assoc_Chain : Node)
    is
-      Sub_Inst : Synth_Instance_Acc;
       Inter : Node;
-      Inter_Typ : Type_Acc;
-      Inst_Obj : Inst_Object;
-      Inst : Instance;
+      Assoc : Node;
       Val : Value_Acc;
+      Inter_Typ : Type_Acc;
    begin
-      --  Elaborate generic + map aspect
-      Sub_Inst := Make_Instance
-        (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname));
-
-      Synth_Generics_Association (Sub_Inst, Syn_Inst,
-                                  Get_Generic_Chain (Ent),
-                                  Get_Generic_Map_Aspect_Chain (Stmt));
-
-      --  Elaborate port types.
-      --  FIXME: what about unconstrained ports ?  Get the type from the
-      --    association.
-      Inter := Get_Port_Chain (Ent);
+      Inter := Inter_Chain;
       while Is_Valid (Inter) loop
          if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
             --  TODO
             --  Find the association for this interface
             --  * if individual assoc: get type
             --  * if whole assoc: get type from object.
-            declare
-               Assoc : Node;
-            begin
-               Assoc := Find_First_Association_For_Interface
-                 (Get_Port_Map_Aspect_Chain (Stmt), Get_Port_Chain (Ent),
-                  Inter);
-               if Assoc = Null_Node then
+            Assoc := Find_First_Association_For_Interface
+              (Assoc_Chain, Inter_Chain, Inter);
+            if Assoc = Null_Node then
+               raise Internal_Error;
+            end if;
+            case Get_Kind (Assoc) is
+               when Iir_Kind_Association_Element_By_Expression =>
+                  Inter_Typ := Synth_Type_Of_Object
+                    (Syn_Inst, Get_Actual (Assoc));
+               when others =>
                   raise Internal_Error;
-               end if;
-               case Get_Kind (Assoc) is
-                  when Iir_Kind_Association_Element_By_Expression =>
-                     Inter_Typ := Synth_Type_Of_Object
-                       (Syn_Inst, Get_Actual (Assoc));
-                  when others =>
-                     raise Internal_Error;
-               end case;
-            end;
+            end case;
          else
             Synth_Declaration_Type (Sub_Inst, Inter);
             Inter_Typ := Get_Value_Type (Sub_Inst, Get_Type (Inter));
@@ -798,6 +806,31 @@ package body Synth.Insts is
          Create_Object (Sub_Inst, Inter, Val);
          Inter := Get_Chain (Inter);
       end loop;
+   end Synth_Ports_Association_Type;
+
+   procedure Synth_Direct_Instantiation_Statement
+     (Syn_Inst : Synth_Instance_Acc;
+      Stmt : Node;
+      Ent : Node;
+      Arch : Node;
+      Config : Node)
+   is
+      Sub_Inst : Synth_Instance_Acc;
+      Inst_Obj : Inst_Object;
+      Inst : Instance;
+   begin
+      --  Elaborate generic + map aspect
+      Sub_Inst := Make_Instance
+        (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname));
+
+      Synth_Generics_Association (Sub_Inst, Syn_Inst,
+                                  Get_Generic_Chain (Ent),
+                                  Get_Generic_Map_Aspect_Chain (Stmt));
+
+      --  Elaborate port types.
+      Synth_Ports_Association_Type (Sub_Inst, Syn_Inst,
+                                    Get_Port_Chain (Ent),
+                                    Get_Port_Map_Aspect_Chain (Stmt));
 
       --  Search if corresponding module has already been used.
       --  If not create a new module
@@ -977,6 +1010,10 @@ package body Synth.Insts is
                                   Get_Generic_Chain (Ent),
                                   Get_Generic_Map_Aspect_Chain (Bind));
 
+      Synth_Ports_Association_Type (Sub_Inst, Comp_Inst,
+                                    Get_Port_Chain (Ent),
+                                    Get_Port_Map_Aspect_Chain (Bind));
+
       --  Search if corresponding module has already been used.
       --  If not create a new module
       --   * create a name from the generics and the library
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index e07af0d8e..7bbc562ac 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -148,6 +148,62 @@ package body Synth.Values is
       end case;
    end Is_Equal;
 
+   function Are_Types_Equal (L, R : Type_Acc) return Boolean is
+   begin
+      if L.Kind /= R.Kind
+        or else L.W /= R.W
+      then
+         return False;
+      end if;
+      if L = R then
+         return True;
+      end if;
+
+      case L.Kind is
+         when Type_Bit
+           | Type_Logic =>
+            return True;
+         when Type_Discrete =>
+            return L.Drange = R.Drange;
+         when Type_Float =>
+            return L.Frange = R.Frange;
+         when Type_Vector =>
+            return L.Vbound = R.Vbound
+              and then Are_Types_Equal (L.Vec_El, R.Vec_El);
+         when Type_Unbounded_Vector =>
+            return Are_Types_Equal (L.Uvec_El, R.Uvec_El);
+         when Type_Slice =>
+            return Are_Types_Equal (L.Slice_El, R.Slice_El);
+         when Type_Array =>
+            if L.Abounds.Len /= R.Abounds.Len then
+               return False;
+            end if;
+            for I in L.Abounds.D'Range loop
+               if L.Abounds.D (I) /= R.Abounds.D (I) then
+                  return False;
+               end if;
+            end loop;
+            return Are_Types_Equal (L.Arr_El, R.Arr_El);
+         when Type_Unbounded_Array =>
+            return L.Uarr_Ndim = R.Uarr_Ndim
+              and then Are_Types_Equal (L.Uarr_El, R.Uarr_El);
+         when Type_Record =>
+            if L.Rec.Len /= R.Rec.Len then
+               return False;
+            end if;
+            for I in L.Rec.E'Range loop
+               if not Are_Types_Equal (L.Rec.E (I).Typ, R.Rec.E (I).Typ) then
+                  return False;
+               end if;
+            end loop;
+            return True;
+         when Type_Access =>
+            return Are_Types_Equal (L.Acc_Acc, R.Acc_Acc);
+         when Type_File =>
+            return Are_Types_Equal (L.File_Typ, R.File_Typ);
+      end case;
+   end Are_Types_Equal;
+
    function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width
    is
       Lo, Hi : Int64;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index a1e75d1bd..93f298720 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -285,6 +285,7 @@ package Synth.Values is
    function Is_Static_Val (Val : Value_Acc) return Boolean;
 
    function Is_Equal (L, R : Value_Acc) return Boolean;
+   function Are_Types_Equal (L, R : Type_Acc) return Boolean;
 
    --  Create a Value_Net.
    function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc;