synth: factorize code, move value2logvec to synth-expr.

Fix #1036

4 files changed, 116 insertions, 196 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 91f73b484..ef9569c0c 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -379,87 +379,6 @@ package body Synth.Context is
 
    pragma Unreferenced (Vec2net);
 
-   type Logic_32 is record
-      Val : Uns32;  --  AKA aval
-      Zx  : Uns32;  --  AKA bval
-   end record;
-
-   type Digit_Index is new Natural;
-   type Logvec_Array is array (Digit_Index range <>) of Logic_32;
-   type Logvec_Array_Acc is access Logvec_Array;
-
-   procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation
-     (Logvec_Array, Logvec_Array_Acc);
-
-   procedure Value2net (Val : Value_Acc;
-                        Vec : in out Logvec_Array;
-                        Off : in out Uns32;
-                        Has_Zx : in out Boolean) is
-   begin
-      if Val.Kind = Value_Const then
-         Value2net (Val.C_Val, Vec, Off, Has_Zx);
-         return;
-      end if;
-
-      case Val.Typ.Kind is
-         when Type_Bit =>
-            declare
-               Idx : constant Digit_Index := Digit_Index (Off / 32);
-               Pos : constant Natural := Natural (Off mod 32);
-               Va : Uns32;
-            begin
-               Va := Uns32 (Val.Scal);
-               Va := Shift_Left (Va, Pos);
-               Vec (Idx).Val := Vec (Idx).Val or Va;
-               Vec (Idx).Zx := 0;
-               Off := Off + 1;
-            end;
-         when Type_Logic =>
-            declare
-               Idx : constant Digit_Index := Digit_Index (Off / 32);
-               Pos : constant Natural := Natural (Off mod 32);
-               Va : Uns32;
-               Zx : Uns32;
-            begin
-               From_Std_Logic (Val.Scal, Va, Zx);
-               Has_Zx := Has_Zx or Zx /= 0;
-               Va := Shift_Left (Va, Pos);
-               Zx := Shift_Left (Zx, Pos);
-               Vec (Idx).Val := Vec (Idx).Val or Va;
-               Vec (Idx).Zx := Vec (Idx).Zx or Zx;
-               Off := Off + 1;
-            end;
-         when Type_Discrete =>
-            for I in 0 .. Val.Typ.W - 1 loop
-               declare
-                  B : constant Uns32 :=
-                    Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I)))
-                    and 1;
-                  Idx : constant Digit_Index := Digit_Index (Off / 32);
-                  Pos : constant Natural := Natural (Off mod 32);
-               begin
-                  Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos);
-               end;
-               Off := Off + 1;
-            end loop;
-         when Type_Vector =>
-            --  TODO: optimize off mod 32 = 0.
-            for I in reverse Val.Arr.V'Range loop
-               Value2net (Val.Arr.V (I), Vec, Off, Has_Zx);
-            end loop;
-         when Type_Array =>
-            for I in reverse Val.Arr.V'Range loop
-               Value2net (Val.Arr.V (I), Vec, Off, Has_Zx);
-            end loop;
-         when Type_Record =>
-            for I in Val.Rec.V'Range loop
-               Value2net (Val.Rec.V (I), Vec, Off, Has_Zx);
-            end loop;
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Value2net;
-
    procedure Value2net
      (Val : Value_Acc; W : Width; Vec : in out Logvec_Array; Res : out Net)
    is
@@ -469,7 +388,7 @@ package body Synth.Context is
    begin
       Has_Zx := False;
       Off := 0;
-      Value2net (Val, Vec, Off, Has_Zx);
+      Value2logvec (Val, Vec, Off, Has_Zx);
       if W = 0 then
          --  For null range (like the null string literal "")
          Res := Build_Const_UB32 (Build_Context, 0, 0);
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 627005a88..8724afdc0 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -121,6 +121,76 @@ package body Synth.Expr is
       end if;
    end To_Logic;
 
