synth-vhdl_eval: handle more operators

3 files changed, 402 insertions, 26 deletions

diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb
index 20af6434b..76a9a59e8 100644
--- a/src/synth/elab-vhdl_expr.adb
+++ b/src/synth/elab-vhdl_expr.adb
@@ -36,6 +36,7 @@ with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
 with Synth.Vhdl_Oper; use Synth.Vhdl_Oper;
 with Synth.Vhdl_Aggr;
 with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
+with Synth.Vhdl_Eval; use Synth.Vhdl_Eval;
 
 with Grt.Types;
 with Grt.To_Strings;
@@ -323,29 +324,10 @@ package body Elab.Vhdl_Expr is
                return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id);
             end;
          when others =>
-            Error_Kind ("execute_image_attribute", Expr_Type);
+            Error_Kind ("synth_image_attribute_str", Expr_Type);
       end case;
    end Synth_Image_Attribute_Str;
 
-   function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp
-   is
-      Len : constant Natural := Str'Length;
-      Bnd : Bound_Type;
-      Typ : Type_Acc;
-      Res : Valtyp;
-   begin
-      Bnd := (Dir => Dir_To, Left => 1, Right => Int32 (Len),
-              Len => Uns32 (Len));
-      Typ := Create_Array_Type (Bnd, True, Styp.Uarr_El);
-
-      Res := Create_Value_Memory (Typ);
-      for I in Str'Range loop
-         Write_U8 (Res.Val.Mem + Size_Type (I - Str'First),
-                   Character'Pos (Str (I)));
-      end loop;
-      return Res;
-   end String_To_Valtyp;
-
    function Exec_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
                                  return Valtyp
    is
@@ -353,6 +335,7 @@ package body Elab.Vhdl_Expr is
       Etype : constant Node := Get_Type (Attr);
       V : Valtyp;
       Dtype : Type_Acc;
+      Res : Memtyp;
    begin
       --  The parameter is expected to be static.
       V := Exec_Expression (Syn_Inst, Param);
@@ -366,8 +349,9 @@ package body Elab.Vhdl_Expr is
       end if;
 
       Strip_Const (V);
-      return String_To_Valtyp
+      Res := String_To_Memtyp
         (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype);
+      return Create_Value_Memtyp (Res);
    end Exec_Image_Attribute;
 
    function Exec_Instance_Name_Attribute
@@ -377,9 +361,11 @@ package body Elab.Vhdl_Expr is
       Atyp  : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype);
       Name  : constant Path_Instance_Name_Type :=
         Get_Path_Instance_Name_Suffix (Attr);
+      Res : Memtyp;
    begin
       --  Return a truncated name, as the prefix is not completly known.
-      return String_To_Valtyp (Name.Suffix, Atyp);
+      Res := String_To_Memtyp (Name.Suffix, Atyp);
+      return Create_Value_Memtyp (Res);
    end Exec_Instance_Name_Attribute;
 
    --  Convert index IDX in PFX to an offset.
diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb
index aef98b807..e3b998afd 100644
--- a/src/synth/synth-vhdl_eval.adb
+++ b/src/synth/synth-vhdl_eval.adb
@@ -21,6 +21,8 @@ with Types_Utils; use Types_Utils;
 with Name_Table;
 
 with Grt.Types; use Grt.Types;
+with Grt.Vhdl_Types; use Grt.Vhdl_Types;
+with Grt.To_Strings;
 
 with Vhdl.Utils;
 with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164;
@@ -218,6 +220,111 @@ package body Synth.Vhdl_Eval is
       return Equal;
    end Compare_Array;
 
+   function Execute_Shift_Operator (Left : Memtyp;
+                                    Count : Int64;
+                                    Op : Iir_Predefined_Shift_Functions)
+                                   return Memtyp
+   is
+      Cnt : Uns32;
+      Len : constant Uns32 := Left.Typ.Abound.Len;
+      Dir_Left : Boolean;
+      P : Size_Type;
+      Res : Memtyp;
+      E : Ghdl_U8;
+   begin
+      --  LRM93 7.2.3
+      --  That is, if R is 0 or if L is a null array, the return value is L.
+      if Count = 0 or else Len = 0 then
+         return Left;
+      end if;
+
+      case Op is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Rol =>
+            Dir_Left := True;
+         when Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sra
+           | Iir_Predefined_Array_Ror =>
+            Dir_Left := False;
+      end case;
+      if Count < 0 then
+         Cnt := Uns32 (-Count);
+         Dir_Left := not Dir_Left;
+      else
+         Cnt := Uns32 (Count);
+      end if;
+
+      case Op is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl =>
+            E := 0;
+         when Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               E := Read_U8 (Left.Mem + Size_Type (Len - 1));
+            else
+               E := Read_U8 (Left.Mem);
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            Cnt := Cnt mod Len;
+            if not Dir_Left then
+               Cnt := (Len - Cnt) mod Len;
+            end if;
+      end case;
+
+      Res := Create_Memory (Left.Typ);
+      P := 0;
+
+      case Op is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               if Cnt < Len then
+                  for I in Cnt .. Len - 1 loop
+                     Write_U8 (Res.Mem + P,
+                               Read_U8 (Left.Mem + Size_Type (I + 1)));
+                     P := P + 1;
+                  end loop;
+               else
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Write_U8 (Res.Mem + P, E);
+                  P := P + 1;
+               end loop;
+            else
+               if Cnt > Len then
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Write_U8 (Res.Mem + P, E);
+                  P := P + 1;
+               end loop;
+               for I in Cnt .. Len - 1 loop
+                  Write_U8 (Res.Mem + P,
+                            Read_U8 (Left.Mem + Size_Type (I - Cnt + 1)));
+                  P := P + 1;
+               end loop;
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            for I in 1 .. Len loop
+               Write_U8 (Res.Mem + P,
+                         Read_U8 (Left.Mem + Size_Type (Cnt + 1)));
+               P := P + 1;
+               Cnt := Cnt + 1;
+               if Cnt = Len then
+                  Cnt := 0;
+               end if;
+            end loop;
+      end case;
+      return Res;
+   end Execute_Shift_Operator;
+
    function Get_Static_Ulogic (Op : Memtyp) return Std_Ulogic is
    begin
       pragma Assert (Op.Typ.Kind = Type_Logic);
@@ -350,12 +457,14 @@ package body Synth.Vhdl_Eval is
               (Read_Discrete (Left) > Read_Discrete (Right));
          when Iir_Predefined_Integer_Equality
             | Iir_Predefined_Physical_Equality
-            | Iir_Predefined_Enum_Equality =>
+            | Iir_Predefined_Enum_Equality
+            | Iir_Predefined_Bit_Match_Equality =>
             return Create_Memory_Boolean
               (Read_Discrete (Left) = Read_Discrete (Right));
          when Iir_Predefined_Integer_Inequality
             | Iir_Predefined_Physical_Inequality
-            | Iir_Predefined_Enum_Inequality =>
+            | Iir_Predefined_Enum_Inequality
+            | Iir_Predefined_Bit_Match_Inequality =>
             return Create_Memory_Boolean
               (Read_Discrete (Left) /= Read_Discrete (Right));
 
@@ -499,10 +608,12 @@ package body Synth.Vhdl_Eval is
             end;
 
          when Iir_Predefined_Array_Equality
-           | Iir_Predefined_Record_Equality =>
+            | Iir_Predefined_Record_Equality
+            | Iir_Predefined_Bit_Array_Match_Equality =>
             return Create_Memory_Boolean (Is_Equal (Left, Right));
          when Iir_Predefined_Array_Inequality
-            | Iir_Predefined_Record_Inequality =>
+            | Iir_Predefined_Record_Inequality
+            | Iir_Predefined_Bit_Array_Match_Inequality =>
             return Create_Memory_Boolean (not Is_Equal (Left, Right));
 
          when Iir_Predefined_Access_Equality =>
@@ -540,8 +651,21 @@ package body Synth.Vhdl_Eval is
                return Right;
             end if;
 
+         when Iir_Predefined_Array_Sll =>
+            return Execute_Shift_Operator (Left, Read_Discrete (Right), Def);
+
+         when Iir_Predefined_TF_Array_And =>
+            return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_And, Expr);
+         when Iir_Predefined_TF_Array_Or =>
+            return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Or, Expr);
          when Iir_Predefined_TF_Array_Xor =>
             return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Xor, Expr);
