synth: handle subtypes in components. Fix #970

4 files changed, 61 insertions, 20 deletions

diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 85845c09b..12703bc64 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -301,6 +301,48 @@ package body Synth.Insts is
       end loop;
    end Synth_Instantiate_Module;
 
+   procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
+                                         Syn_Inst : Synth_Instance_Acc;
+                                         Inter_Chain : Node;
+                                         Assoc_Chain : Node)
+   is
+      Inter : Node;
+      Inter_Type : Type_Acc;
+      Assoc : Node;
+      Assoc_Inter : Node;
+      Actual : Node;
+      Val : Value_Acc;
+   begin
+      Assoc := Assoc_Chain;
+      Assoc_Inter := Inter_Chain;
+      while Is_Valid (Assoc) loop
+         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+
+         Synth_Declaration_Type (Sub_Inst, Inter);
+         Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter));
+
+         pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               Actual := Get_Default_Value (Inter);
+               Val := Synth_Expression_With_Type
+                 (Sub_Inst, Actual, Inter_Type);
+            when Iir_Kind_Association_Element_By_Expression =>
+               Actual := Get_Actual (Assoc);
+               Val := Synth_Expression_With_Type
+                 (Syn_Inst, Actual, Inter_Type);
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);
+
+         Create_Object (Sub_Inst, Inter, Val);
+
+         Next_Association_Interface (Assoc, Assoc_Inter);
+      end loop;
+   end Synth_Generics_Association;
+
    procedure Synth_Direct_Instantiation_Statement
      (Syn_Inst : Synth_Instance_Acc;
       Stmt : Node;
@@ -319,15 +361,9 @@ package body Synth.Insts is
       Sub_Inst := Make_Instance
         (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent)));
 
-      Inter := Get_Generic_Chain (Ent);
-      while Is_Valid (Inter) loop
-         Synth_Declaration_Type (Sub_Inst, Inter);
-         Inter := Get_Chain (Inter);
-      end loop;
-
-      Synth_Subprogram_Association (Sub_Inst, Syn_Inst,
-                                    Get_Generic_Chain (Ent),
-                                    Get_Generic_Map_Aspect_Chain (Stmt));
+      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
@@ -455,9 +491,10 @@ package body Synth.Insts is
       --  Elaborate generic + map aspect
       Comp_Inst := Make_Instance (Syn_Inst, Component,
                                   New_Sname_User (Get_Identifier (Component)));
-      Synth_Subprogram_Association (Comp_Inst, Syn_Inst,
-                                    Get_Generic_Chain (Component),
-                                    Get_Generic_Map_Aspect_Chain (Stmt));
+
+      Synth_Generics_Association (Comp_Inst, Syn_Inst,
+                                  Get_Generic_Chain (Component),
+                                  Get_Generic_Map_Aspect_Chain (Stmt));
 
       --  Create objects for inputs and outputs, assign inputs.
       declare
@@ -521,9 +558,9 @@ package body Synth.Insts is
       --  Elaborate generic + map aspect
       Sub_Inst := Make_Instance
         (Comp_Inst, Ent, New_Sname_User (Get_Identifier (Ent)));
-      Synth_Subprogram_Association (Sub_Inst, Comp_Inst,
-                                    Get_Generic_Chain (Ent),
-                                    Get_Generic_Map_Aspect_Chain (Bind));
+      Synth_Generics_Association (Sub_Inst, Comp_Inst,
+                                  Get_Generic_Chain (Ent),
+                                  Get_Generic_Map_Aspect_Chain (Bind));
 
       --  Search if corresponding module has already been used.
       --  If not create a new module
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
index fbd345be0..cf0aafb9a 100644
--- a/src/synth/synth-oper.adb
+++ b/src/synth/synth-oper.adb
@@ -970,7 +970,7 @@ package body Synth.Oper is
       Subprg_Inst := Make_Instance (Syn_Inst, Imp);
 
       Synth_Subprogram_Association
-        (Subprg_Inst, Syn_Inst, Inter_Chain, Assoc_Chain);
+        (Subprg_Inst, Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain);
 
       Param1 := Inter_Chain;
       if Param1 /= Null_Node then
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 50229d775..a9cc0d377 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -1211,6 +1211,7 @@ package body Synth.Stmts is
    end Synth_Selected_Signal_Assignment;
 
    procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
+                                           Inter_Inst  : Synth_Instance_Acc;
                                            Caller_Inst : Synth_Instance_Acc;
                                            Inter_Chain : Node;
                                            Assoc_Chain : Node;
@@ -1232,7 +1233,7 @@ package body Synth.Stmts is
       Assoc_Inter := Inter_Chain;
       while Is_Valid (Assoc) loop
          Inter := Get_Association_Interface (Assoc, Assoc_Inter);
-         Inter_Type := Get_Value_Type (Subprg_Inst, Get_Type (Inter));
+         Inter_Type := Get_Value_Type (Inter_Inst, Get_Type (Inter));
 
          case Iir_Parameter_Modes (Get_Mode (Inter)) is
             when Iir_In_Mode =>
@@ -1295,6 +1296,7 @@ package body Synth.Stmts is
    end Synth_Subprogram_Association;
 
    procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
+                                           Inter_Inst  : Synth_Instance_Acc;
                                            Caller_Inst : Synth_Instance_Acc;
                                            Inter_Chain : Node;
                                            Assoc_Chain : Node)
@@ -1302,8 +1304,8 @@ package body Synth.Stmts is
       Infos : Target_Info_Array (1 .. 0);
       pragma Unreferenced (Infos);
    begin
-      Synth_Subprogram_Association
-        (Subprg_Inst, Caller_Inst, Inter_Chain, Assoc_Chain, Infos);
+      Synth_Subprogram_Association (Subprg_Inst, Inter_Inst, Caller_Inst,
+                                    Inter_Chain, Assoc_Chain, Infos);
    end Synth_Subprogram_Association;
 
    procedure Synth_Subprogram_Back_Association
@@ -1414,7 +1416,7 @@ package body Synth.Stmts is
          Infos : Target_Info_Array (1 .. Nbr_Inout);
       begin
          Synth_Subprogram_Association
-           (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+           (C.Inst, Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
 
          Push_Phi;
 
diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads
index aed471c03..a09472168 100644
--- a/src/synth/synth-stmts.ads
+++ b/src/synth/synth-stmts.ads
@@ -28,7 +28,9 @@ with Synth.Context; use Synth.Context;
 with Synth.Environment; use Synth.Environment;
 
 package Synth.Stmts is
+   --  INTER_INST is the instance for the types of the formals.
    procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
+                                           Inter_Inst  : Synth_Instance_Acc;
                                            Caller_Inst : Synth_Instance_Acc;
                                            Inter_Chain : Node;
                                            Assoc_Chain : Node);