synth: preliminary work to factorize code

6 files changed, 69 insertions, 52 deletions

diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb
index 01cfc6b9a..89cf9cf17 100644
--- a/src/simul/simul-vhdl_elab.adb
+++ b/src/simul/simul-vhdl_elab.adb
@@ -423,7 +423,6 @@ package body Simul.Vhdl_Elab is
       Base : Signal_Index_Type;
       Typ : Type_Acc;
       Off : Value_Offsets;
-      Dyn : Dyn_Name;
    begin
       Mark_Expr_Pool (Marker);
 
@@ -432,8 +431,7 @@ package body Simul.Vhdl_Elab is
       while Is_Valid (It) loop
          Sig := Get_Element (It);
          exit when Sig = Null_Node;
-         Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn);
-         pragma Assert (Dyn = No_Dyn_Name);
+         Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off);
          Base := Base_Vt.Val.S;
          Typ := Unshare (Typ, Global_Pool'Access);
 
@@ -457,7 +455,6 @@ package body Simul.Vhdl_Elab is
       Base : Signal_Index_Type;
       Typ : Type_Acc;
       Off : Value_Offsets;
-      Dyn : Dyn_Name;
    begin
       Mark_Expr_Pool (Marker);
 
@@ -465,8 +462,7 @@ package body Simul.Vhdl_Elab is
       while Is_Valid (It) loop
          Sig := Get_Element (It);
          exit when Sig = Null_Node;
-         Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn);
-         pragma Assert (Dyn = No_Dyn_Name);
+         Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off);
          Base := Base_Vt.Val.S;
          Typ := Unshare (Typ, Global_Pool'Access);
 
@@ -580,7 +576,6 @@ package body Simul.Vhdl_Elab is
       Actual_Sig : Signal_Index_Type;
       Typ : Type_Acc;
       Off : Value_Offsets;
-      Dyn : Dyn_Name;
       Conn : Connect_Entry;
       List : Iir_List;
       Formal_Ep, Actual_Ep : Connect_Endpoint;
@@ -597,15 +592,13 @@ package body Simul.Vhdl_Elab is
                   Formal := Inter;
                end if;
                Synth_Assignment_Prefix
-                 (Port_Inst, Formal, Formal_Base, Typ, Off, Dyn);
-               pragma Assert (Dyn = No_Dyn_Name);
+                 (Port_Inst, Formal, Formal_Base, Typ, Off);
                Typ := Unshare (Typ, Global_Pool'Access);
                Formal_Sig := Formal_Base.Val.S;
                Formal_Ep := (Formal_Sig, Off, Typ);
 
                Synth_Assignment_Prefix
-                 (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off, Dyn);
-               pragma Assert (Dyn = No_Dyn_Name);
+                 (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off);
                Typ := Unshare (Typ, Global_Pool'Access);
                Actual_Sig := Actual_Base.Val.S;
                Actual_Ep := (Actual_Sig, Off, Typ);
@@ -666,8 +659,7 @@ package body Simul.Vhdl_Elab is
             when Iir_Kind_Association_Element_By_Expression =>
                Inter := Get_Association_Interface (Assoc, Assoc_Inter);
                Synth_Assignment_Prefix
-                 (Port_Inst, Inter, Formal_Base, Typ, Off, Dyn);
-               pragma Assert (Dyn = No_Dyn_Name);
+                 (Port_Inst, Inter, Formal_Base, Typ, Off);
                Formal_Sig := Formal_Base.Val.S;
                Formal_Ep := (Formal_Sig, Off, Typ);
 
diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
index d7ceef8e5..5d5f38d25 100644
--- a/src/synth/elab-vhdl_decls.adb
+++ b/src/synth/elab-vhdl_decls.adb
@@ -295,7 +295,6 @@ package body Elab.Vhdl_Decls is
       Obj_Typ : Type_Acc;
       Base : Valtyp;
       Typ : Type_Acc;
-      Dyn : Dyn_Name;
    begin
       Mark_Expr_Pool (Marker);
 
@@ -307,8 +306,7 @@ package body Elab.Vhdl_Decls is
          Obj_Typ := null;
       end if;
 
-      Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off, Dyn);
-      pragma Assert (Dyn = No_Dyn_Name);
+      Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off);
       Typ := Unshare (Typ, Instance_Pool);
       Res := Create_Value_Alias (Base, Off, Typ, Expr_Pool'Access);
       if Obj_Typ /= null then
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index 36fbf818d..c3945a82c 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -500,7 +500,6 @@ package body Synth.Vhdl_Decls is
       Atype : constant Node := Get_Declaration_Type (Decl);
       Marker : Mark_Type;
       Off : Value_Offsets;
-      Dyn : Vhdl_Stmts.Dyn_Name;
       Res : Valtyp;
       Obj_Typ : Type_Acc;
       Base : Valtyp;
@@ -516,9 +515,8 @@ package body Synth.Vhdl_Decls is
 
       Mark_Expr_Pool (Marker);
 
-      Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl),
-                                          Base, Typ, Off, Dyn);
-      pragma Assert (Dyn.Voff = No_Net);
+      Vhdl_Stmts.Synth_Assignment_Prefix
+        (Syn_Inst, Get_Name (Decl), Base, Typ, Off);
       Typ := Unshare (Typ, Instance_Pool);
       if Base.Val.Kind = Value_Net then
          --  Object is a net if it is not writable.  Extract the
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index 99ab99ea2..3775b3f7b 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -2065,7 +2065,8 @@ package body Synth.Vhdl_Expr is
 
                Dyn : Dyn_Name;
             begin
