Rework inertial associations.

Fix #1625
Fix #1672

8 files changed, 228 insertions, 46 deletions

diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 72b88140c..65e2297dd 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2791,15 +2791,15 @@ package body Trans.Chap4 is
       Base_Block : Iir;
       Entity     : Iir)
    is
-      Formal : constant Iir := Get_Association_Formal (Assoc, Inter);
-      Actual : constant Iir := Get_Actual (Assoc);
+      Formal     : constant Iir := Get_Association_Formal (Assoc, Inter);
+      Actual     : constant Iir := Get_Actual (Assoc);
+      Block_Info : constant Block_Info_Acc := Get_Info (Base_Block);
 
       Mark2, Mark3      : Id_Mark_Type;
       Inter_List        : O_Inter_List;
       In_Type, Out_Type : Iir;
       In_Info, Out_Info : Type_Info_Acc;
       El_List           : O_Element_List;
-      Block_Info        : constant Block_Info_Acc := Get_Info (Base_Block);
       Stmt_Info         : Block_Info_Acc;
       Entity_Info       : Ortho_Info_Acc;
       Var_Data          : O_Dnode;
@@ -2835,10 +2835,8 @@ package body Trans.Chap4 is
             Imp := Get_Formal_Conversion (Assoc);
 
       end case;
-      --  FIXME: individual assoc -> overload.
-      Push_Identifier_Prefix
-        (Mark3, Get_Identifier (Get_Association_Interface (Assoc, Inter)),
-         Num);
+      --  Add interface name and a unique number in case of individual assoc.
+      Push_Identifier_Prefix (Mark3, Get_Identifier (Inter), Num);
 
       --  Handle anonymous subtypes.
       Chap3.Translate_Anonymous_Subtype_Definition (Out_Type, False);
@@ -2930,7 +2928,7 @@ package body Trans.Chap4 is
       V := Create_Temp_Init
         (Block_Info.Block_Decls_Ptr_Type,
          New_Value_Selected_Acc_Value (New_Obj (Var_Data),
-           Conv_Info.Instance_Field));
+                                       Conv_Info.Instance_Field));
       Set_Scope_Via_Param_Ptr (Block_Info.Block_Scope, V);
 
       --  Add an access to instantiated entity.
@@ -3097,11 +3095,114 @@ package body Trans.Chap4 is
       Pop_Identifier_Prefix (Mark2);
    end Translate_Association_Subprogram;
 
