From 1ca1bd17a6d6ae95d67d58345f495aee3fe272f0 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 11 Sep 2022 11:22:16 +0200 Subject: synth: improve handling of top-level interfaces subtype --- src/synth/elab-vhdl_decls.adb | 2 ++ src/synth/elab-vhdl_insts.adb | 7 ++++++- src/synth/elab-vhdl_objtypes.adb | 31 ++++++++++++++++++++++++------- src/synth/elab-vhdl_objtypes.ads | 7 ++++++- src/synth/synth-vhdl_eval.adb | 12 ++++++++---- src/synth/synth-vhdl_oper.adb | 12 ++++++++---- src/synth/synth-vhdl_stmts.adb | 7 ++++--- 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); -- cgit v1.2.3