synth: improve handling of top-level interfaces subtype

7 files changed, 58 insertions, 20 deletions

diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
index 599d4a342..d7ceef8e5 100644
--- a/src/synth/elab-vhdl_decls.adb
+++ b/src/synth/elab-vhdl_decls.adb
@@ -160,6 +160,8 @@ package body Elab.Vhdl_Decls is
          Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
          Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);
          Init := Unshare (Init, Instance_Pool);
+         --  Note: Obj_Typ is bounded.
+         Init.Typ := Obj_Typ;
       else
          if Force_Init then
             Current_Pool := Instance_Pool;
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
index 8705909db..30ea40b3b 100644
--- a/src/synth/elab-vhdl_insts.adb
+++ b/src/synth/elab-vhdl_insts.adb
@@ -873,7 +873,7 @@ package body Elab.Vhdl_Insts is
               (Top_Inst, Get_Default_Value (Inter), Inter_Typ);
             pragma Assert (Is_Static (Val.Val));
             Val := Unshare (Val, Instance_Pool);
-            Val.Typ := Unshare (Val.Typ, Instance_Pool);
+            Val.Typ := Unshare_Type_Instance (Val.Typ, Inter_Typ);
             Create_Object (Top_Inst, Inter, Val);
             Release_Expr_Pool (Em);
          end;
@@ -897,12 +897,17 @@ package body Elab.Vhdl_Insts is
          else
             declare
                Def : constant Node := Get_Default_Value (Inter);
+               Marker : Mark_Type;
                Inter_Typ : Type_Acc;
                Val : Valtyp;
             begin
+               Mark_Expr_Pool (Marker);
                pragma Assert (Def /= Null_Node);
                Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter);
                Val := Synth_Expression_With_Type (Top_Inst, Def, Inter_Typ);
+               Val := Unshare (Val, Instance_Pool);
+               Val.Typ := Unshare_Type_Instance (Val.Typ, Inter_Typ);
+               Release_Expr_Pool (Marker);
                Create_Signal (Top_Inst, Inter, Val.Typ);
             end;
          end if;
diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index 7595ac441..b4e5b954a 100644
--- a/src/synth/elab-vhdl_objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -1033,15 +1033,18 @@ package body Elab.Vhdl_Objtypes is
       return Res;
    end Unshare;
 
-   function Unshare_Type (Typ : Type_Acc; Base : Type_Acc) return Type_Acc
+   function Unshare_Type (Typ : Type_Acc;
+                          Base : Type_Acc;
+                          Global : Boolean;
+                          Pool : Areapool_Acc) return Type_Acc
    is
       Res : Type_Acc;
    begin
-      if Typ = Base or else not Typ.Is_Global then
+      if Typ = Base or else Typ.Is_Global = Global then
          return Typ;
       end if;
-      Res := Raw_Copy (Typ, Expr_Pool'Access);
-      Res.Is_Global := False;
+      Res := Raw_Copy (Typ, Pool);
+      Res.Is_Global := Global;
 
       case Res.Kind is
          when Type_Bit
@@ -1054,17 +1057,19 @@ package body Elab.Vhdl_Objtypes is
          when Type_Array
            | Type_Vector =>
             Res.Arr_El := Unshare_Type (Typ.Arr_El,
-                                        Get_Array_Element (Base));
+                                        Get_Array_Element (Base),
+                                        Global, Pool);
          when Type_Unbounded_Array
            | Type_Unbounded_Vector
            | Type_Unbounded_Record =>
             raise Internal_Error;
          when Type_Record =>
-            Res.Rec := Create_Rec_El_Array (Typ.Rec.Len, Expr_Pool'Access);
+            Res.Rec := Create_Rec_El_Array (Typ.Rec.Len, Pool);
             for I in Typ.Rec.E'Range loop
                Res.Rec.E (I) := (Offs => Typ.Rec.E (I).Offs,
                                  Typ => Unshare_Type (Typ.Rec.E (I).Typ,
-                                                      Base.Rec.E (I).Typ));
+                                                      Base.Rec.E (I).Typ,
+                                                      Global, Pool));
             end loop;
          when Type_Access =>
             raise Internal_Error;
