synth: rework indexed names.

4 files changed, 106 insertions, 101 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 7681d8f3b..be229c4cd 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -25,7 +25,6 @@ with Tables;
 with Vhdl.Errors; use Vhdl.Errors;
 with Netlists.Builders; use Netlists.Builders;
 
-with Synth.Types; use Synth.Types;
 with Synth.Errors; use Synth.Errors;
 with Synth.Expr; use Synth.Expr;
 
@@ -90,27 +89,11 @@ package body Synth.Context is
    begin
       case Get_Kind (Obj_Type) is
          when Iir_Kind_Enumeration_Type_Definition
-           | Iir_Kind_Enumeration_Subtype_Definition =>
-            Otype := Get_Value_Type (Syn_Inst, Get_Type (Obj));
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            Otype := Get_Value_Type (Syn_Inst, Obj_Type);
             return Alloc_Wire (Kind, Obj, Otype);
-         when Iir_Kind_Array_Subtype_Definition =>
-            declare
-               Bnd : Value_Acc;
-            begin
-               Bnd := Get_Value (Syn_Inst, Obj_Type);
-               if Is_Vector_Type (Obj_Type) then
-                  return Alloc_Wire (Kind, Obj, Bnd.Typ);
-               else
-                  raise Internal_Error;
-               end if;
-            end;
-         when Iir_Kind_Integer_Subtype_Definition =>
-            declare
-               Rng : Value_Acc;
-            begin
-               Rng := Get_Value (Syn_Inst, Obj_Type);
-               return Alloc_Wire (Kind, Obj, Rng.Typ);
-            end;
          when others =>
             Error_Kind ("alloc_object", Obj_Type);
       end case;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index abdedf37b..10173471f 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -1130,22 +1130,20 @@ package body Synth.Expr is
       end case;
    end In_Bounds;
 
-   function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node)
-                            return Uns32
-   is
-      Rng : constant Type_Acc := Pfx.Typ;
+   function Index_To_Offset (Bnd : Bound_Type; Idx : Int64; Loc : Node)
+                            return Uns32 is
    begin
-      if not In_Bounds (Rng.Vbound, Int32 (Idx)) then
+      if not In_Bounds (Bnd, Int32 (Idx)) then
          Error_Msg_Synth (+Loc, "index not within bounds");
          return 0;
       end if;
 
       --  The offset is from the LSB (bit 0).  Bit 0 is the rightmost one.
-      case Rng.Vbound.Dir is
+      case Bnd.Dir is
          when Iir_To =>
-            return Uns32 (Rng.Vbound.Right - Int32 (Idx));
+            return Uns32 (Bnd.Right - Int32 (Idx));
          when Iir_Downto =>
-            return Uns32 (Int32 (Idx) - Rng.Vbound.Right);
+            return Uns32 (Int32 (Idx) - Bnd.Right);
       end case;
    end Index_To_Offset;
 
@@ -1175,64 +1173,78 @@ package body Synth.Expr is
       return Off;
    end Dyn_Index_To_Offset;
 
-   function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
-                               return Value_Acc
+   procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc;
+                                 Name : Node;
+                                 Pfx_Type : Type_Acc;
+                                 Voff : out Net;
+                                 Mul : out Uns32;
+                                 Off : out Uns32;
+                                 W : out Width)
    is
       Indexes : constant Iir_Flist := Get_Index_List (Name);
       Idx_Expr : constant Node := Get_Nth_Element (Indexes, 0);
       Idx_Val : Value_Acc;
-      Pfx_Val : Value_Acc;
    begin
       if Get_Nbr_Elements (Indexes) /= 1 then
          Error_Msg_Synth (+Name, "multi-dim arrays not yet supported");
-         return null;
+         raise Internal_Error;
       end if;
 
-      Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name));
-
       --  Use the base type as the subtype of the index is not synth-ed.
       Idx_Val := Synth_Expression_With_Type
         (Syn_Inst, Idx_Expr, Get_Base_Type (Get_Type (Idx_Expr)));
 
-      if Pfx_Val.Typ.Kind = Type_Vector then
+      if Pfx_Type.Kind = Type_Vector then
+         W := 1;
+         Mul := 0;
          if Idx_Val.Kind = Value_Discrete then
-            declare
-               Off : Uns32;
-            begin
-               Off := Index_To_Offset (Pfx_Val, Idx_Val.Scal, Name);
-               return Bit_Extract (Pfx_Val, Off, Name);
-            end;
+            Voff := No_Net;
+            Off := Index_To_Offset (Pfx_Type.Vbound, Idx_Val.Scal, Name);
          else
-            declare
-               Off : Net;
-               Res : Net;
-            begin
-               Off := Dyn_Index_To_Offset (Pfx_Val.Typ.Vbound, Idx_Val, Name);
-               Res := Build_Dyn_Extract
-                 (Build_Context, Get_Net (Pfx_Val), Off, 1, 0, 1);
-               Set_Location (Res, Name);
-               return Create_Value_Net (Res, Pfx_Val.Typ.Vec_El);
-            end;
+            Voff := Dyn_Index_To_Offset (Pfx_Type.Vbound, Idx_Val, Name);
+            Off := 0;
          end if;