+   procedure Translate_Inertial_Subprogram
+     (Stmt       : Iir;
+      Block      : Iir;
+      Assoc      : Iir;
+      Inter      : Iir;
+      Num        : Iir_Int32;
+      Base_Block : Iir;
+      Entity     : Iir)
+   is
+      pragma Unreferenced (Num);
+      Formal     : constant Iir := Get_Association_Formal (Assoc, Inter);
+      Actual     : constant Iir := Get_Actual (Assoc);
+      Block_Info : constant Block_Info_Acc := Get_Info (Base_Block);
+      Assoc_Info  : Inertial_Info_Acc;
+      Inter_List  : O_Inter_List;
+      Entity_Info : Ortho_Info_Acc;
+      Targ : Mnode;
+      Val : Mnode;
+   begin
+      --  Declare the subprogram.
+      Assoc_Info := Add_Info (Assoc, Kind_Inertial_Assoc);
+      Start_Procedure_Decl
+        (Inter_List, Create_Identifier (Inter, "INERTIAL"),
+         O_Storage_Private);
+      New_Interface_Decl (Inter_List, Assoc_Info.Inertial_Inst,
+                          Wki_Instance, Block_Info.Block_Decls_Ptr_Type);
+      Finish_Subprogram_Decl (Inter_List, Assoc_Info.Inertial_Proc);
+
+      --  The body.
+      New_Debug_Line_Decl (Get_Line_Number (Assoc));
+      Start_Subprogram_Body (Assoc_Info.Inertial_Proc);
+      Push_Local_Factory;
+      --  Access for actual.
+      Assoc_Info.Inertial_Block := Base_Block;
+      Set_Scope_Via_Param_Ptr (Block_Info.Block_Scope,
+                               Assoc_Info.Inertial_Inst);
+
+      Open_Temp;
+
+      --  Access for formals.
+      if Entity /= Null_Iir then
+         Entity_Info := Get_Info (Entity);
+         declare
+            Inst_Info  : constant Block_Info_Acc := Get_Info (Stmt);
+            V : O_Dnode;
+         begin
+            if Entity_Info.Kind = Kind_Component then
+               Set_Scope_Via_Field (Entity_Info.Comp_Scope,
+                                    Inst_Info.Block_Link_Field,
+                                    Block_Info.Block_Scope'Access);
+            else
+               --  Get access to the directly instantiated entity through
+               --  the link.  The link is a __ghdl_component_link_type which
+               --  points to the __ghdl_entity_link_type of the entity.
+               V := Create_Temp_Init
+                 (Entity_Info.Block_Decls_Ptr_Type,
+                  New_Convert_Ov
+                    (New_Value
+                       (New_Selected_Element
+                          (New_Selected_Element
+                             (New_Access_Element (Get_Instance_Access (Block)),
+                              Inst_Info.Block_Link_Field),
+                           Rtis.Ghdl_Component_Link_Instance)),
+                     Entity_Info.Block_Decls_Ptr_Type));
+               Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, V);
+            end if;
+
+         end;
+      end if;
+
+      --  Access for formal.
+      --  1. Translate target (translate_name)
+      Targ := Chap6.Translate_Name (Formal, Mode_Signal);
+
+      --  2. Translate expression
+      Val := Chap7.Translate_Expression (Actual, Get_Type (Formal));
+
+      --  3. Check bounds match
+      --  TODO
+
+      --  4. Call Gen_Simple_Signal_Assign
+      Chap8.Translate_Inertial_Assignment
+        (Targ, Get_Type (Formal), Val, Assoc);
+
+      --  Set_Map_Env (Formal_Env);
+
+      if Entity /= Null_Iir then
+         if Entity_Info.Kind = Kind_Component then
+            Clear_Scope (Entity_Info.Comp_Scope);
+         else
+            Clear_Scope (Entity_Info.Block_Scope);
+         end if;
+      end if;
+
+      Close_Temp;
+
+      Clear_Scope (Block_Info.Block_Scope);
+      Pop_Local_Factory;
+      Finish_Subprogram_Body;
+   end Translate_Inertial_Subprogram;
+
+   --  Create subprograms for associations: conversions and inertial assocs.
    --  ENTITY is null for block_statement.
    procedure Translate_Association_Subprograms
      (Stmt : Iir; Block : Iir; Base_Block : Iir; Entity : Iir)
    is
       Assoc : Iir;
+      Assoc_Inter : Iir;
       Inter : Iir;
       Info  : Assoc_Info_Acc;
       Num : Iir_Int32;
@@ -3109,31 +3210,43 @@ package body Trans.Chap4 is
       Assoc := Get_Port_Map_Aspect_Chain (Stmt);
       Num := 0;
       if Is_Null (Entity) then
-         Inter := Get_Port_Chain (Stmt);
+         Assoc_Inter := Get_Port_Chain (Stmt);
       else
-         Inter := Get_Port_Chain (Entity);
+         Assoc_Inter := Get_Port_Chain (Entity);
       end if;
       while Assoc /= Null_Iir loop
