elab-vhdl_types(Elab_Declaration_Type): rework to handle 'subtype

Fix #2085

7 files changed, 64 insertions, 30 deletions

diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
index a60843716..caaac05c4 100644
--- a/src/synth/elab-vhdl_decls.adb
+++ b/src/synth/elab-vhdl_decls.adb
@@ -32,6 +32,7 @@ package body Elab.Vhdl_Decls is
      (Syn_Inst : Synth_Instance_Acc; Subprg : Node)
    is
       Inter : Node;
+      Typ : Type_Acc;
    begin
       if Is_Second_Subprogram_Specification (Subprg) then
          --  Already handled.
@@ -40,9 +41,10 @@ package body Elab.Vhdl_Decls is
 
       Inter := Get_Interface_Declaration_Chain (Subprg);
       while Inter /= Null_Node loop
-         Elab_Declaration_Type (Syn_Inst, Inter);
+         Typ := Elab_Declaration_Type (Syn_Inst, Inter);
          Inter := Get_Chain (Inter);
       end loop;
+      pragma Unreferenced (Typ);
    end Elab_Subprogram_Declaration;
 
    procedure Elab_Constant_Declaration (Syn_Inst : Synth_Instance_Acc;
@@ -55,7 +57,7 @@ package body Elab.Vhdl_Decls is
       Val : Valtyp;
       Obj_Type : Type_Acc;
    begin
-      Elab_Declaration_Type (Syn_Inst, Decl);
+      Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl);
       if Deferred_Decl = Null_Node
         or else Get_Deferred_Declaration_Flag (Decl)
       then
@@ -89,7 +91,6 @@ package body Elab.Vhdl_Decls is
          end if;
          Last_Type := Decl_Type;
       end if;
-      Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type);
       Val := Exec_Expression_With_Type
         (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
       if Val = No_Valtyp then
@@ -107,8 +108,7 @@ package body Elab.Vhdl_Decls is
       Init : Valtyp;
       Obj_Typ : Type_Acc;
    begin
-      Elab_Declaration_Type (Syn_Inst, Decl);
-      Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
+      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);
 
       if Is_Valid (Def) then
          Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
@@ -128,12 +128,11 @@ package body Elab.Vhdl_Decls is
       Init : Valtyp;
       Obj_Typ : Type_Acc;
    begin
-      Elab_Declaration_Type (Syn_Inst, Decl);
+      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);
       if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then
          Error_Msg_Elab (+Decl, "protected type not supported");
          return;
       end if;
-      Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type);
 
       if Is_Valid (Def) then
          Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
@@ -262,7 +261,12 @@ package body Elab.Vhdl_Decls is
               (Syn_Inst, Get_Type_Definition (Decl),
                Get_Subtype_Definition (Decl));
          when Iir_Kind_Subtype_Declaration =>
-            Elab_Declaration_Type (Syn_Inst, Decl);
+            declare
+               T : Type_Acc;
+            begin
+               T := Elab_Declaration_Type (Syn_Inst, Decl);
+               pragma Unreferenced (T);
+            end;
          when Iir_Kind_Component_Declaration =>
             null;
          when Iir_Kind_File_Declaration =>
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
index 820e20ff1..d03f75154 100644
--- a/src/synth/elab-vhdl_insts.adb
+++ b/src/synth/elab-vhdl_insts.adb
@@ -71,8 +71,7 @@ package body Elab.Vhdl_Insts is
          Inter := Get_Association_Interface (Assoc, Assoc_Inter);
          case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
             when Iir_Kind_Interface_Constant_Declaration =>
-               Elab_Declaration_Type (Sub_Inst, Inter);
-               Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
+               Inter_Type := Elab_Declaration_Type (Sub_Inst, Inter);
 
                case Get_Kind (Assoc) is
                   when Iir_Kind_Association_Element_Open =>
@@ -349,8 +348,7 @@ package body Elab.Vhdl_Insts is
                raise Internal_Error;
          end case;
       else
-         Elab_Declaration_Type (Sub_Inst, Inter);
-         return Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
+         return Elab_Declaration_Type (Sub_Inst, Inter);
       end if;
    end Elab_Port_Association_Type;
 
@@ -789,12 +787,11 @@ package body Elab.Vhdl_Insts is
       --  Compute generics.
       Inter := Get_Generic_Chain (Entity);
       while Is_Valid (Inter) loop
-         Elab_Declaration_Type (Top_Inst, Inter);
          declare
             Val : Valtyp;
             Inter_Typ : Type_Acc;
          begin
-            Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter));
+            Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter);
             Val := Exec_Expression_With_Type
               (Top_Inst, Get_Default_Value (Inter), Inter_Typ);
             pragma Assert (Is_Static (Val.Val));
@@ -815,8 +812,7 @@ package body Elab.Vhdl_Insts is
          declare
             Inter_Typ : Type_Acc;
          begin
-            Elab_Declaration_Type (Top_Inst, Inter);
-            Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter));
+            Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter);
             Create_Signal (Top_Inst, Inter, Inter_Typ, null);
          end;
          Inter := Get_Chain (Inter);
diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index 4815a495a..bea919a4d 100644
--- a/src/synth/elab-vhdl_objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -841,6 +841,7 @@ package body Elab.Vhdl_Objtypes is
       Boolean_Type := Create_Bit_Type;
       Logic_Type := Create_Logic_Type;
       Bit_Type := Create_Bit_Type;