+         when Iir_Predefined_TF_Array_Nand =>
+            return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Nand, Expr);
+         when Iir_Predefined_TF_Array_Nor =>
+            return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Nor, Expr);
+         when Iir_Predefined_TF_Array_Xnor =>
+            return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Xnor, Expr);
 
          when Iir_Predefined_TF_Element_Array_Or =>
             return Eval_TF_Array_Element (Left, Right, Tf_2d_Or);
@@ -872,6 +996,153 @@ package body Synth.Vhdl_Eval is
       return Create_Memory_U8 (Std_Ulogic'Pos (Res), El_Typ);
    end Eval_Vector_Reduce;
 
+   function Eval_TF_Vector_Monadic (Vec : Memtyp) return Memtyp
+   is
+      Len : constant Iir_Index32 := Vec_Length (Vec.Typ);
+      Res : Memtyp;
+   begin
+      Res := Create_Memory (Create_Res_Bound (Vec.Typ));
+      for I in 1 .. Uns32 (Len) loop
+         declare
+            V : constant Boolean :=
+              Boolean'Val (Read_U8 (Vec.Mem + Size_Type (I - 1)));
+         begin
+            Write_U8 (Res.Mem + Size_Type (I - 1), Boolean'Pos (not V));
+         end;
+      end loop;
+      return Res;
+   end Eval_TF_Vector_Monadic;
+
+   function Eval_TF_Vector_Reduce (Init : Boolean;
+                                   Neg : Boolean;
+                                   Vec : Memtyp;
+                                   Op : Tf_Table_2d) return Memtyp
+   is
+      El_Typ : constant Type_Acc := Vec.Typ.Arr_El;
+      Res : Boolean;
+   begin
+      Res := Init;
+      for I in 1 .. Size_Type (Vec.Typ.Abound.Len) loop
+         declare
+            V : constant Boolean := Boolean'Val (Read_U8 (Vec.Mem + (I - 1)));
+         begin
+            Res := Op (Res, V);
+         end;
+      end loop;
+
+      return Create_Memory_U8 (Boolean'Pos (Res xor Neg), El_Typ);
+   end Eval_TF_Vector_Reduce;
+
+   function Eval_Vector_Maximum (Vec : Memtyp) return Memtyp
+   is
+      Etyp : constant Type_Acc := Vec.Typ.Arr_El;
+      Len : constant Uns32 := Vec.Typ.Abound.Len;
+   begin
+      case Etyp.Kind is
+         when Type_Logic
+           | Type_Bit
+           | Type_Discrete =>
+            declare
+               Res : Int64;
+               V : Int64;
+            begin
+               case Etyp.Drange.Dir is
+                  when Dir_To =>
+                     Res := Etyp.Drange.Left;
+                  when Dir_Downto =>
+                     Res := Etyp.Drange.Right;
+               end case;
+
+               for I in 1 .. Len loop
+                  V := Read_Discrete
+                    (Vec.Mem + Size_Type (I - 1) * Etyp.Sz, Etyp);
+                  if V > Res then
+                     Res := V;
+                  end if;
+               end loop;
+               return Create_Memory_Discrete (Res, Etyp);
+            end;
+         when Type_Float =>
+            declare
+               Res : Fp64;
+               V : Fp64;
+            begin
+               case Etyp.Frange.Dir is
+                  when Dir_To =>
+                     Res := Etyp.Frange.Left;
+                  when Dir_Downto =>
+                     Res := Etyp.Frange.Right;
+               end case;
+
+               for I in 1 .. Len loop
+                  V := Read_Fp64
+                    (Vec.Mem + Size_Type (I - 1) * Etyp.Sz);
+                  if V > Res then
+                     Res := V;
+                  end if;
+               end loop;
+               return Create_Memory_Fp64 (Res, Etyp);
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Eval_Vector_Maximum;
+
+   function Eval_Vector_Minimum (Vec : Memtyp) return Memtyp
+   is
+      Etyp : constant Type_Acc := Vec.Typ.Arr_El;
+      Len : constant Uns32 := Vec.Typ.Abound.Len;
+   begin
+      case Etyp.Kind is
+         when Type_Logic
+           | Type_Bit
+           | Type_Discrete =>
+            declare
+               Res : Int64;
+               V : Int64;
+            begin
+               case Etyp.Drange.Dir is
+                  when Dir_To =>
+                     Res := Etyp.Drange.Right;
+                  when Dir_Downto =>
+                     Res := Etyp.Drange.Left;
+               end case;
+
+               for I in 1 .. Len loop
+                  V := Read_Discrete
+                    (Vec.Mem + Size_Type (I - 1) * Etyp.Sz, Etyp);
+                  if V < Res then
+                     Res := V;
+                  end if;
+               end loop;
+               return Create_Memory_Discrete (Res, Etyp);
+            end;
+         when Type_Float =>
+            declare
+               Res : Fp64;
+               V : Fp64;
+            begin
+               case Etyp.Frange.Dir is
+                  when Dir_To =>
+                     Res := Etyp.Frange.Right;
+                  when Dir_Downto =>
+                     Res := Etyp.Frange.Left;
+               end case;
+
+               for I in 1 .. Len loop
+                  V := Read_Fp64
+                    (Vec.Mem + Size_Type (I - 1) * Etyp.Sz);
+                  if V < Res then
+                     Res := V;
+                  end if;
+               end loop;
+               return Create_Memory_Fp64 (Res, Etyp);
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Eval_Vector_Minimum;
+
    function Eval_Static_Monadic_Predefined (Imp : Node;
                                              Operand : Memtyp;
                                              Expr : Node) return Memtyp
@@ -906,6 +1177,27 @@ package body Synth.Vhdl_Eval is
          when Iir_Predefined_Floating_Absolute =>
             return Create_Memory_Fp64 (abs Read_Fp64 (Operand), Operand.Typ);
 
+         when Iir_Predefined_Vector_Maximum =>
+            return Eval_Vector_Maximum (Operand);
+         when Iir_Predefined_Vector_Minimum =>
+            return Eval_Vector_Minimum (Operand);
+
+         when Iir_Predefined_TF_Array_Not =>
+            return Eval_TF_Vector_Monadic (Operand);
+
+         when Iir_Predefined_TF_Reduction_Or =>
+            return Eval_TF_Vector_Reduce (False, False, Operand, Tf_2d_Or);
+         when Iir_Predefined_TF_Reduction_And =>
+            return Eval_TF_Vector_Reduce (True, False, Operand, Tf_2d_And);
+         when Iir_Predefined_TF_Reduction_Xor =>
+            return Eval_TF_Vector_Reduce (False, False, Operand, Tf_2d_Xor);
+         when Iir_Predefined_TF_Reduction_Nor =>
+            return Eval_TF_Vector_Reduce (False, True, Operand, Tf_2d_Or);
+         when Iir_Predefined_TF_Reduction_Nand =>
+            return Eval_TF_Vector_Reduce (True, True, Operand, Tf_2d_And);
+         when Iir_Predefined_TF_Reduction_Xnor =>
+            return Eval_TF_Vector_Reduce (False, True, Operand, Tf_2d_Xor);
+
          when Iir_Predefined_Ieee_1164_Condition_Operator =>
             --  Constant std_logic: need to convert.
             declare
@@ -1063,6 +1355,81 @@ package body Synth.Vhdl_Eval is
       return Res;
    end Eval_Array_Char_To_String;
 
+   function String_To_Memtyp (Str : String; Styp : Type_Acc) return Memtyp
+   is
+      Len : constant Natural := Str'Length;
+      Bnd : Bound_Type;
+      Typ : Type_Acc;
+      Res : Memtyp;
+   begin
+      Bnd := (Dir => Dir_To, Left => 1, Right => Int32 (Len),
+              Len => Uns32 (Len));
+      Typ := Create_Array_Type (Bnd, True, Styp.Uarr_El);
+
+      Res := Create_Memory (Typ);
+      for I in Str'Range loop
+         Write_U8 (Res.Mem + Size_Type (I - Str'First),
+                   Character'Pos (Str (I)));
+      end loop;
+      return Res;
+   end String_To_Memtyp;
+
+   function Eval_Enum_To_String (Param : Memtyp;
+                                 Res_Typ : Type_Acc;
+                                 Imp : Node) return Memtyp
+   is
+      use Vhdl.Utils;
+      use Name_Table;
+      Etype : constant Node := Get_Base_Type
+        (Get_Type (Get_Interface_Declaration_Chain (Imp)));
+      pragma Assert (Get_Kind (Etype) = Iir_Kind_Enumeration_Type_Definition);
+      Enums : constant Iir_Flist := Get_Enumeration_Literal_List (Etype);
+      Lit : Node;
+      Lit_Id : Name_Id;
+      V : Int64;
+      C : String (1 .. 1);
+   begin
+      V := Read_Discrete (Param.Mem, Param.Typ);
+      Lit := Get_Nth_Element (Enums, Natural (V));
+      Lit_Id := Get_Identifier (Lit);
+      if Is_Character (Lit_Id) then
+         C (1) := Get_Character (Lit_Id);
+         return String_To_Memtyp (C, Res_Typ);
+      else
+         return String_To_Memtyp (Image (Lit_Id), Res_Typ);
+      end if;
+   end Eval_Enum_To_String;
+
+   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
+     "0123456789ABCDEF";
+
+   function Eval_Bit_Vector_To_String (Val : Memtyp;
+                                       Res_Typ : Type_Acc;
+                                       Log_Base : Natural) return Memtyp
+   is
+      Base : constant Natural := 2 ** Log_Base;
+      Blen : constant Natural := Natural (Val.Typ.Abound.Len);
+      Str : String (1 .. (Blen + Log_Base - 1) / Log_Base);
+      Pos : Natural;
+      V : Natural;
+      N : Natural;
+   begin
+      V := 0;
+      N := 1;
+      Pos := Str'Last;
+      for I in 1 .. Blen loop
+         V := V + Natural (Read_U8 (Val.Mem + Size_Type (Blen - I))) * N;
+         N := N * 2;
+         if N = Base or else I = Blen then
+            Str (Pos) := Hex_Chars (V);
+            Pos := Pos - 1;
+            N := 1;
+            V := 0;
+         end if;
+      end loop;
+      return String_To_Memtyp (Str, Res_Typ);
+   end Eval_Bit_Vector_To_String;
+
    function Eval_Static_Predefined_Function_Call (Param1 : Valtyp;
                                                   Param2 : Valtyp;
                                                   Res_Typ : Type_Acc;
@@ -1092,6 +1459,10 @@ package body Synth.Vhdl_Eval is
             return Create_Memory_Fp64
               (Fp64'Min (Read_Fp64 (Param1), Read_Fp64 (Param2)), Res_Typ);
 
+         when Iir_Predefined_Now_Function =>
+            return Create_Memory_Discrete
+              (Int64 (Grt.Vhdl_Types.Current_Time), Res_Typ);
+
          when Iir_Predefined_Endfile =>
             declare
                Res : Boolean;
@@ -1100,9 +1471,25 @@ package body Synth.Vhdl_Eval is
                return Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type);
             end;
 
+         when Iir_Predefined_Integer_To_String =>
+            declare
+               Str : String (1 .. 21);
+               First : Natural;
+            begin
+               Grt.To_Strings.To_String
+                 (Str, First, Ghdl_I64 (Read_Discrete (Param1)));
+               return String_To_Memtyp (Str (First .. Str'Last), Res_Typ);
+            end;
          when Iir_Predefined_Array_Char_To_String =>
             return Eval_Array_Char_To_String
               (Get_Memtyp (Param1), Res_Typ, Imp);
+         when Iir_Predefined_Enum_To_String =>
+            return Eval_Enum_To_String (Get_Memtyp (Param1), Res_Typ, Imp);
+
+         when Iir_Predefined_Bit_Vector_To_Hstring =>
+            return Eval_Bit_Vector_To_String (Get_Memtyp (Param1), Res_Typ, 4);
+         when Iir_Predefined_Bit_Vector_To_Ostring =>
+            return Eval_Bit_Vector_To_String (Get_Memtyp (Param1), Res_Typ, 3);
 
          when Iir_Predefined_Std_Env_Resolution_Limit =>
             return Create_Memory_Discrete (1, Res_Typ);
diff --git a/src/synth/synth-vhdl_eval.ads b/src/synth/synth-vhdl_eval.ads
index 3d6bc3b9f..2b689d89a 100644
--- a/src/synth/synth-vhdl_eval.ads
+++ b/src/synth/synth-vhdl_eval.ads
@@ -35,4 +35,7 @@ package Synth.Vhdl_Eval is
                                                   Param2 : Valtyp;
                                                   Res_Typ : Type_Acc;
                                                   Expr : Node) return Memtyp;
+
+   --  STYP is the string type.
+   function String_To_Memtyp (Str : String; Styp : Type_Acc) return Memtyp;
 end Synth.Vhdl_Eval;