diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-06-09 07:52:39 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-06-09 07:52:39 +0200 |
commit | 46bd0ff2b72f47fa7e12612f66bcae0cb2003b7a (patch) | |
tree | f4f98f223bd97f85575342d935563bfdfe001c9b | |
parent | 7064ef37029a883d0098d0af665231b36854d5e2 (diff) | |
download | ghdl-46bd0ff2b72f47fa7e12612f66bcae0cb2003b7a.tar.gz ghdl-46bd0ff2b72f47fa7e12612f66bcae0cb2003b7a.tar.bz2 ghdl-46bd0ff2b72f47fa7e12612f66bcae0cb2003b7a.zip |
elab-vhdl_types(Elab_Declaration_Type): rework to handle 'subtype
Fix #2085
-rw-r--r-- | src/synth/elab-vhdl_decls.adb | 20 | ||||
-rw-r--r-- | src/synth/elab-vhdl_insts.adb | 12 | ||||
-rw-r--r-- | src/synth/elab-vhdl_objtypes.adb | 2 | ||||
-rw-r--r-- | src/synth/elab-vhdl_objtypes.ads | 1 | ||||
-rw-r--r-- | src/synth/elab-vhdl_types.adb | 42 | ||||
-rw-r--r-- | src/synth/elab-vhdl_types.ads | 4 | ||||
-rw-r--r-- | src/synth/synth-vhdl_decls.adb | 13 |
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 => |