-         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Name then
-            Info := null;
-            if Get_Actual_Conversion (Assoc) /= Null_Iir then
-               Info := Add_Info (Assoc, Kind_Assoc);
-               Translate_Association_Subprogram
-                 (Stmt, Block, Assoc, Inter, Conv_Mode_In, Info.Assoc_In,
-                  Num, Base_Block, Entity);
-               Num := Num + 1;
-            end if;
-            if Get_Formal_Conversion (Assoc) /= Null_Iir then
-               if Info = null then
+         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_By_Name =>
+               Info := null;
+               if Get_Actual_Conversion (Assoc) /= Null_Iir then
                   Info := Add_Info (Assoc, Kind_Assoc);
+                  Translate_Association_Subprogram
+                    (Stmt, Block, Assoc, Inter, Conv_Mode_In, Info.Assoc_In,
+                     Num, Base_Block, Entity);
+                  Num := Num + 1;
                end if;
-               Translate_Association_Subprogram
-                 (Stmt, Block, Assoc, Inter, Conv_Mode_Out, Info.Assoc_Out,
-                  Num, Base_Block, Entity);
-               Num := Num + 1;
-            end if;
-         end if;
-         Next_Association_Interface (Assoc, Inter);
+               if Get_Formal_Conversion (Assoc) /= Null_Iir then
+                  if Info = null then
+                     Info := Add_Info (Assoc, Kind_Assoc);
+                  end if;
+                  Translate_Association_Subprogram
+                    (Stmt, Block, Assoc, Inter, Conv_Mode_Out, Info.Assoc_Out,
+                     Num, Base_Block, Entity);
+                  Num := Num + 1;
+               end if;
+            when Iir_Kind_Association_Element_By_Expression =>
+               if Get_Expr_Staticness (Get_Actual (Assoc)) = None then
+                  Translate_Inertial_Subprogram
+                    (Stmt, Block, Assoc, Inter, Num, Base_Block, Entity);
+               end if;
+            when Iir_Kind_Association_Element_By_Individual
+              | Iir_Kind_Association_Element_Open =>
+               null;
+            when others =>
+               Error_Kind ("translate_association_subprograms", Assoc);
+         end case;
+         Next_Association_Interface (Assoc, Assoc_Inter);
       end loop;
    end Translate_Association_Subprograms;
 
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index 9b2eec152..e9b11f8eb 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -760,9 +760,17 @@ package body Trans.Chap5 is
                         --  Create non-collapsed signals.
                         Chap4.Elab_Signal_Declaration_Object
                           (Formal, Block_Parent, False);
-                        --  And associate.
-                        Elab_Port_Map_Aspect_Assoc
-                          (Assoc, Formal, False, Formal_Env, Actual_Env);
+                        --  And associate (if not an inertial association).
+                        if (Get_Kind (Assoc)
+                              = Iir_Kind_Association_Element_By_Name)
+                          or else (Get_Expr_Staticness (Get_Actual (Assoc))
+                                     /= None)
+                        then
+                           Elab_Port_Map_Aspect_Assoc
+                             (Assoc, Formal, False, Formal_Env, Actual_Env);
+                        else
+                           Chap9.Elab_Inertial_Association (Assoc, Formal);
+                        end if;
                      end if;
                   else
                      --  By sub-element.
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 3626460aa..d9616fa97 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -4745,6 +4745,14 @@ package body Trans.Chap8 is
       end;
    end Translate_Waveform_Assignment;
 
+   procedure Translate_Inertial_Assignment
+     (Targ : Mnode; Targ_Type : Iir; Val : Mnode; Assoc : Iir) is
+   begin
+      Signal_Assign_Line := Get_Line_Number (Assoc);
+
+      Gen_Simple_Signal_Assign (Targ, Targ_Type, M2E (Val));
+   end Translate_Inertial_Assignment;
+
    procedure Translate_Simple_Signal_Assignment_Statement (Stmt : Iir)
    is
       Target : constant Iir := Strip_Reference_Name (Get_Target (Stmt));