-               Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Dyn);
+               Synth_Assignment_Prefix
+                 (Syn_Inst, Syn_Inst, Expr, Base, Typ, Off, Dyn);
                if Base = No_Valtyp then
                   --  Propagate error.
                   return No_Valtyp;
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index b37cdcc77..199bd86d6 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -101,46 +101,52 @@ package body Synth.Vhdl_Stmts is
    end Synth_Waveform;
 
    procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+                                      Inter_Inst : Synth_Instance_Acc;
                                       Pfx : Node;
                                       Dest_Base : out Valtyp;
                                       Dest_Typ : out Type_Acc;
                                       Dest_Off : out Value_Offsets;
-                                      Dest_Dyn : out Dyn_Name) is
+                                      Dest_Dyn : out Dyn_Name)
+   is
+      procedure Assign_Base (Inst : Synth_Instance_Acc)
+      is
+         Targ : constant Valtyp := Get_Value (Inst, Pfx);
+      begin
+         Dest_Dyn := No_Dyn_Name;
+         Dest_Typ := Targ.Typ;
+
+         if Targ.Val.Kind = Value_Alias then
+            --  Replace alias by the aliased name.
+            Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj);
+            Dest_Off := Targ.Val.A_Off;
+         else
+            Dest_Base := Targ;
+            Dest_Off := No_Value_Offsets;
+         end if;
+      end Assign_Base;
    begin
       case Get_Kind (Pfx) is
          when Iir_Kind_Simple_Name
            | Iir_Kind_Attribute_Name =>
-            Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx),
-                                     Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
+            Synth_Assignment_Prefix
+              (Syn_Inst, Inter_Inst, Get_Named_Entity (Pfx),
+               Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
          when Iir_Kind_Interface_Signal_Declaration
-           | Iir_Kind_Variable_Declaration
            | Iir_Kind_Interface_Variable_Declaration
-           | Iir_Kind_Signal_Declaration
            | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            Assign_Base (Inter_Inst);
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Signal_Declaration
            | Iir_Kind_Constant_Declaration
            | Iir_Kind_File_Declaration
-           | Iir_Kind_Interface_File_Declaration
            | Iir_Kind_Non_Object_Alias_Declaration
            | Iir_Kind_Object_Alias_Declaration
            | Iir_Kind_Attribute_Value
            | Iir_Kind_Free_Quantity_Declaration
            | Iir_Kinds_Branch_Quantity_Declaration
            | Iir_Kind_Dot_Attribute =>
-            declare
-               Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx);
-            begin
-               Dest_Dyn := No_Dyn_Name;
-               Dest_Typ := Targ.Typ;
-
-               if Targ.Val.Kind = Value_Alias then
-                  --  Replace alias by the aliased name.
-                  Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj);
-                  Dest_Off := Targ.Val.A_Off;
-               else
-                  Dest_Base := Targ;
-                  Dest_Off := (0, 0);
-               end if;
-            end;
+            Assign_Base (Syn_Inst);
          when Iir_Kind_Function_Call =>
             Dest_Base := Synth_Expression (Syn_Inst, Pfx);
             Dest_Typ := Dest_Base.Typ;
@@ -155,7 +161,7 @@ package body Synth.Vhdl_Stmts is
                Err : Boolean;
             begin
                Synth_Assignment_Prefix