+
+   procedure Value2logvec (Val : Value_Acc;
+                           Vec : in out Logvec_Array;
+                           Off : in out Uns32;
+                           Has_Zx : in out Boolean) is
+   begin
+      if Val.Kind = Value_Const then
+         Value2logvec (Val.C_Val, Vec, Off, Has_Zx);
+         return;
+      end if;
+
+      case Val.Typ.Kind is
+         when Type_Bit =>
+            declare
+               Idx : constant Digit_Index := Digit_Index (Off / 32);
+               Pos : constant Natural := Natural (Off mod 32);
+               Va : Uns32;
+            begin
+               Va := Uns32 (Val.Scal);
+               Va := Shift_Left (Va, Pos);
+               Vec (Idx).Val := Vec (Idx).Val or Va;
+               Vec (Idx).Zx := 0;
+               Off := Off + 1;
+            end;
+         when Type_Logic =>
+            declare
+               Idx : constant Digit_Index := Digit_Index (Off / 32);
+               Pos : constant Natural := Natural (Off mod 32);
+               Va : Uns32;
+               Zx : Uns32;
+            begin
+               From_Std_Logic (Val.Scal, Va, Zx);
+               Has_Zx := Has_Zx or Zx /= 0;
+               Va := Shift_Left (Va, Pos);
+               Zx := Shift_Left (Zx, Pos);
+               Vec (Idx).Val := Vec (Idx).Val or Va;
+               Vec (Idx).Zx := Vec (Idx).Zx or Zx;
+               Off := Off + 1;
+            end;
+         when Type_Discrete =>
+            for I in 0 .. Val.Typ.W - 1 loop
+               declare
+                  B : constant Uns32 :=
+                    Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I)))
+                    and 1;
+                  Idx : constant Digit_Index := Digit_Index (Off / 32);
+                  Pos : constant Natural := Natural (Off mod 32);
+               begin
+                  Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos);
+               end;
+               Off := Off + 1;
+            end loop;
+         when Type_Vector =>
+            --  TODO: optimize off mod 32 = 0.
+            for I in reverse Val.Arr.V'Range loop
+               Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx);
+            end loop;
+         when Type_Array =>
+            for I in reverse Val.Arr.V'Range loop
+               Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx);
+            end loop;
+         when Type_Record =>
+            for I in Val.Rec.V'Range loop
+               Value2logvec (Val.Rec.V (I), Vec, Off, Has_Zx);
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Value2logvec;
+
    function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node)
                         return Value_Acc
    is
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 5d8d7f7d5..8fdf5a89c 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -18,6 +18,8 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
+with Ada.Unchecked_Deallocation;
+
 with Types; use Types;
 
 with Netlists; use Netlists;
@@ -110,4 +112,23 @@ package Synth.Expr is
                                  Voff : out Net;
                                  Off : out Uns32;
                                  W : out Width);
+
+   --  Conversion to logic vector.
+
+   type Logic_32 is record
+      Val : Uns32;  --  AKA aval
+      Zx  : Uns32;  --  AKA bval
+   end record;
+
+   type Digit_Index is new Natural;
+   type Logvec_Array is array (Digit_Index range <>) of Logic_32;
+   type Logvec_Array_Acc is access Logvec_Array;
+
+   procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation
+     (Logvec_Array, Logvec_Array_Acc);
+
+   procedure Value2logvec (Val : Value_Acc;
+                           Vec : in out Logvec_Array;
+                           Off : in out Uns32;
+                           Has_Zx : in out Boolean);
 end Synth.Expr;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 6e3a5d0c8..02732f58a 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -33,7 +33,6 @@ with Vhdl.Types;
 with Vhdl.Sem_Expr;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Std_Package;
-with Vhdl.Ieee.Std_Logic_1164;
 with Vhdl.Evaluation;
 
 with PSL.Types;
@@ -690,91 +689,24 @@ package body Synth.Stmts is
       end if;
    end Synth_If_Statement;
 
-   procedure Convert_Bv_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64)
-   is
-      El_Type : constant Node :=
-        Get_Base_Type (Get_Element_Subtype (Get_Type (Expr)));
-   begin
-      if El_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then
-         declare
-            use Vhdl.Evaluation.String_Utils;
-
-            Info : constant Str_Info := Get_Str_Info (Expr);
-         begin
-            if Info.Len > 64 then
-               raise Internal_Error;
-            end if;
-            Val := 0;
-            Dc := 0;
-            for I in 0 .. Info.Len - 1 loop
-               Val := Shift_Left (Val, 1);
-               Dc := Shift_Left (Dc, 1);
-               case Get_Pos (Info, I) is
-                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos =>
-                     Val := Val or 0;
-                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos =>
-                     Val := Val or 1;
-                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos
-                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos =>
-                     Dc := Dc or 1;
-                  when others =>
-                     raise Internal_Error;
-               end case;
-            end loop;
-         end;
-      elsif El_Type = Vhdl.Std_Package.Bit_Type_Definition then
-         declare
-            use Vhdl.Evaluation.String_Utils;
-
-            Info : constant Str_Info := Get_Str_Info (Expr);
-         begin
-            if Info.Len > 64 then
-               raise Internal_Error;
-            end if;
-            Val := 0;
-            Dc := 0;
-            for I in 0 .. Info.Len - 1 loop
-               Val := Shift_Left (Val, 1);
-               case Get_Pos (Info, I) is
-                  when 0 =>
-                     Val := Val or 0;
-                  when 1 =>
-                     Val := Val or 1;
-                  when others =>
-                     raise Internal_Error;
-               end case;
-            end loop;
-         end;
-      else
-         raise Internal_Error;
-      end if;
-   end Convert_Bv_To_Uns64;
-
    --  EXPR is a choice, so a locally static literal.