diff --git a/src/vhdl/translate/trans-chap8.ads b/src/vhdl/translate/trans-chap8.ads
index 466b25a14..a15f57d99 100644
--- a/src/vhdl/translate/trans-chap8.ads
+++ b/src/vhdl/translate/trans-chap8.ads
@@ -90,4 +90,8 @@ package Trans.Chap8 is
 
    function Translate_Subprogram_Call
      (Call : Iir; Assoc_Chain : Iir; Obj : Iir) return O_Enode;
+
+   --  Signal assignment for an inertial association.
+   procedure Translate_Inertial_Assignment
+     (Targ : Mnode; Targ_Type : Iir; Val : Mnode; Assoc : Iir);
 end Trans.Chap8;
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 89bc687d5..fe5a291b5 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -172,6 +172,7 @@ package body Trans.Chap9 is
       Push_Identifier_Prefix (Mark, Get_Label (Inst));
       Num := 0;
 
+      --  Add a pointer to the instance.
       if Is_Component_Instantiation (Inst) then
          --  Via a component declaration.
          declare
@@ -979,7 +980,7 @@ package body Trans.Chap9 is
       Info.Block_Configured_Field := Add_Instance_Factory_Field
         (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
 
-                  --  Iterator.
+      --  Iterator.
       It_Info := Add_Info (Param, Kind_Iterator);
       It_Info.Iterator_Var := Create_Var
         (Create_Var_Identifier (Param),
@@ -1773,7 +1774,7 @@ package body Trans.Chap9 is
       New_Association
         (Constr,
          New_Lit (New_Subprogram_Address (Info.Process_Subprg,
-           Ghdl_Ptr_Type)));
+                                          Ghdl_Ptr_Type)));
       Rtis.Associate_Rti_Context (Constr, Proc);
       New_Procedure_Call (Constr);
 
@@ -1887,6 +1888,42 @@ package body Trans.Chap9 is
       end if;
    end Elab_Process;
 
+   procedure Elab_Inertial_Association (Assoc : Iir; Formal : Iir)
+   is
+      Info      : constant Inertial_Info_Acc := Get_Info (Assoc);
+      Constr        : O_Assoc_List;
+      List          : Iir_List;
+   begin
+      New_Debug_Line_Stmt (Get_Line_Number (Assoc));
+
+      --  Register proc.
+      Start_Association (Constr, Ghdl_Sensitized_Process_Register);
+      New_Association
+        (Constr, New_Convert_Ov (Get_Instance_Access (Info.Inertial_Block),
+                                 Ghdl_Ptr_Type));
+      New_Association
+        (Constr,
+         New_Lit (New_Subprogram_Address (Info.Inertial_Proc,
+                                          Ghdl_Ptr_Type)));
+      Rtis.Associate_Null_Rti_Context (Constr);
+      New_Procedure_Call (Constr);
+
+      --  Driver
+      Register_Signal (Chap6.Translate_Name (Formal, Mode_Signal),
+                       Get_Type (Formal),
+                       Ghdl_Process_Add_Driver);
+
+      --  Sensitivity
+      List := Create_Iir_List;
+      Vhdl.Canon.Canon_Extract_Sensitivity_Expression
+        (Get_Actual (Assoc), List, False);
+      --  For extracted sensitivity, any signal can appear in the list.
+      --  Remove transient types now.
+      Destroy_Types_In_List (List);
+      Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
+      Destroy_Iir_List (List);
+   end Elab_Inertial_Association;
+
    --  PROC: the process to be elaborated
    --  BLOCK: the block containing the process (its parent)
    --  BASE_INFO: info for the global block