-                 (Syn_Inst, Get_Prefix (Pfx),
+                 (Syn_Inst, Inter_Inst, Get_Prefix (Pfx),
                   Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
                Strip_Const (Dest_Base);
                Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ,
@@ -197,7 +203,7 @@ package body Synth.Vhdl_Stmts is
                  Get_Element_Position (Get_Named_Entity (Pfx));
             begin
                Synth_Assignment_Prefix
-                 (Syn_Inst, Get_Prefix (Pfx),
+                 (Syn_Inst, Inter_Inst, Get_Prefix (Pfx),
                   Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
                Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs;
 
@@ -213,7 +219,7 @@ package body Synth.Vhdl_Stmts is
                Sl_Off : Value_Offsets;
             begin
                Synth_Assignment_Prefix
-                 (Syn_Inst, Get_Prefix (Pfx),
+                 (Syn_Inst, Inter_Inst, Get_Prefix (Pfx),
                   Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
                Strip_Const (Dest_Base);
 
@@ -253,20 +259,33 @@ package body Synth.Vhdl_Stmts is
          when Iir_Kind_Implicit_Dereference
            | Iir_Kind_Dereference =>
             Synth_Assignment_Prefix
-              (Syn_Inst, Get_Prefix (Pfx),
-               Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn);
-            if Dest_Off /= (0, 0) and then Dest_Dyn.Voff /= No_Net then
+              (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off);
+            if Dest_Off /= (0, 0) then
                raise Internal_Error;
             end if;
             Dest_Base := Create_Value_Memtyp
               (Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Dest_Base)));
             Dest_Typ := Dest_Base.Typ;
+            Dest_Dyn := No_Dyn_Name;
 
          when others =>
             Error_Kind ("synth_assignment_prefix", Pfx);
       end case;
    end Synth_Assignment_Prefix;
 
+   procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+                                      Pfx : Node;
+                                      Dest_Base : out Valtyp;
+                                      Dest_Typ : out Type_Acc;
+                                      Dest_Off : out Value_Offsets)
+   is
+      Dyn : Dyn_Name;
+   begin
+      Synth_Assignment_Prefix
+        (Syn_Inst, Syn_Inst, Pfx, Dest_Base, Dest_Typ, Dest_Off, Dyn);
+      pragma Assert (Dyn = No_Dyn_Name);
+   end Synth_Assignment_Prefix;
+
    function Synth_Aggregate_Target_Type (Syn_Inst : Synth_Instance_Acc;
                                          Target : Node) return Type_Acc
    is
@@ -365,7 +384,8 @@ package body Synth.Vhdl_Stmts is
 
                Dyn : Dyn_Name;
             begin
-               Synth_Assignment_Prefix (Syn_Inst, Target, Base, Typ, Off, Dyn);
+               Synth_Assignment_Prefix
+                 (Syn_Inst, Syn_Inst, Target, Base, Typ, Off, Dyn);
                if Dyn.Voff = No_Net then
                   --  FIXME: check index.
                   return Target_Info'(Kind => Target_Simple,
@@ -4222,14 +4242,12 @@ package body Synth.Vhdl_Stmts is
 
       declare
          Off : Value_Offsets;
-         Dyn : Dyn_Name;
          N : Net;
          Base : Valtyp;
          Typ : Type_Acc;
       begin
-         Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off, Dyn);
+         Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off);
          pragma Assert (Off = (0, 0));
-         pragma Assert (Dyn.Voff = No_Net);
          pragma Assert (Base.Val.Kind = Value_Wire);
          pragma Assert (Base.Typ = Typ);
 
diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads
index 092249225..fde8fd8cd 100644
--- a/src/synth/synth-vhdl_stmts.ads
+++ b/src/synth/synth-vhdl_stmts.ads
@@ -75,13 +75,23 @@ package Synth.Vhdl_Stmts is
    --  DEST_TYP is the type of the result.
    --  DEST_OFF is the offset, within DEST_DYN.
    --  DEST_DYN is set (Voff field set) when there is a non-static index.
+   --  SYN_INST is used for all parts except when PFX is an interface.  In the
+   --  latter, INTER_INST is used.
    procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+                                      Inter_Inst : Synth_Instance_Acc;
                                       Pfx : Node;
                                       Dest_Base : out Valtyp;
                                       Dest_Typ : out Type_Acc;
                                       Dest_Off : out Value_Offsets;
                                       Dest_Dyn : out Dyn_Name);
 
+   --  Simplified version.  No dynamic offset expected.
+   procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+                                      Pfx : Node;
+                                      Dest_Base : out Valtyp;
+                                      Dest_Typ : out Type_Acc;
+                                      Dest_Off : out Value_Offsets);
+
    procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
                                Target : Node;
                                Val : Valtyp;