-   procedure Convert_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64)
+   function Convert_To_Uns64 (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+                             return Uns64
    is
-      Expr_Type : constant Node := Get_Type (Expr);
-   begin
-      case Get_Kind (Expr_Type) is
-         when Iir_Kind_Array_Type_Definition
-           | Iir_Kind_Array_Subtype_Definition =>
-            Convert_Bv_To_Uns64 (Expr, Val, Dc);
-         when Iir_Kind_Enumeration_Type_Definition =>
-            Dc := 0;
-            Val := Uns64 (Get_Enum_Pos (Strip_Denoting_Name (Expr)));
-         when Iir_Kind_Integer_Type_Definition
-           | Iir_Kind_Integer_Subtype_Definition =>
-            --  TODO: signed values.
-            Dc := 0;
-            Val := Uns64 (Get_Value (Expr));
-         when others =>
-            Error_Kind ("convert_to_uns64", Expr_Type);
-      end case;
+      Expr_Val : Value_Acc;
+      Vec : Logvec_Array (0 .. 1);
+      Off : Uns32;
+      Has_Zx : Boolean;
+   begin
+      Expr_Val := Synth_Expression_With_Basetype (Syn_Inst, Expr);
+      Off := 0;
+      Has_Zx := False;
+      Vec := (others => (0, 0));
+      Value2logvec (Expr_Val, Vec, Off, Has_Zx);
+      if Has_Zx then
+         Error_Msg_Synth (+Expr, "meta-values never match");
+      end if;
+      return Uns64 (Vec (0).Val) or Shift_Left (Uns64 (Vec (1).Val), 32);
    end Convert_To_Uns64;
 
    type Alternative_Index is new Int32;
@@ -960,21 +892,10 @@ package body Synth.Stmts is
             when Iir_Kind_Choice_By_Expression =>
                Choice_Idx := Choice_Idx + 1;
                Annex_Arr (Choice_Idx) := Int32 (Choice_Idx);
-               declare
-                  Choice_Expr : constant Node :=
-                    Get_Choice_Expression (Choice);
-                  Val, Dc : Uns64;
-               begin
-                  Convert_To_Uns64 (Choice_Expr, Val, Dc);
-                  if Dc = 0 then
-                     Choice_Data (Choice_Idx) := (Val => Val,
-                                                  Alt => Alt_Idx);
-                  else
-                     Error_Msg_Synth (+Choice_Expr, "meta-values never match");
-                     Choice_Data (Choice_Idx) := (Val => 0,
-                                                  Alt => 0);
-                  end if;
-               end;
+               Choice_Data (Choice_Idx) :=
+                 (Val => Convert_To_Uns64 (C.Inst,
+                                           Get_Choice_Expression (Choice)),
+                  Alt => Alt_Idx);
             when Iir_Kind_Choice_By_Others =>
                Others_Alt_Idx := Alt_Idx;
             when others =>
@@ -1268,21 +1189,10 @@ package body Synth.Stmts is
             when Iir_Kind_Choice_By_Expression =>
                Choice_Idx := Choice_Idx + 1;
                Annex_Arr (Choice_Idx) := Int32 (Choice_Idx);
-               declare
-                  Choice_Expr : constant Node :=
-                    Get_Choice_Expression (Choice);
-                  Val, Dc : Uns64;
-               begin
-                  Convert_To_Uns64 (Choice_Expr, Val, Dc);
-                  if Dc = 0 then
-                     Choice_Data (Choice_Idx) := (Val => Val,
-                                                  Alt => Alt_Idx);
-                  else
-                     Error_Msg_Synth (+Choice_Expr, "meta-values never match");
-                     Choice_Data (Choice_Idx) := (Val => 0,
-                                                  Alt => 0);
-                  end if;
-               end;
+               Choice_Data (Choice_Idx) :=
+                 (Val => Convert_To_Uns64 (Syn_Inst,
+                                           Get_Choice_Expression (Choice)),
+                  Alt => Alt_Idx);
             when Iir_Kind_Choice_By_Others =>
                Others_Alt_Idx := Alt_Idx;
             when others =>