@@ -1076,6 +1081,18 @@ package body Elab.Vhdl_Objtypes is
       return Res;
    end Unshare_Type;
 
+   function Unshare_Type_Expr (Typ : Type_Acc; Base : Type_Acc)
+                              return Type_Acc is
+   begin
+      return Unshare_Type (Typ, Base, False, Expr_Pool'Access);
+   end Unshare_Type_Expr;
+
+   function Unshare_Type_Instance (Typ : Type_Acc; Base : Type_Acc)
+                                  return Type_Acc is
+   begin
+      return Unshare_Type (Typ, Base, True, Instance_Pool);
+   end Unshare_Type_Instance;
+
    procedure Save_Type (Typ : Type_Acc;
                         Res : out Type_Acc;
                         Mem : Memory_Ptr;
diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads
index 4ca3e6d37..46c6660ba 100644
--- a/src/synth/elab-vhdl_objtypes.ads
+++ b/src/synth/elab-vhdl_objtypes.ads
@@ -339,7 +339,12 @@ package Elab.Vhdl_Objtypes is
    function Unshare (T : Type_Acc; Pool : Areapool_Acc) return Type_Acc;
 
    --  Unshare parts of TYP that is not in BASE.
-   function Unshare_Type (Typ : Type_Acc; Base : Type_Acc) return Type_Acc;
+   --  For return expression, the type is allocated on the Expr_Pool.
+   function Unshare_Type_Expr (Typ : Type_Acc; Base : Type_Acc)
+                              return Type_Acc;
+   --  For object types, the type is allocated on the Instance_Pool.
+   function Unshare_Type_Instance (Typ : Type_Acc; Base : Type_Acc)
+                                  return Type_Acc;
 
    --  Copy TYP to MEM; MEM_SZ.
    function Save_Type (Typ : Type_Acc;
diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb
index c7fe0b00c..af2c9e0d6 100644
--- a/src/synth/synth-vhdl_eval.adb
+++ b/src/synth/synth-vhdl_eval.adb
@@ -594,7 +594,8 @@ package body Synth.Vhdl_Eval is
                Check_Matching_Bounds (Le_Typ, Re_Typ, Expr);
                Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length
                  (Get_Uarray_Index (Res_Typ).Drange, L_Len + R_Len);
-               El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ));
+               El_Typ := Unshare_Type_Expr (Le_Typ,
+                                            Get_Array_Element (Res_Typ));
                Res_St := Create_Onedimensional_Array_Subtype
                  (Res_Typ, Bnd, El_Typ);
                Res := Create_Memory (Res_St);
@@ -619,7 +620,8 @@ package body Synth.Vhdl_Eval is
                Check_Matching_Bounds (Left.Typ, Re_Typ, Expr);
                Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length
                  (Get_Uarray_Index (Res_Typ).Drange, 1 + Rlen);
-               El_Typ := Unshare_Type (Re_Typ, Get_Array_Element (Res_Typ));
+               El_Typ := Unshare_Type_Expr (Re_Typ,
+                                            Get_Array_Element (Res_Typ));
                Res_St := Create_Onedimensional_Array_Subtype
                  (Res_Typ, Bnd, El_Typ);
                Res := Create_Memory (Res_St);
@@ -641,7 +643,8 @@ package body Synth.Vhdl_Eval is
                Check_Matching_Bounds (Le_Typ, Right.Typ, Expr);
                Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length
                  (Get_Uarray_Index (Res_Typ).Drange, Llen + 1);
-               El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ));
+               El_Typ := Unshare_Type_Expr (Le_Typ,
+                                            Get_Array_Element (Res_Typ));
                Res_St := Create_Onedimensional_Array_Subtype
                  (Res_Typ, Bnd, El_Typ);
                Res := Create_Memory (Res_St);
@@ -661,7 +664,8 @@ package body Synth.Vhdl_Eval is
                Check_Matching_Bounds (Left.Typ, Right.Typ, Expr);
                Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length
                  (Get_Uarray_Index (Res_Typ).Drange, 2);