+      Protected_Type := Create_Protected_Type;
 
       Bit0 := (Bit_Type, To_Memory_Ptr (Bit0_Mem'Address));
       Bit1 := (Bit_Type, To_Memory_Ptr (Bit1_Mem'Address));
@@ -855,6 +856,7 @@ package body Elab.Vhdl_Objtypes is
       Boolean_Type := null;
       Logic_Type := null;
       Bit_Type := null;
+      Protected_Type := null;
 
       Bit0 := Null_Memtyp;
       Bit1 := Null_Memtyp;
diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads
index 6d8554994..6ff20d3b4 100644
--- a/src/synth/elab-vhdl_objtypes.ads
+++ b/src/synth/elab-vhdl_objtypes.ads
@@ -308,6 +308,7 @@ package Elab.Vhdl_Objtypes is
    Boolean_Type : Type_Acc := null;
    Logic_Type : Type_Acc := null;
    Bit_Type : Type_Acc := null;
+   Protected_Type : Type_Acc := null;
 
    --  Also set by initialize.
    Bit0 : Memtyp;
diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb
index b7f2da58f..eb97b7b1e 100644
--- a/src/synth/elab-vhdl_types.adb
+++ b/src/synth/elab-vhdl_types.adb
@@ -644,15 +644,43 @@ package body Elab.Vhdl_Types is
       end loop;
    end Get_Declaration_Type;
 
-   procedure Elab_Declaration_Type
-     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+   function Elab_Declaration_Type
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc
    is
-      Atype : constant Node := Get_Declaration_Type (Decl);
+      Atype : Node;
+      Typ : Type_Acc;
    begin
-      if Atype = Null_Node then
-         --  Already elaborated.
-         return;
+      Atype := Get_Subtype_Indication (Decl);
+      if Atype /= Null_Node then
+         case Get_Kind (Atype) is
+            when Iir_Kinds_Subtype_Definition =>
+               if not Get_Is_Ref (Decl) then
+                  --  That's a new type.
+                  Typ := Synth_Subtype_Indication (Syn_Inst, Atype);
+                  Create_Subtype_Object (Syn_Inst, Atype, Typ);
+                  return Typ;
+               end if;
+            when Iir_Kinds_Denoting_Name =>
+               --  Already elaborated.
+               Atype := Get_Type (Get_Named_Entity (Atype));
+            when Iir_Kind_Subtype_Attribute =>
+               declare
+                  Pfx : constant Node := Get_Prefix (Atype);
+                  Vt : Valtyp;
+               begin
+                  Vt := Exec_Name (Syn_Inst, Pfx);
+                  return Vt.Typ;
+               end;
+            when others =>
+               Error_Kind ("elab_declaration_type", Atype);
+         end case;
+      else
+         Atype := Get_Type (Decl);
+      end if;
+      if Get_Kind (Atype) = Iir_Kind_Protected_Type_Declaration then
+         return Protected_Type;
+      else
+         return Get_Subtype_Object (Syn_Inst, Atype);
       end if;
-      Synth_Subtype_Indication (Syn_Inst, Atype);
    end Elab_Declaration_Type;
 end Elab.Vhdl_Types;
diff --git a/src/synth/elab-vhdl_types.ads b/src/synth/elab-vhdl_types.ads
index 7f1d2c55e..afab9e494 100644
--- a/src/synth/elab-vhdl_types.ads
+++ b/src/synth/elab-vhdl_types.ads
@@ -66,6 +66,6 @@ package Elab.Vhdl_Types is
                                         return Type_Acc;
 
    --  Elaborate the type of DECL.
-   procedure Elab_Declaration_Type
-     (Syn_Inst : Synth_Instance_Acc; Decl : Node);
+   function Elab_Declaration_Type
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc;
 end Elab.Vhdl_Types;
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index b6b00270e..56d7ab9e0 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -136,7 +136,7 @@ package body Synth.Vhdl_Decls is
       Cst : Valtyp;
       Obj_Type : Type_Acc;
    begin
-      Elab_Declaration_Type (Syn_Inst, Decl);
+      Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl);
       if Deferred_Decl = Null_Node
         or else Get_Deferred_Declaration_Flag (Decl)
       then
@@ -170,7 +170,6 @@ package body Synth.Vhdl_Decls is
          end if;
          Last_Type := Decl_Type;
       end if;
-      Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type);
       Val := Synth_Expression_With_Type
         (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
       if Val = No_Valtyp then
@@ -380,7 +379,7 @@ package body Synth.Vhdl_Decls is
       Obj_Typ : Type_Acc;
       Wid : Wire_Id;
    begin
-      Elab_Declaration_Type (Syn_Inst, Decl);
+      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);
       if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then
          Error_Msg_Synth
            (+Decl, "protected type variable is not synthesizable");
@@ -389,7 +388,6 @@ package body Synth.Vhdl_Decls is
          return;
       end if;
 
-      Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type);
       if Obj_Typ.Wkind /= Wkind_Net
         and then not Get_Instance_Const (Syn_Inst)
       then
@@ -598,7 +596,12 @@ package body Synth.Vhdl_Decls is
               (Syn_Inst, Get_Type_Definition (Decl),
                Get_Subtype_Definition (Decl));
          when Iir_Kind_Subtype_Declaration =>
-            Elab_Declaration_Type (Syn_Inst, Decl);
+            declare
+               T : Type_Acc;
+            begin
+               T := Elab_Declaration_Type (Syn_Inst, Decl);
+               pragma Unreferenced (T);
+            end;
          when Iir_Kind_Component_Declaration =>
             null;
          when Iir_Kind_File_Declaration =>