-      elsif Pfx_Val.Typ.Kind = Type_Array then
-         declare
-            Off : Net;
-            Res : Net;
-            El_Width : Width;
-         begin
-            Off := Dyn_Index_To_Offset
-              (Pfx_Val.Typ.Abounds.D (1), Idx_Val, Name);
-            El_Width := Get_Type_Width (Pfx_Val.Typ.Arr_El);
-            Res := Build_Dyn_Extract
-              (Build_Context, Get_Net (Pfx_Val), Off, El_Width, 0, El_Width);
-            Set_Location (Res, Name);
-            return Create_Value_Net (Res, Pfx_Val.Typ.Arr_El);
-         end;
+      elsif Pfx_Type.Kind = Type_Array then
+         Voff := Dyn_Index_To_Offset (Pfx_Type.Abounds.D (1), Idx_Val, Name);
+         W := Get_Type_Width (Pfx_Type.Arr_El);
+         Mul := W;
+         Off := 0;
       else
          raise Internal_Error;
       end if;
    end Synth_Indexed_Name;
 
+   function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
+                               return Value_Acc
+   is
+      Pfx_Val : Value_Acc;
+      Voff : Net;
+      Mul : Uns32;
+      Off : Uns32;
+      W : Width;
+      Res : Net;
+   begin
+      Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name));
+
+      Synth_Indexed_Name (Syn_Inst, Name, Pfx_Val.Typ, Voff, Mul, Off, W);
+
+      if Voff = No_Net then
+         pragma Assert (Mul = 0);
+         if W = 1 and then Pfx_Val.Kind = Value_Array then
+            return Bit_Extract (Pfx_Val, Off, Name);
+         else
+            Res := Build_Extract (Build_Context, Get_Net (Pfx_Val), Off, W);
+            Set_Location (Res, Name);
+            return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ));
+         end if;
+      else
+         Res := Build_Dyn_Extract
+           (Build_Context, Get_Net (Pfx_Val), Voff, Mul, Int32 (Off), W);
+         Set_Location (Res, Name);
+         return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ));
+      end if;
+   end Synth_Indexed_Name;
+
    function Is_Const (N : Net) return Boolean is
    begin
       case Get_Id (Get_Module (Get_Parent (N))) is
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 039dab5d6..f7edc2417 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -69,7 +69,7 @@ package Synth.Expr is
      (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type;
 
    --  Convert index IDX in PFX to an offset.  LOC is used in case of error.
-   function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node)
+   function Index_To_Offset (Bnd : Bound_Type; Idx : Int64; Loc : Node)
                             return Uns32;
 
    procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
@@ -80,4 +80,12 @@ package Synth.Expr is
                                  Step : out Uns32;
                                  Off : out Int32;
                                  Wd : out Uns32);
+
+   procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc;
+                                 Name : Node;
+                                 Pfx_Type : Type_Acc;
+                                 Voff : out Net;
+                                 Mul : out Uns32;
+                                 Off : out Uns32;
+                                 W : out Width);
 end Synth.Expr;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 468733b09..888746ae7 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -110,9 +110,41 @@ package body Synth.Stmts is
       end if;
    end Synth_Assignment_Aggregate;
 
-   procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
-                               Target : Node;
-                               Val : Value_Acc) is
+   procedure Synth_Indexed_Assignment
+     (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc)
+   is
+      Pfx : constant Node := Get_Prefix (Target);
+      Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx));
+      Targ_Net : Net;
+      V : Net;
+
+      Val_Net : Net;
+      Voff : Net;
+      Mul : Uns32;
+      Off : Uns32;
+      W : Width;
+   begin
+      Synth_Indexed_Name (Syn_Inst, Target, Targ.Typ, Voff, Mul, Off, W);
+
+      pragma Assert (Get_Type_Width (Val.Typ) = W);
+      Targ_Net := Get_Last_Assigned_Value (Targ.W);
+      Val_Net := Get_Net (Val);
+
+      if Voff = No_Net then
+         --  FIXME: check index.
+         pragma Assert (Mul = 0);
+         V := Build_Insert (Build_Context, Targ_Net, Val_Net, Off);
+         Set_Location (V, Target);
+      else
+         V := Build_Dyn_Insert
+           (Build_Context, Targ_Net, Val_Net, Voff, Mul, Int32 (Off));
+         Set_Location (V, Target);
+      end if;
+      Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ));
+   end Synth_Indexed_Assignment;
+
+   procedure Synth_Assignment
+     (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) is
    begin
       case Get_Kind (Target) is
          when Iir_Kind_Simple_Name =>
@@ -125,37 +157,7 @@ package body Synth.Stmts is
          when Iir_Kind_Aggregate =>
             Synth_Assignment_Aggregate (Syn_Inst, Target, Val);
          when Iir_Kind_Indexed_Name =>
-            declare
-               Pfx : constant Node := Get_Prefix (Target);
-               Targ : constant Value_Acc :=
-                 Get_Value (Syn_Inst, Get_Base_Name (Pfx));
-               Indexes : constant Node_Flist := Get_Index_List (Target);
-               N_Idx : Node;
-               Idx : Value_Acc;
-               Targ_Net : Net;
-               V : Net;
-            begin
-               if Get_Nbr_Elements (Indexes) /= 1
-                 or else Targ.Kind /= Value_Wire
-               then
-                  --  Only support assignment of vector.
-                  raise Internal_Error;
-               end if;
-               N_Idx := Get_Nth_Element (Indexes, 0);
-               Idx := Synth_Expression_With_Type
-                 (Syn_Inst, N_Idx, Get_Type (N_Idx));
-               if Is_Const (Idx) then
-                  --  FIXME: check index.
-                  Targ_Net := Get_Last_Assigned_Value (Targ.W);
-                  V := Build_Insert (Build_Context,
-                                     Targ_Net, Get_Net (Val),
-                                     Index_To_Offset (Targ, Idx.Scal, Target));
-                  Set_Location (V, Target);
-               else
-                  raise Internal_Error;
-               end if;
-               Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ));
-            end;
+            Synth_Indexed_Assignment (Syn_Inst, Target, Val);
          when Iir_Kind_Slice_Name =>
             declare
                Pfx : constant Node := Get_Prefix (Target);