@@ -2148,22 +2185,22 @@ package body Trans.Chap9 is
             --  Set the ghdl_component_link_instance field.
             New_Assign_Stmt
               (New_Selected_Element
-                 (New_Selected_Element (Get_Instance_Ref (Ref_Scope),
-                  Link_Field),
+                 (New_Selected_Element
+                    (Get_Instance_Ref (Ref_Scope), Link_Field),
                   Rtis.Ghdl_Component_Link_Instance),
-               New_Address (New_Selected_Acc_Value
-                 (New_Obj (Var_Sub),
-                      Entity_Info.Block_Link_Field),
-                 Rtis.Ghdl_Entity_Link_Acc));
+               New_Address
+                 (New_Selected_Acc_Value
+                    (New_Obj (Var_Sub), Entity_Info.Block_Link_Field),
+                  Rtis.Ghdl_Entity_Link_Acc));
             --  Set the ghdl_entity_link_parent field.
             New_Assign_Stmt
               (New_Selected_Element
-                 (New_Selected_Acc_Value (New_Obj (Var_Sub),
-                  Entity_Info.Block_Link_Field),
+                 (New_Selected_Acc_Value
+                    (New_Obj (Var_Sub), Entity_Info.Block_Link_Field),
                   Rtis.Ghdl_Entity_Link_Parent),
                New_Address
-                 (New_Selected_Element (Get_Instance_Ref (Ref_Scope),
-                  Link_Field),
+                 (New_Selected_Element
+                    (Get_Instance_Ref (Ref_Scope), Link_Field),
                   Rtis.Ghdl_Component_Link_Acc));
          end Set_Links;
       begin
diff --git a/src/vhdl/translate/trans-chap9.ads b/src/vhdl/translate/trans-chap9.ads
index deb3968ed..069ee693b 100644
--- a/src/vhdl/translate/trans-chap9.ads
+++ b/src/vhdl/translate/trans-chap9.ads
@@ -30,6 +30,9 @@ package Trans.Chap9 is
    procedure Translate_Entity_Instantiation
      (Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir);
 
+   --  Elaborate an inertial association: register the anonymous process.
+   procedure Elab_Inertial_Association (Assoc : Iir; Formal : Iir);
+
    --  Remove anonymous and implicit type definitions in a list of names.
    --  Such type definitions are created during slice translations, however
    --  variables created are defined in the translation scope.
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index ecfc79203..3c47d94ec 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -739,6 +739,7 @@ package Trans is
       Kind_Package_Instance,
       Kind_Config,
       Kind_Assoc,
+      Kind_Inertial_Assoc,
       Kind_Design_File,
       Kind_Library,
       Kind_Expr_Eval
@@ -1204,6 +1205,7 @@ package Trans is
    subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field);
    subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config);
    subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc);
+   subtype Inertial_Info_Acc is Ortho_Info_Acc (Kind_Inertial_Assoc);
    subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface);
    subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File);
    subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library);
@@ -2117,6 +2119,11 @@ package Trans is
             Assoc_In  : Assoc_Conv_Info;
             Assoc_Out : Assoc_Conv_Info;
 
+         when Kind_Inertial_Assoc =>
+            Inertial_Proc : O_Dnode;
+            Inertial_Inst : O_Dnode;
+            Inertial_Block : Iir;
+
          when Kind_Design_File =>
             Design_Filename : O_Dnode;
 
diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb
index 142a7706b..d223935d3 100644
--- a/src/vhdl/vhdl-sem.adb
+++ b/src/vhdl/vhdl-sem.adb
@@ -618,9 +618,11 @@ package body Vhdl.Sem is
             if Get_Expr_Staticness (Actual) < Globally then
                if Flags.Vhdl_Std >= Vhdl_08 then
                   --  LRM08 6.5.6.3 Port clauses
-                  Actual := Sem_Insert_Anonymous_Signal (Formal, Actual);
-                  Set_Actual (Assoc, Actual);
-                  Set_Collapse_Signal_Flag (Assoc, True);
+                  if False then
+                     Actual := Sem_Insert_Anonymous_Signal (Formal, Actual);
+                     Set_Actual (Assoc, Actual);
+                     Set_Collapse_Signal_Flag (Assoc, True);
+                  end if;
                else
                   Error_Msg_Sem
                     (+Actual, "actual expression must be globally static");