synth: handle enumerated types.

5 files changed, 97 insertions, 51 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index d26562481..704e22975 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -25,7 +25,6 @@ with Grt.Types; use Grt.Types;
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils;
 
-with Vhdl.Std_Package;
 with Vhdl.Ieee.Std_Logic_1164;
 
 with Simul.Annotations; use Simul.Annotations;
@@ -47,7 +46,7 @@ package body Synth.Context is
                                       M => No_Module,
                                       Name => No_Sname,
                                       Sim => Sim_Inst,
-                                      Objects => (others => null));
+                                      Objects => (others => <>));
       pragma Assert (Instance_Map (Sim_Inst.Id) = null);
       Instance_Map (Sim_Inst.Id) := Res;
       return Res;
@@ -82,12 +81,20 @@ package body Synth.Context is
    begin
       case Get_Kind (Btype) is
          when Iir_Kind_Enumeration_Type_Definition =>
-            if Is_Bit_Type (Btype) then
-               return Alloc_Wire (Kind, Obj, null);
-            else
-               --  TODO
-               raise Internal_Error;
-            end if;
+            declare
+               Info : constant Sim_Info_Acc := Get_Info (Btype);
+               Rng : Value_Range_Acc;
+            begin
+               if Info.Kind = Kind_Bit_Type then
+                  Rng := null;
+               else
+               Rng := Create_Range_Value ((Dir => Iir_Downto,
+                                           Len => Info.Width,
+                                           Left => Int32 (Info.Width - 1),
+                                           Right => 0));
+               end if;
+               return Alloc_Wire (Kind, Obj, Rng);
+            end;
          when Iir_Kind_Array_Type_Definition =>
             --  Well known array types.
             if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type
@@ -145,29 +152,34 @@ package body Synth.Context is
             end;
          when Value_Lit =>
             case Val.Lit.Kind is
-               when Iir_Value_B1 =>
-                  pragma Assert
-                    (Val.Lit_Type = Vhdl.Std_Package.Boolean_Type_Definition
-                       or else
-                       Val.Lit_Type = Vhdl.Std_Package.Bit_Type_Definition);
-                  return Build_Const_UB32
-                    (Build_Context, Ghdl_B1'Pos (Val.Lit.B1), 1);
-               when Iir_Value_E8 =>
-                  if Is_Bit_Type (Val.Lit_Type) then
-                     declare
-                        V, Xz : Uns32;
-                     begin
-                        To_Logic (Val.Lit, V, Xz);
-                        if Xz = 0 then
-                           return Build_Const_UB32 (Build_Context, V, 1);
-                        else
-                           return Build_Const_UL32 (Build_Context, V, Xz, 1);
-                        end if;
-                     end;
-                  else
-                     --  State machine.
-                     raise Internal_Error;
-                  end if;
+               when Iir_Value_E8
+                 | Iir_Value_B1 =>
+                  declare
+                     Info : constant Sim_Info_Acc :=
+                       Get_Info (Get_Base_Type (Val.Lit_Type));
+                  begin
+                     case Info.Kind is
+                        when Kind_Bit_Type =>
+                           declare
+                              V, Xz : Uns32;
+                           begin
+                              To_Logic (Val.Lit, V, Xz);
+                              if Xz = 0 then
+                                 return Build_Const_UB32
+                                   (Build_Context, V, 1);
+                              else
+                                 return Build_Const_UL32
+                                   (Build_Context, V, Xz, 1);
+                              end if;
+                           end;
+                        when Kind_Enum_Type =>
+                           --  State machine.
+                           return Build_Const_UB32
+                             (Build_Context, Uns32 (Val.Lit.E8), Info.Width);
+                        when others =>
+                           raise Internal_Error;
+                     end case;
+                  end;
                when Iir_Value_I64 =>
                   if Val.Lit.I64 >= 0 then
                      for I in 1 .. 32 loop
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 2c464758e..8352707e2 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -19,6 +19,7 @@
 --  MA 02110-1301, USA.
 
 with Types; use Types;
+with Mutils; use Mutils;
 with Netlists; use Netlists;
 with Netlists.Builders; use Netlists.Builders;
 with Vhdl.Errors; use Vhdl.Errors;
@@ -40,6 +41,7 @@ package body Synth.Decls is
    begin
       case Val.Kind is
          when Value_Wire =>
+            --  FIXME: get the width directly from the wire ?
             W := Get_Width (Syn_Inst, Get_Type (Decl));
             Name := New_Sname (Syn_Inst.Name, Get_Identifier (Decl));
             if Init /= null then
@@ -55,7 +57,38 @@ package body Synth.Decls is
       end case;
    end Create_Var_Wire;
 
-   procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Iir) is
+   procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
+   is
+      pragma Unreferenced (Syn_Inst);
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            declare
+               Info : constant Sim_Info_Acc := Get_Info (Def);
+               Enum_List : constant Node_Flist :=
+                 Get_Enumeration_Literal_List (Def);
+            begin
+               if Is_Bit_Type (Def) then
+                  Info.Width := 1;
+               else
+                  Info.Width :=
+                    Uns32 (Clog2 (Uns64 (Get_Nbr_Elements (Enum_List))));
+               end if;
+            end;
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            null;
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_File_Type_Definition =>
+            null;
+         when others =>
+            Error_Kind ("synth_type_definition", Def);
+      end case;
+   end Synth_Type_Definition;
+
+   procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Variable_Declaration =>
@@ -104,9 +137,10 @@ package body Synth.Decls is
          when Iir_Kind_Attribute_Specification =>
             null;
          when Iir_Kind_Type_Declaration