-               El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ));
+               El_Typ := Unshare_Type_Expr (Le_Typ,
+                                            Get_Array_Element (Res_Typ));
                Res_St := Create_Onedimensional_Array_Subtype
                  (Res_Typ, Bnd, El_Typ);
                Res := Create_Memory (Res_St);
diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb
index 16ba47006..7feb61c5b 100644
--- a/src/synth/synth-vhdl_oper.adb
+++ b/src/synth/synth-vhdl_oper.adb
@@ -968,7 +968,8 @@ package body Synth.Vhdl_Oper is
                   Get_Index_Type (Get_Type (Expr), 0),
                   Iir_Index32 (Get_Bound_Length (Left.Typ) + 1));
 
-               El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Expr_Typ));
+               El_Typ := Unshare_Type_Expr (Le_Typ,
+                                            Get_Array_Element (Expr_Typ));
                Res_Typ := Create_Onedimensional_Array_Subtype
                  (Expr_Typ, Bnd, El_Typ);
                return Create_Value_Net (N, Res_Typ);
@@ -990,7 +991,8 @@ package body Synth.Vhdl_Oper is
                   Get_Index_Type (Get_Type (Expr), 0),
                   Iir_Index32 (Get_Bound_Length (Right.Typ) + 1));
 
-               El_Typ := Unshare_Type (Re_Typ, Get_Array_Element (Expr_Typ));
+               El_Typ := Unshare_Type_Expr (Re_Typ,
+                                            Get_Array_Element (Expr_Typ));
                Res_Typ := Create_Onedimensional_Array_Subtype
                  (Expr_Typ, Bnd, El_Typ);
                return Create_Value_Net (N, Res_Typ);
@@ -1008,7 +1010,8 @@ package body Synth.Vhdl_Oper is
                Set_Location (N, Expr);
                Bnd := Create_Bounds_From_Length
                  (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2);
-               El_Typ := Unshare_Type (Left.Typ, Get_Array_Element (Expr_Typ));
+               El_Typ := Unshare_Type_Expr (Left.Typ,
+                                            Get_Array_Element (Expr_Typ));
                Res_Typ := Create_Onedimensional_Array_Subtype
                  (Expr_Typ, Bnd, El_Typ);
                return Create_Value_Net (N, Res_Typ);
@@ -1033,7 +1036,8 @@ package body Synth.Vhdl_Oper is
                   Iir_Index32 (Get_Bound_Length (Left.Typ)
                                  + Get_Bound_Length (Right.Typ)));
 
-               El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Expr_Typ));
+               El_Typ := Unshare_Type_Expr (Le_Typ,
+                                            Get_Array_Element (Expr_Typ));
                Res_Typ := Create_Onedimensional_Array_Subtype
                  (Expr_Typ, Bnd, El_Typ);
                return Create_Value_Net (N, Res_Typ);
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index d0234b814..04555a776 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -2280,8 +2280,9 @@ package body Synth.Vhdl_Stmts is
             elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value.Val) then
                Res := C.Ret_Value;
             else
-               Res := Create_Value_Net (Get_Current_Value (Ctxt, C.W_Val),
-                                        Unshare_Type (C.Ret_Typ, Ret_Typ));
+               Res := Create_Value_Net
+                 (Get_Current_Value (Ctxt, C.W_Val),
+                  Unshare_Type_Expr (C.Ret_Typ, Ret_Typ));
             end if;
          else
             Res := No_Valtyp;
@@ -2499,7 +2500,7 @@ package body Synth.Vhdl_Stmts is
          --  Protect return value from being deallocated
          Res := Unshare (Res, Expr_Pool'Access);
          Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Imp));
-         Res.Typ := Unshare_Type (Res.Typ, Ret_Typ);
+         Res.Typ := Unshare_Type_Expr (Res.Typ, Ret_Typ);
       end if;
 
       Areapools.Release (Area_Mark, Instance_Pool.all);