synth: move procedure call copyback values in context

3 files changed, 82 insertions, 79 deletions

diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb
index 7211c01f0..f46418a6d 100644
--- a/src/synth/elab-vhdl_context.adb
+++ b/src/synth/elab-vhdl_context.adb
@@ -458,21 +458,59 @@ package body Elab.Vhdl_Context is
       Syn_Inst.Uninst_Scope := Get_Info (Bod);
    end Set_Uninstantiated_Scope;
 
-   procedure Destroy_Object
-     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+   procedure Destroy_Init (D : out Destroy_Type;
+                           Syn_Inst : Synth_Instance_Acc) is
+   begin
+      D := (Inst => Syn_Inst,
+            First => Object_Slot_Type'Last,
+            Last => Syn_Inst.Elab_Objects);
+   end Destroy_Init;
+
+   procedure Destroy_Object (D : in out Destroy_Type; Decl : Node)
    is
       Info : constant Sim_Info_Acc := Get_Info (Decl);
       Slot : constant Object_Slot_Type := Info.Slot;
    begin
-      if Slot /= Syn_Inst.Elab_Objects
-        or else Info.Obj_Scope /= Syn_Inst.Block_Scope
-      then
-         Error_Msg_Elab ("synth: bad destroy order");
+      if Info.Obj_Scope /= D.Inst.Block_Scope then
+         --  Bad context.
+         raise Internal_Error;
+      end if;
+      if Slot > D.Last then
+         --  Not elaborated object ?
+         raise Internal_Error;
+      end if;
+      if D.Inst.Objects (Slot).Kind = Obj_None then
+         --  Already destroyed.
+         raise Internal_Error;
       end if;
-      Syn_Inst.Objects (Slot) := (Kind => Obj_None);
-      Syn_Inst.Elab_Objects := Slot - 1;
+      if Slot < D.First then
+         D.First := Slot;
+      end if;
+      D.Inst.Objects (Slot) := (Kind => Obj_None);
    end Destroy_Object;
 
+   procedure Destroy_Finish (D : in out Destroy_Type) is
+   begin
+      if D.First = Object_Slot_Type'Last then
+         --  No object destroyed.
+         return;
+      end if;
+
+      if D.Last /= D.Inst.Elab_Objects then
+         --  Two destroys at the same time.
+         raise Internal_Error;
+      end if;
+
+      --  Check all objects have been destroyed.
+      for I in D.First .. D.Last loop
+         if D.Inst.Objects (I).Kind /= Obj_None then
+            raise Internal_Error;
+         end if;
+      end loop;
+
+      D.Inst.Elab_Objects := D.First - 1;
+   end Destroy_Finish;
+
    function Get_Instance_By_Scope
      (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
      return Synth_Instance_Acc is
diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads
index c67d99b0d..0bf2a4b50 100644
--- a/src/synth/elab-vhdl_context.ads
+++ b/src/synth/elab-vhdl_context.ads
@@ -145,8 +145,11 @@ package Elab.Vhdl_Context is
    procedure Mutate_Object
      (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
 
-   procedure Destroy_Object
-     (Syn_Inst : Synth_Instance_Acc; Decl : Node);
+   type Destroy_Type is limited private;
+   procedure Destroy_Init (D : out Destroy_Type;
+                           Syn_Inst : Synth_Instance_Acc);
+   procedure Destroy_Object (D : in out Destroy_Type; Decl : Node);
+   procedure Destroy_Finish (D : in out Destroy_Type);
 
    --  Get the value of OBJ.
    function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node)
@@ -176,6 +179,12 @@ package Elab.Vhdl_Context is
    function Get_Caller_Instance (Syn_Inst : Synth_Instance_Acc)
                                 return Synth_Instance_Acc;
 private
+   type Destroy_Type is record
+      Inst : Synth_Instance_Acc;
+      First : Object_Slot_Type;
+      Last : Object_Slot_Type;
+   end record;
+
    type Obj_Kind is
      (
       Obj_None,
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 7bccb6736..27ff9642d 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -1644,36 +1644,6 @@ package body Synth.Vhdl_Stmts is
                                         Right => Right);
    end Association_Iterator_Build;
 
-   function Count_Associations (Init : Association_Iterator_Init)
-                               return Nat32
-   is
-      Assoc : Node;
-      Assoc_Inter : Node;
-      Inter : Node;
-      Nbr_Inout : Nat32;
-   begin
-      case Init.Kind is
-         when Association_Function =>
-            Nbr_Inout := 0;
-
-            Assoc := Init.Assoc_Chain;
-            Assoc_Inter := Init.Inter_Chain;
-            while Is_Valid (Assoc) loop
-               Inter := Get_Association_Interface (Assoc, Assoc_Inter);
-
-               if Is_Copyback_Parameter (Inter) then
-                  Nbr_Inout := Nbr_Inout + 1;
-               end if;
-
-               Next_Association_Interface (Assoc, Assoc_Inter);
-            end loop;
-
-            return Nbr_Inout;
-         when Association_Operator =>
-            return 0;
-      end case;
-   end Count_Associations;
-
    type Association_Iterator
      (Kind : Association_Iterator_Kind := Association_Function) is
    record
@@ -1794,24 +1764,19 @@ package body Synth.Vhdl_Stmts is
 
    procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc;
                                             Caller_Inst : Synth_Instance_Acc;
-                                            Init : Association_Iterator_Init;
-                                            Infos : out Valtyp_Array)
+                                            Init : Association_Iterator_Init)
    is