-           | Iir_Kind_Anonymous_Type_Declaration
-           | Iir_Kind_Subtype_Declaration =>
-            --  TODO, in particular enumerated types.
+           | Iir_Kind_Anonymous_Type_Declaration =>
+            Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl));
+         when  Iir_Kind_Subtype_Declaration =>
+            --  TODO
             null;
          when Iir_Kind_Component_Declaration =>
             null;
diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads
index d608285b5..0fab14b39 100644
--- a/src/synth/synth-decls.ads
+++ b/src/synth/synth-decls.ads
@@ -22,7 +22,7 @@ with Vhdl.Nodes; use Vhdl.Nodes;
 with Synth.Context; use Synth.Context;
 
 package Synth.Decls is
-   procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Iir);
+   procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node);
 
-   procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Iir);
+   procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Node);
 end Synth.Decls;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 753b79243..5abb5ffa2 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -425,6 +425,13 @@ package body Synth.Expr is
            No_Range);
       end Synth_Bit_Dyadic;
 
+      function Synth_Compare (Id : Compare_Module_Id) return Value_Acc is
+      begin
+         return Create_Value_Net
+           (Build_Compare (Build_Context, Id, Get_Net (Left), Get_Net (Right)),
+            No_Range);
+      end Synth_Compare;
+
       function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc
       is
          L : constant Net := Get_Net (Left);
@@ -492,16 +499,11 @@ package body Synth.Expr is
                   return Synth_Bit_Eq_Const (Right, Left, Expr);
                end if;
             end if;
-            --  TODO
-            Error_Msg_Synth (+Expr, "unsupported enum equality");
-            raise Internal_Error;
+            return Synth_Compare (Id_Eq);
 
          when Iir_Predefined_Array_Equality =>
-            --  TODO:
-            return Create_Value_Net
-              (Build_Compare (Build_Context, Id_Eq,
-                              Get_Net (Left), Get_Net (Right)),
-               No_Range);
+            --  TODO: check size, handle non-vector.
+            return Synth_Compare (Id_Eq);
 
          when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat =>
             --  "+" (Unsigned, Natural)
@@ -635,7 +637,8 @@ package body Synth.Expr is
            | Iir_Kind_Variable_Declaration
            | Iir_Kind_Signal_Declaration =>
             return Get_Value (Syn_Inst, Name);
-         when Iir_Kind_Constant_Declaration =>
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Enumeration_Literal =>
             return Create_Value_Lit
               (Simul.Execution.Execute_Expression (Syn_Inst.Sim, Name),
                Get_Type (Name));
diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb
index cc89eefe3..955e5c9e0 100644
--- a/src/synth/synth-types.adb
+++ b/src/synth/synth-types.adb
@@ -24,6 +24,7 @@ with Vhdl.Ieee.Std_Logic_1164;
 with Vhdl.Utils; use Vhdl.Utils;
 
 with Simul.Environments; use Simul.Environments;
+with Simul.Annotations; use Simul.Annotations;
 with Simul.Execution;
 with Vhdl.Errors; use Vhdl.Errors;
 
@@ -49,11 +50,7 @@ package body Synth.Types is
    begin
       case Get_Kind (Atype) is
          when Iir_Kind_Enumeration_Type_Definition =>
-            if Is_Bit_Type (Atype) then
-               return 1;
-            else
-               raise Internal_Error;
-            end if;
+            return Width (Get_Info (Atype).Width);
          when Iir_Kind_Enumeration_Subtype_Definition =>
             --  Tail call
             return Get_Width (Syn_Inst, Btype);