-      pragma Assert (Infos'First = 1);
       Ctxt : constant Context_Acc := Get_Build (Caller_Inst);
       Inter : Node;
       Inter_Type : Type_Acc;
       Assoc : Node;
       Actual : Node;
       Val : Valtyp;
-      Nbr_Inout : Nat32;
       Iterator : Association_Iterator;
       Info : Target_Info;
    begin
       Set_Instance_Const (Subprg_Inst, True);
 
-      Nbr_Inout := 0;
-
       --  Process in INTER order.
       Association_Iterate_Init (Iterator, Init);
       loop
@@ -1844,9 +1809,8 @@ package body Synth.Vhdl_Stmts is
                --  Always pass by value.
                Actual := Get_Actual (Assoc);
                Info := Synth_Target (Caller_Inst, Actual);
-               if Get_Mode (Inter) /= Iir_In_Mode then
-                  Nbr_Inout := Nbr_Inout + 1;
-                  Infos (Nbr_Inout) := Info_To_Valtyp (Info);
+               if Is_Copyback_Parameter (Inter) then
+                  Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info));
                end if;
                if Info.Kind /= Target_Memory
                  and then Is_Static (Info.Obj.Val)
@@ -1974,12 +1938,10 @@ package body Synth.Vhdl_Stmts is
                                            Inter_Chain : Node;
                                            Assoc_Chain : Node)
    is
-      Infos : Valtyp_Array (1 .. 0);
       Init : Association_Iterator_Init;
    begin
       Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain);
-      Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init, Infos);
-      pragma Unreferenced (Infos);
+      Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init);
    end Synth_Subprogram_Association;
 
    --  Create wires for out and inout interface variables.
@@ -2017,20 +1979,18 @@ package body Synth.Vhdl_Stmts is
    procedure Synth_Subprogram_Back_Association
      (Subprg_Inst : Synth_Instance_Acc;
       Caller_Inst : Synth_Instance_Acc;
-      Init : Association_Iterator_Init;
-      Infos : Valtyp_Array)
+      Init : Association_Iterator_Init)
    is
-      pragma Assert (Infos'First = 1);
       Inter : Node;
       Assoc : Node;
       Assoc_Inter : Node;
       Val : Valtyp;
       Targ : Valtyp;
-      Nbr_Inout : Nat32;
       W : Wire_Id;
+      D : Destroy_Type;
    begin
-      Nbr_Inout := 0;
       pragma Assert (Init.Kind = Association_Function);
+      Destroy_Init (D, Caller_Inst);
       Assoc := Init.Assoc_Chain;
       Assoc_Inter := Init.Inter_Chain;
       while Is_Valid (Assoc) loop
@@ -2040,8 +2000,7 @@ package body Synth.Vhdl_Stmts is
             if not Get_Whole_Association_Flag (Assoc) then
                raise Internal_Error;
             end if;
-            Nbr_Inout := Nbr_Inout + 1;
-            Targ := Infos (Nbr_Inout);
+            Targ := Get_Value (Caller_Inst, Assoc);
             Val := Get_Value (Subprg_Inst, Inter);
             if Targ.Val.Kind = Value_Dyn_Alias then
                Synth_Assignment_Memory
@@ -2060,11 +2019,13 @@ package body Synth.Vhdl_Stmts is
                Phi_Discard_Wires (W, No_Wire_Id);
                Free_Wire (W);
             end if;
+
+            Destroy_Object (D, Assoc);
          end if;
 
          Next_Association_Interface (Assoc, Assoc_Inter);
       end loop;
-      pragma Assert (Nbr_Inout = Infos'Last);
+      Destroy_Finish (D);
    end Synth_Subprogram_Back_Association;
 
    function Build_Control_Signal (Syn_Inst : Synth_Instance_Acc;
@@ -2082,8 +2043,7 @@ package body Synth.Vhdl_Stmts is
    function Synth_Dynamic_Subprogram_Call (Syn_Inst : Synth_Instance_Acc;
                                            Sub_Inst : Synth_Instance_Acc;
                                            Call : Node;
-                                           Init : Association_Iterator_Init;
-                                           Infos : Valtyp_Array)
+                                           Init : Association_Iterator_Init)
                                           return Valtyp
    is
       Imp  : constant Node := Get_Implementation (Call);
@@ -2159,7 +2119,7 @@ package body Synth.Vhdl_Stmts is
             end if;
          else
             Res := No_Valtyp;
-            Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos);
+            Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init);
          end if;
       end if;
 
@@ -2167,7 +2127,6 @@ package body Synth.Vhdl_Stmts is
 
       Vhdl_Decls.Finalize_Declarations
         (C.Inst, Get_Declaration_Chain (Bod), True);
-      pragma Unreferenced (Infos);
 
       --  Propagate assignments.
       --  Wires that have been created for this subprogram will be destroyed.
@@ -2194,8 +2153,7 @@ package body Synth.Vhdl_Stmts is
                                           Sub_Inst : Synth_Instance_Acc;
                                           Call     : Node;
                                           Bod      : Node;
-                                          Init : Association_Iterator_Init;
-                                          Infos : Valtyp_Array)
+                                          Init : Association_Iterator_Init)
                                          return Valtyp
    is
       Imp  : constant Node := Get_Implementation (Call);
@@ -2237,13 +2195,12 @@ package body Synth.Vhdl_Stmts is
             end if;
          else
             Res := No_Valtyp;
-            Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos);
+            Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init);
          end if;
       end if;
 
       Vhdl_Decls.Finalize_Declarations
         (C.Inst, Get_Declaration_Chain (Bod), True);
-      pragma Unreferenced (Infos);
 
       return Res;
    end Synth_Static_Subprogram_Call;
@@ -2271,8 +2228,6 @@ package body Synth.Vhdl_Stmts is
       Imp  : constant Node := Get_Implementation (Call);
       Is_Func : constant Boolean := Is_Function_Declaration (Imp);
       Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp);
-      Nbr_Inout : constant Nat32 := Count_Associations (Init);
-      Infos : Valtyp_Array (1 .. Nbr_Inout);
       Area_Mark : Areapools.Mark_Type;
       Res : Valtyp;
       Sub_Inst : Synth_Instance_Acc;
@@ -2284,7 +2239,7 @@ package body Synth.Vhdl_Stmts is
          Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
       end if;
 
-      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init, Infos);
+      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init);
 
       if Is_Error (Sub_Inst) then
          Res := No_Valtyp;
@@ -2297,10 +2252,10 @@ package body Synth.Vhdl_Stmts is
 
          if Get_Instance_Const (Sub_Inst) then
             Res := Synth_Static_Subprogram_Call
-              (Syn_Inst, Sub_Inst, Call, Bod, Init, Infos);
+              (Syn_Inst, Sub_Inst, Call, Bod, Init);
          else
             Res := Synth_Dynamic_Subprogram_Call
-              (Syn_Inst, Sub_Inst, Call, Init, Infos);
+              (Syn_Inst, Sub_Inst, Call, Init);
          end if;
       end if;
 
@@ -2364,8 +2319,6 @@ package body Synth.Vhdl_Stmts is
       Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
       Init : constant Association_Iterator_Init :=
         Association_Iterator_Build (Inter_Chain, Assoc_Chain);
-      Nbr_Inout : constant Nat32 := Count_Associations (Init);
-      Infos : Valtyp_Array (1 .. Nbr_Inout);
       Area_Mark : Areapools.Mark_Type;
       Sub_Inst : Synth_Instance_Acc;
    begin
@@ -2376,11 +2329,11 @@ package body Synth.Vhdl_Stmts is
          Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
       end if;
 
-      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init, Infos);
+      Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init);
 
       Synth.Vhdl_Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call);
 
-      Synth_Subprogram_Back_Association (Sub_Inst, Syn_Inst, Init, Infos);
+      Synth_Subprogram_Back_Association (Sub_Inst, Syn_Inst, Init);
 
       Free_Instance (Sub_Inst);
       Areapools.Release (Area_Mark, Instance_Pool.all);
@@ -2742,11 +2695,14 @@ package body Synth.Vhdl_Stmts is
    is
       Iterator : constant Node := Get_Parameter_Specification (Stmt);
       It_Type : constant Node := Get_Declaration_Type (Iterator);
+      D : Destroy_Type;
    begin
-      Destroy_Object (Inst, Iterator);
+      Destroy_Init (D, Inst);
+      Destroy_Object (D, Iterator);
       if It_Type /= Null_Node then
-         Destroy_Object (Inst, It_Type);
+         Destroy_Object (D, It_Type);
       end if;
+      Destroy_Finish (D);
    end Finish_For_Loop_Statement;
 
    procedure Synth_Dynamic_For_Loop_Statement