From 655866865db5d5c259a87105807dc7aed0d857d7 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 29 Jun 2019 03:58:07 +0200 Subject: vhdl: move annotations from simul to vhdl. --- src/ghdldrv/ghdlsimul.adb | 6 +- src/ghdldrv/ghdlsynth.adb | 8 +- src/synth/synth-context.ads | 2 +- src/synth/synth-decls.adb | 2 +- src/synth/synth-expr.adb | 2 +- src/synth/synth-stmts.adb | 2 +- src/synth/synth-types.adb | 2 +- src/synth/synthesis.adb | 2 +- src/vhdl/simulate/simul-annotations.adb | 1315 --------------------------- src/vhdl/simulate/simul-annotations.ads | 158 ---- src/vhdl/simulate/simul-debugger.adb | 2 +- src/vhdl/simulate/simul-elaboration.ads | 2 +- src/vhdl/simulate/simul-environments.ads | 2 +- src/vhdl/simulate/simul-execution.ads | 2 +- src/vhdl/simulate/simul-file_operation.adb | 2 +- src/vhdl/simulate/simul-simulation-main.adb | 2 +- src/vhdl/vhdl-annotations.adb | 1315 +++++++++++++++++++++++++++ src/vhdl/vhdl-annotations.ads | 158 ++++ 18 files changed, 1492 insertions(+), 1492 deletions(-) delete mode 100644 src/vhdl/simulate/simul-annotations.adb delete mode 100644 src/vhdl/simulate/simul-annotations.ads create mode 100644 src/vhdl/vhdl-annotations.adb create mode 100644 src/vhdl/vhdl-annotations.ads (limited to 'src') diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index 52408b067..97adef30d 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -27,7 +27,7 @@ with Flags; with Vhdl.Std_Package; with Vhdl.Canon; with Vhdl.Configuration; -with Simul.Annotations; +with Vhdl.Annotations; with Simul.Elaboration; with Simul.Simulation.Main; with Simul.Debugger; @@ -67,9 +67,9 @@ package body Ghdlsimul is Common_Compile_Elab (Cmd_Name, Args, Opt_Arg, Top_Conf); -- Annotate all units. - Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); + Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); for I in Design_Units.First .. Design_Units.Last loop - Simul.Annotations.Annotate (Design_Units.Table (I)); + Vhdl.Annotations.Annotate (Design_Units.Table (I)); end loop; end Compile_Elab; diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index d02386eea..70315dc31 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -27,7 +27,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Vhdl.Std_Package; with Vhdl.Canon; with Vhdl.Configuration; -with Simul.Annotations; +with Vhdl.Annotations; with Synthesis; with Netlists.Dump; @@ -92,7 +92,7 @@ package body Ghdlsynth is end if; end loop; - Simul.Annotations.Flag_Synthesis := True; + Vhdl.Annotations.Flag_Synthesis := True; Common_Compile_Init (False); Flags.Flag_Elaborate_With_Outdated := False; @@ -117,9 +117,9 @@ package body Ghdlsynth is end if; -- Annotate all units. - Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); + Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); for I in Design_Units.First .. Design_Units.Last loop - Simul.Annotations.Annotate (Design_Units.Table (I)); + Vhdl.Annotations.Annotate (Design_Units.Table (I)); end loop; return Synthesis.Synth_Design (Config); diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index e09702e1d..bb633b17c 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -20,7 +20,7 @@ with Synth.Environment; use Synth.Environment; with Synth.Values; use Synth.Values; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Netlists; use Netlists; with Netlists.Builders; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index b9ce77fed..0726cfa6d 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -28,7 +28,7 @@ with Synth.Types; use Synth.Types; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Expr; use Synth.Expr; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; package body Synth.Decls is procedure Synth_Anonymous_Subtype_Indication diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 3f6e2efc5..4b48ae83a 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -29,7 +29,7 @@ with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; with Areapools; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Synth.Errors; use Synth.Errors; with Synth.Types; use Synth.Types; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index b43170078..0f374a904 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -37,7 +37,7 @@ with Synth.Expr; use Synth.Expr; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb index ff516bac0..87034036e 100644 --- a/src/synth/synth-types.adb +++ b/src/synth/synth-types.adb @@ -26,7 +26,7 @@ with Vhdl.Errors; use Vhdl.Errors; with Synth.Values; use Synth.Values; with Synth.Expr; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; package body Synth.Types is function Is_Bit_Type (Atype : Iir) return Boolean is diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index b17cff003..a9ce60085 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -25,7 +25,7 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Utils; with Vhdl.Utils; use Vhdl.Utils; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Synth.Environment; use Synth.Environment; with Synth.Values; use Synth.Values; diff --git a/src/vhdl/simulate/simul-annotations.adb b/src/vhdl/simulate/simul-annotations.adb deleted file mode 100644 index 18b41561c..000000000 --- a/src/vhdl/simulate/simul-annotations.adb +++ /dev/null @@ -1,1315 +0,0 @@ --- Annotations for interpreted simulation --- Copyright (C) 2014 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Tables; -with Simple_IO; -with Vhdl.Std_Package; -with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Utils; use Vhdl.Utils; -with Vhdl.Ieee.Std_Logic_1164; - -package body Simul.Annotations is - procedure Annotate_Declaration_List - (Block_Info: Sim_Info_Acc; Decl_Chain: Iir); - procedure Annotate_Sequential_Statement_Chain - (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir); - procedure Annotate_Concurrent_Statements_List - (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir); - procedure Annotate_Block_Configuration - (Block : Iir_Block_Configuration); - procedure Annotate_Subprogram_Interfaces_Type - (Block_Info : Sim_Info_Acc; Subprg: Iir); - procedure Annotate_Subprogram_Specification - (Block_Info : Sim_Info_Acc; Subprg: Iir); - procedure Annotate_Interface_List - (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean); - - procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir); - - -- Annotate type definition DEF only if it is anonymous. - procedure Annotate_Anonymous_Type_Definition - (Block_Info: Sim_Info_Acc; Def: Iir); - - -- Add an annotation to object OBJ. - procedure Create_Object_Info (Block_Info : Sim_Info_Acc; - Obj : Iir; - Obj_Kind : Sim_Info_Kind := Kind_Object) - is - Info : Sim_Info_Acc; - begin - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; - case Obj_Kind is - when Kind_Object => - Info := new Sim_Info_Type'(Kind => Kind_Object, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - when Kind_File => - Info := new Sim_Info_Type'(Kind => Kind_File, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - when Kind_Signal => - Info := new Sim_Info_Type'(Kind => Kind_Signal, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - if not Flag_Synthesis then - -- Reserve one more slot for value, and initial driver value. - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 2; - end if; - when Kind_Terminal => - Info := new Sim_Info_Type'(Kind => Kind_Terminal, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - when Kind_Quantity => - Info := new Sim_Info_Type'(Kind => Kind_Quantity, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - when Kind_PSL => - Info := new Sim_Info_Type'(Kind => Kind_PSL, - Ref => Obj, - Obj_Scope => Block_Info, - Slot => Block_Info.Nbr_Objects); - when Kind_Block - | Kind_Process - | Kind_Frame - | Kind_Protected - | Kind_Package - | Kind_Scalar_Types - | Kind_File_Type - | Kind_Extra => - raise Internal_Error; - end case; - Set_Info (Obj, Info); - end Create_Object_Info; - - -- Add an annotation to SIGNAL. - procedure Create_Signal_Info (Block_Info: Sim_Info_Acc; Signal: Iir) is - begin - Create_Object_Info (Block_Info, Signal, Kind_Signal); - end Create_Signal_Info; - - procedure Add_Terminal_Info (Block_Info: Sim_Info_Acc; Terminal : Iir) is - begin - Create_Object_Info (Block_Info, Terminal, Kind_Terminal); - end Add_Terminal_Info; - - procedure Add_Quantity_Info (Block_Info: Sim_Info_Acc; Quantity : Iir) is - begin - Create_Object_Info (Block_Info, Quantity, Kind_Quantity); - end Add_Quantity_Info; - - -- If EXPR has not a literal value, create one. - -- This is necessary for subtype bounds. - procedure Annotate_Range_Expression - (Block_Info: Sim_Info_Acc; Expr: Iir_Range_Expression) is - begin - if Get_Info (Expr) /= null then - return; - end if; - Create_Object_Info (Block_Info, Expr); - end Annotate_Range_Expression; - - -- Annotate type definition DEF only if it is anonymous. - procedure Annotate_Anonymous_Type_Definition - (Block_Info: Sim_Info_Acc; Def: Iir) is - begin - if Is_Anonymous_Type_Definition (Def) then - Annotate_Type_Definition (Block_Info, Def); - end if; - end Annotate_Anonymous_Type_Definition; - - function Get_File_Signature_Length (Def : Iir) return Natural is - begin - case Get_Kind (Def) is - when Iir_Kinds_Scalar_Type_And_Subtype_Definition => - return 1; - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - return 2 - + Get_File_Signature_Length (Get_Element_Subtype (Def)); - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => - declare - List : constant Iir_Flist := - Get_Elements_Declaration_List (Get_Base_Type (Def)); - El : Iir; - Res : Natural; - begin - Res := 2; - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Res := Res + Get_File_Signature_Length (Get_Type (El)); - end loop; - return Res; - end; - when others => - Error_Kind ("get_file_signature_length", Def); - end case; - end Get_File_Signature_Length; - - procedure Get_File_Signature (Def : Iir; - Res : in out String; - Off : in out Natural) - is - Scalar_Map : constant array (Kind_Scalar_Types) of Character := "beeEIF"; - begin - case Get_Kind (Def) is - when Iir_Kinds_Scalar_Type_And_Subtype_Definition => - Res (Off) := Scalar_Map (Get_Info (Get_Base_Type (Def)).Kind); - Off := Off + 1; - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - Res (Off) := '['; - Off := Off + 1; - Get_File_Signature (Get_Element_Subtype (Def), Res, Off); - Res (Off) := ']'; - Off := Off + 1; - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => - declare - List : constant Iir_Flist := - Get_Elements_Declaration_List (Get_Base_Type (Def)); - El : Iir; - begin - Res (Off) := '<'; - Off := Off + 1; - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Get_File_Signature (Get_Type (El), Res, Off); - end loop; - Res (Off) := '>'; - Off := Off + 1; - end; - when others => - Error_Kind ("get_file_signature", Def); - end case; - end Get_File_Signature; - - procedure Annotate_Protected_Type_Declaration (Block_Info : Sim_Info_Acc; - Prot: Iir) - is - Decl : Iir; - Prot_Info: Sim_Info_Acc; - begin - -- First the interfaces type (they are elaborated in their context). - Decl := Get_Declaration_Chain (Prot); - while Decl /= Null_Iir loop - case Get_Kind (Decl) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); - when Iir_Kind_Use_Clause => - null; - when others => - -- FIXME: attribute - Error_Kind ("annotate_protected_type_declaration", Decl); - end case; - Decl := Get_Chain (Decl); - end loop; - - -- Note: if this protected type declaration appears in a generic - -- package declaration that is shared, the instances will always get - -- Nbr_Objects as 0... - Prot_Info := new Sim_Info_Type'(Kind => Kind_Protected, - Ref => Prot, - Nbr_Objects => 0); - Set_Info (Prot, Prot_Info); - - Decl := Get_Declaration_Chain (Prot); - while Decl /= Null_Iir loop - case Get_Kind (Decl) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - Annotate_Subprogram_Specification (Block_Info, Decl); - when Iir_Kind_Use_Clause => - null; - when others => - Error_Kind ("annotate_protected_type_declaration", Decl); - end case; - Decl := Get_Chain (Decl); - end loop; - end Annotate_Protected_Type_Declaration; - - procedure Annotate_Protected_Type_Body (Block_Info : Sim_Info_Acc; - Prot: Iir) - is - pragma Unreferenced (Block_Info); - Prot_Info : constant Sim_Info_Acc := - Get_Info (Get_Protected_Type_Declaration (Prot)); - begin - Set_Info (Prot, Prot_Info); - - Annotate_Declaration_List (Prot_Info, Get_Declaration_Chain (Prot)); - end Annotate_Protected_Type_Body; - - procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir) - is - El: Iir; - begin - -- Happen only with universal types. - if Def = Null_Iir then - return; - end if; - - case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition => - declare - Info : Sim_Info_Acc; - Nbr_Enums : Natural; - begin - if Def = Vhdl.Std_Package.Boolean_Type_Definition - or else Def = Vhdl.Std_Package.Bit_Type_Definition - then - Info := new Sim_Info_Type'(Kind => Kind_Bit_Type, - Ref => Def, - Width => 1); - elsif Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type - or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type - then - Info := new Sim_Info_Type'(Kind => Kind_Log_Type, - Ref => Def, - Width => 1); - else - Nbr_Enums := Get_Nbr_Elements - (Get_Enumeration_Literal_List (Def)); - if Nbr_Enums <= 256 then - Info := new Sim_Info_Type'(Kind => Kind_E8_Type, - Ref => Def, - Width => 0); - else - Info := new Sim_Info_Type'(Kind => Kind_E32_Type, - Ref => Def, - Width => 0); - end if; - end if; - Set_Info (Def, Info); - if not Flag_Synthesis then - Annotate_Range_Expression - (Block_Info, Get_Range_Constraint (Def)); - end if; - end; - - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => - El := Get_Range_Constraint (Def); - if El /= Null_Iir then - case Get_Kind (El) is - when Iir_Kind_Range_Expression => - if not Flag_Synthesis then - Annotate_Range_Expression (Block_Info, El); - end if; - -- A physical subtype may be defined by an integer range. - if Get_Kind (Def) = Iir_Kind_Physical_Subtype_Definition - then - null; - -- FIXME - -- Convert_Int_To_Phys (Get_Info (El).Value); - end if; - when Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - null; - when others => - Error_Kind ("annotate_type_definition (rc)", El); - end case; - end if; - if Flag_Synthesis then - Create_Object_Info (Block_Info, Def); - end if; - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Base_Type (Def)); - - when Iir_Kind_Integer_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, - Ref => Def, - Width => 0)); - - when Iir_Kind_Floating_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_F64_Type, - Ref => Def, - Width => 0)); - - when Iir_Kind_Physical_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, - Ref => Def, - Width => 0)); - - when Iir_Kind_Array_Type_Definition => - El := Get_Element_Subtype (Def); - Annotate_Anonymous_Type_Definition (Block_Info, El); - - when Iir_Kind_Array_Subtype_Definition => - if Flag_Synthesis then - -- For the bounds. - Create_Object_Info (Block_Info, Def); - else - declare - List : constant Iir_Flist := Get_Index_Subtype_List (Def); - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Index_Type (List, I); - Annotate_Anonymous_Type_Definition (Block_Info, El); - end loop; - end; - end if; - - when Iir_Kind_Record_Type_Definition => - declare - List : constant Iir_Flist := - Get_Elements_Declaration_List (Def); - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Type (El)); - end loop; - end; - - when Iir_Kind_Record_Subtype_Definition => - null; - - when Iir_Kind_Access_Type_Definition => - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Designated_Type (Def)); - - when Iir_Kind_Access_Subtype_Definition => - null; - - when Iir_Kind_File_Type_Definition => - declare - Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def)); - Res : String_Acc; - begin - if Get_Text_File_Flag (Def) - or else - (Get_Kind (Type_Name) - in Iir_Kinds_Scalar_Type_And_Subtype_Definition) - then - Res := null; - else - declare - Sig : String - (1 .. Get_File_Signature_Length (Type_Name) + 2); - Off : Natural := Sig'First; - begin - Get_File_Signature (Type_Name, Sig, Off); - Sig (Off + 0) := '.'; - Sig (Off + 1) := ASCII.NUL; - Res := new String'(Sig); - end; - end if; - Set_Info (Def, - new Sim_Info_Type'(Kind => Kind_File_Type, - Ref => Def, - File_Signature => Res)); - end; - - when Iir_Kind_Protected_Type_Declaration => - Annotate_Protected_Type_Declaration (Block_Info, Def); - - when Iir_Kind_Incomplete_Type_Definition => - null; - - when others => - Error_Kind ("annotate_type_definition", Def); - end case; - end Annotate_Type_Definition; - - procedure Annotate_Interface_List_Subtype - (Block_Info: Sim_Info_Acc; Decl_Chain: Iir) - is - El: Iir; - begin - El := Decl_Chain; - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_File_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El)); - when others => - Error_Kind ("annotate_interface_list_subtype", El); - end case; - El := Get_Chain (El); - end loop; - end Annotate_Interface_List_Subtype; - - procedure Annotate_Interface_Package_Declaration - (Block_Info: Sim_Info_Acc; Inter : Iir) - is - Package_Info : Sim_Info_Acc; - begin - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; - Package_Info := new Sim_Info_Type' - (Kind => Kind_Package, - Ref => Inter, - Nbr_Objects => 0, - Pkg_Slot => Block_Info.Nbr_Objects, - Pkg_Parent => Block_Info); - Set_Info (Inter, Package_Info); - - Annotate_Interface_List - (Package_Info, Get_Generic_Chain (Inter), True); - Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Inter)); - end Annotate_Interface_Package_Declaration; - - procedure Annotate_Interface_List - (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean) - is - Decl : Iir; - begin - Decl := Decl_Chain; - while Decl /= Null_Iir loop - if With_Types - and then Get_Kind (Decl) in Iir_Kinds_Interface_Object_Declaration - then - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); - end if; - case Get_Kind (Decl) is - when Iir_Kind_Interface_Signal_Declaration => - Create_Signal_Info (Block_Info, Decl); - when Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_File_Declaration => - Create_Object_Info (Block_Info, Decl); - when Iir_Kind_Interface_Package_Declaration => - Annotate_Interface_Package_Declaration (Block_Info, Decl); - when Iir_Kinds_Interface_Subprogram_Declaration - | Iir_Kind_Interface_Type_Declaration => - -- Macro-expanded - null; - when others => - Error_Kind ("annotate_interface_list", Decl); - end case; - Decl := Get_Chain (Decl); - end loop; - end Annotate_Interface_List; - - procedure Annotate_Subprogram_Interfaces_Type - (Block_Info : Sim_Info_Acc; Subprg: Iir) - is - Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg); - begin - -- See LRM93 12.3.1.1 (Subprogram declarations and bodies). The type - -- of the interfaces are elaborated in the outer context. - Annotate_Interface_List_Subtype (Block_Info, Interfaces); - - if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then - -- FIXME: can this create a new annotation ? - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Return_Type (Subprg)); - end if; - end Annotate_Subprogram_Interfaces_Type; - - procedure Annotate_Subprogram_Specification - (Block_Info : Sim_Info_Acc; Subprg: Iir) - is - pragma Unreferenced (Block_Info); - Subprg_Info: Sim_Info_Acc; - Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg); - begin - Subprg_Info := new Sim_Info_Type'(Kind => Kind_Frame, - Ref => Subprg, - Nbr_Objects => 0); - Set_Info (Subprg, Subprg_Info); - - Annotate_Interface_List (Subprg_Info, Interfaces, False); - end Annotate_Subprogram_Specification; - - procedure Annotate_Subprogram_Body - (Block_Info : Sim_Info_Acc; Subprg: Iir) - is - pragma Unreferenced (Block_Info); - Spec : constant Iir := Get_Subprogram_Specification (Subprg); - Subprg_Info : constant Sim_Info_Acc := Get_Info (Spec); - begin - Set_Info (Subprg, Subprg_Info); - - -- Do not annotate body of foreign subprograms. - if Get_Foreign_Flag (Spec) then - return; - end if; - - Annotate_Declaration_List - (Subprg_Info, Get_Declaration_Chain (Subprg)); - - Annotate_Sequential_Statement_Chain - (Subprg_Info, Get_Sequential_Statement_Chain (Subprg)); - end Annotate_Subprogram_Body; - - procedure Annotate_Component_Declaration (Comp: Iir_Component_Declaration) - is - Info : Sim_Info_Acc; - begin - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Comp, - Inst_Slot => Invalid_Instance_Slot, - Nbr_Objects => 0, - Nbr_Instances => 1); -- For the instance. - Set_Info (Comp, Info); - - Annotate_Interface_List (Info, Get_Generic_Chain (Comp), True); - Annotate_Interface_List (Info, Get_Port_Chain (Comp), True); - end Annotate_Component_Declaration; - - -- For package declaration or package instantiation declaration. - procedure Annotate_Package_Declaration - (Block_Info : Sim_Info_Acc; Decl: Iir) - is - Package_Info : Sim_Info_Acc; - Header : Iir; - begin - Package_Info := new Sim_Info_Type' - (Kind => Kind_Package, - Ref => Decl, - Nbr_Objects => 0, - Pkg_Slot => Invalid_Object_Slot, - Pkg_Parent => null); - if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration - or else not Is_Uninstantiated_Package (Decl) - then - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; - Package_Info.Pkg_Slot := Block_Info.Nbr_Objects; - Package_Info.Pkg_Parent := Block_Info; - end if; - - Set_Info (Decl, Package_Info); - - if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then - Annotate_Interface_List - (Package_Info, Get_Generic_Chain (Decl), True); - else - Header := Get_Package_Header (Decl); - if Header /= Null_Iir then - Annotate_Interface_List - (Package_Info, Get_Generic_Chain (Header), True); - end if; - end if; - -- declarations - Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); - - if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then - declare - Bod : constant Iir := Get_Instance_Package_Body (Decl); - begin - if Bod /= Null_Iir then - Set_Info (Bod, Package_Info); - Annotate_Declaration_List - (Package_Info, Get_Declaration_Chain (Bod)); - else - declare - Uninst : constant Iir := - Get_Uninstantiated_Package_Decl (Decl); - Uninst_Info : constant Sim_Info_Acc := Get_Info (Uninst); - begin - -- There is not corresponding body for an instantiation, so - -- also add objects for the shared body. - Package_Info.Nbr_Objects := Uninst_Info.Nbr_Objects; - end; - end if; - end; - end if; - end Annotate_Package_Declaration; - - procedure Annotate_Package_Body (Decl: Iir) - is - Package_Info : constant Sim_Info_Acc := Get_Info (Get_Package (Decl)); - begin - -- Set info field of package body declaration. - Set_Info (Decl, Package_Info); - - -- declarations - Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); - end Annotate_Package_Body; - - procedure Annotate_Declaration_Type (Block_Info: Sim_Info_Acc; Decl: Iir) - is - Ind : constant Iir := Get_Subtype_Indication (Decl); - begin - if Ind = Null_Iir or else Get_Kind (Ind) in Iir_Kinds_Denoting_Name then - return; - end if; - Annotate_Type_Definition (Block_Info, Ind); - end Annotate_Declaration_Type; - - procedure Annotate_Declaration (Block_Info: Sim_Info_Acc; Decl: Iir) is - begin - case Get_Kind (Decl) is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration => - Annotate_Package_Declaration (Block_Info, Decl); - - when Iir_Kind_Package_Body => - Annotate_Package_Body (Decl); - - when Iir_Kind_Signal_Attribute_Declaration => - declare - Attr : Iir; - begin - Attr := Get_Signal_Attribute_Chain (Decl); - while Is_Valid (Attr) loop - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Type (Attr)); - Create_Signal_Info (Block_Info, Attr); - Attr := Get_Attr_Chain (Attr); - end loop; - end; - - when Iir_Kind_Signal_Declaration => - Annotate_Declaration_Type (Block_Info, Decl); - Create_Signal_Info (Block_Info, Decl); - - when Iir_Kind_Variable_Declaration - | Iir_Kind_Iterator_Declaration => - Annotate_Declaration_Type (Block_Info, Decl); - Create_Object_Info (Block_Info, Decl); - - when Iir_Kind_Constant_Declaration => - if Get_Deferred_Declaration (Decl) = Null_Iir - or else Get_Deferred_Declaration_Flag (Decl) - then - -- Create the slot only if the constant is not a full constant - -- declaration. - Annotate_Declaration_Type (Block_Info, Decl); - Create_Object_Info (Block_Info, Decl); - end if; - - when Iir_Kind_File_Declaration => - Annotate_Declaration_Type (Block_Info, Decl); - Create_Object_Info (Block_Info, Decl, Kind_File); - - when Iir_Kind_Terminal_Declaration => - Add_Terminal_Info (Block_Info, Decl); - when Iir_Kinds_Branch_Quantity_Declaration => - Annotate_Declaration_Type (Block_Info, Decl); - Add_Quantity_Info (Block_Info, Decl); - - when Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration => - Annotate_Type_Definition (Block_Info, Get_Type_Definition (Decl)); - when Iir_Kind_Subtype_Declaration => - Annotate_Type_Definition (Block_Info, Get_Type (Decl)); - - when Iir_Kind_Protected_Type_Body => - Annotate_Protected_Type_Body (Block_Info, Decl); - - when Iir_Kind_Component_Declaration => - Annotate_Component_Declaration (Decl); - - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - if Get_Implicit_Definition (Decl) in Iir_Predefined_Explicit - and then not Is_Second_Subprogram_Specification (Decl) - then - Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); - Annotate_Subprogram_Specification (Block_Info, Decl); - end if; - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - Annotate_Subprogram_Body (Block_Info, Decl); - - when Iir_Kind_Object_Alias_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); - Create_Object_Info (Block_Info, Decl); - - when Iir_Kind_Non_Object_Alias_Declaration => - null; - - when Iir_Kind_Attribute_Declaration => - null; - when Iir_Kind_Attribute_Specification => - declare - Value : Iir_Attribute_Value; - begin - Value := Get_Attribute_Value_Spec_Chain (Decl); - while Value /= Null_Iir loop - if not Flag_Synthesis then - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Type (Value)); - end if; - Create_Object_Info (Block_Info, Value); - Value := Get_Spec_Chain (Value); - end loop; - end; - when Iir_Kind_Disconnection_Specification => - null; - - when Iir_Kind_Group_Template_Declaration => - null; - when Iir_Kind_Group_Declaration => - null; - when Iir_Kind_Use_Clause => - null; - - when Iir_Kind_Configuration_Specification => - null; - --- when Iir_Kind_Implicit_Signal_Declaration => --- declare --- Nsig : Iir; --- begin --- Nsig := Decl; --- loop --- Nsig := Get_Implicit_Signal_Chain (Nsig); --- exit when Nsig = Null_Iir; --- Add_Signal_Info (Block_Info, Nsig); --- end loop; --- end; - - when Iir_Kind_Nature_Declaration => - null; - - when Iir_Kind_Psl_Default_Clock => - null; - - when others => - Error_Kind ("annotate_declaration", Decl); - end case; - end Annotate_Declaration; - - procedure Annotate_Declaration_List - (Block_Info: Sim_Info_Acc; Decl_Chain: Iir) - is - El: Iir; - begin - El := Decl_Chain; - while El /= Null_Iir loop - Annotate_Declaration (Block_Info, El); - El := Get_Chain (El); - end loop; - end Annotate_Declaration_List; - - procedure Annotate_Sequential_Statement_Chain - (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir) - is - El: Iir; - Max_Nbr_Objects : Object_Slot_Type; - Current_Nbr_Objects : Object_Slot_Type; - - procedure Save_Nbr_Objects is - begin - -- Objects used by loop statements can be reused later by - -- other (ie following) loop statements. - -- Furthermore, this allow to correctly check elaboration - -- order. - Max_Nbr_Objects := Object_Slot_Type'Max - (Block_Info.Nbr_Objects, Max_Nbr_Objects); - Block_Info.Nbr_Objects := Current_Nbr_Objects; - end Save_Nbr_Objects; - begin - Current_Nbr_Objects := Block_Info.Nbr_Objects; - Max_Nbr_Objects := Current_Nbr_Objects; - - El := Stmt_Chain; - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Null_Statement => - null; - when Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - null; - when Iir_Kind_Return_Statement => - null; - when Iir_Kind_Simple_Signal_Assignment_Statement - | Iir_Kind_Selected_Waveform_Assignment_Statement - | Iir_Kind_Variable_Assignment_Statement => - null; - when Iir_Kind_Procedure_Call_Statement => - null; - when Iir_Kind_Exit_Statement - | Iir_Kind_Next_Statement => - null; - when Iir_Kind_Wait_Statement => - null; - - when Iir_Kind_If_Statement => - declare - Clause: Iir := El; - begin - loop - Annotate_Sequential_Statement_Chain - (Block_Info, Get_Sequential_Statement_Chain (Clause)); - Clause := Get_Else_Clause (Clause); - exit when Clause = Null_Iir; - Save_Nbr_Objects; - end loop; - end; - - when Iir_Kind_Case_Statement => - declare - Assoc: Iir; - begin - Assoc := Get_Case_Statement_Alternative_Chain (El); - loop - Annotate_Sequential_Statement_Chain - (Block_Info, Get_Associated_Chain (Assoc)); - Assoc := Get_Chain (Assoc); - exit when Assoc = Null_Iir; - Save_Nbr_Objects; - end loop; - end; - - when Iir_Kind_For_Loop_Statement => - Annotate_Declaration - (Block_Info, Get_Parameter_Specification (El)); - Annotate_Sequential_Statement_Chain - (Block_Info, Get_Sequential_Statement_Chain (El)); - - when Iir_Kind_While_Loop_Statement => - Annotate_Sequential_Statement_Chain - (Block_Info, Get_Sequential_Statement_Chain (El)); - - when others => - Error_Kind ("annotate_sequential_statement_chain", El); - end case; - - Save_Nbr_Objects; - - El := Get_Chain (El); - end loop; - Block_Info.Nbr_Objects := Max_Nbr_Objects; - end Annotate_Sequential_Statement_Chain; - - procedure Annotate_Block_Statement - (Block_Info : Sim_Info_Acc; Block : Iir_Block_Statement) - is - Info : Sim_Info_Acc; - Header : Iir_Block_Header; - Guard : Iir; - begin - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Block, - Inst_Slot => Block_Info.Nbr_Instances, - Nbr_Objects => 0, - Nbr_Instances => 0); - Set_Info (Block, Info); - - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; - - Guard := Get_Guard_Decl (Block); - if Guard /= Null_Iir then - Create_Signal_Info (Info, Guard); - end if; - Header := Get_Block_Header (Block); - if Header /= Null_Iir then - Annotate_Interface_List (Info, Get_Generic_Chain (Header), True); - Annotate_Interface_List (Info, Get_Port_Chain (Header), True); - end if; - Annotate_Declaration_List (Info, Get_Declaration_Chain (Block)); - Annotate_Concurrent_Statements_List - (Info, Get_Concurrent_Statement_Chain (Block)); - end Annotate_Block_Statement; - - procedure Annotate_Generate_Statement_Body - (Block_Info : Sim_Info_Acc; Bod : Iir; It : Iir) - is - Info : Sim_Info_Acc; - begin - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Bod, - Inst_Slot => Block_Info.Nbr_Instances, - Nbr_Objects => 0, - Nbr_Instances => 0); - Set_Info (Bod, Info); - - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; - - if It /= Null_Iir then - Annotate_Declaration (Info, It); - end if; - Annotate_Declaration_List (Info, Get_Declaration_Chain (Bod)); - Annotate_Concurrent_Statements_List - (Info, Get_Concurrent_Statement_Chain (Bod)); - end Annotate_Generate_Statement_Body; - - procedure Annotate_If_Generate_Statement - (Block_Info : Sim_Info_Acc; Stmt : Iir) - is - Clause : Iir; - begin - Clause := Stmt; - while Clause /= Null_Iir loop - Annotate_Generate_Statement_Body - (Block_Info, Get_Generate_Statement_Body (Clause), Null_Iir); - Clause := Get_Generate_Else_Clause (Clause); - end loop; - end Annotate_If_Generate_Statement; - - procedure Annotate_For_Generate_Statement - (Block_Info : Sim_Info_Acc; Stmt : Iir) is - begin - Annotate_Generate_Statement_Body - (Block_Info, - Get_Generate_Statement_Body (Stmt), - Get_Parameter_Specification (Stmt)); - end Annotate_For_Generate_Statement; - - procedure Annotate_Case_Generate_Statement - (Block_Info : Sim_Info_Acc; Stmt : Iir) - is - Assoc : Iir; - begin - Assoc := Get_Case_Statement_Alternative_Chain (Stmt); - while Assoc /= Null_Iir loop - if not Get_Same_Alternative_Flag (Assoc) then - Annotate_Generate_Statement_Body - (Block_Info, Get_Associated_Block (Assoc), Null_Iir); - end if; - Assoc := Get_Chain (Assoc); - end loop; - end Annotate_Case_Generate_Statement; - - procedure Annotate_Component_Instantiation_Statement - (Block_Info : Sim_Info_Acc; Stmt : Iir) - is - Info: Sim_Info_Acc; - begin - -- Add a slot just to put the instance. - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Stmt, - Inst_Slot => Block_Info.Nbr_Instances, - Nbr_Objects => 0, - Nbr_Instances => 1); - Set_Info (Stmt, Info); - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; - end Annotate_Component_Instantiation_Statement; - - procedure Annotate_Process_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) - is - pragma Unreferenced (Block_Info); - Info : Sim_Info_Acc; - begin - Info := new Sim_Info_Type'(Kind => Kind_Process, - Ref => Stmt, - Nbr_Objects => 0); - Set_Info (Stmt, Info); - - Annotate_Declaration_List - (Info, Get_Declaration_Chain (Stmt)); - Annotate_Sequential_Statement_Chain - (Info, Get_Sequential_Statement_Chain (Stmt)); - end Annotate_Process_Statement; - - procedure Annotate_Concurrent_Statements_List - (Block_Info: Sim_Info_Acc; Stmt_Chain : Iir) - is - El : Iir; - begin - El := Stmt_Chain; - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Annotate_Process_Statement (Block_Info, El); - - when Iir_Kind_Component_Instantiation_Statement => - Annotate_Component_Instantiation_Statement (Block_Info, El); - - when Iir_Kind_Block_Statement => - Annotate_Block_Statement (Block_Info, El); - - when Iir_Kind_If_Generate_Statement => - Annotate_If_Generate_Statement (Block_Info, El); - when Iir_Kind_For_Generate_Statement => - Annotate_For_Generate_Statement (Block_Info, El); - when Iir_Kind_Case_Generate_Statement => - Annotate_Case_Generate_Statement (Block_Info, El); - - when Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration => - null; - - when Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Psl_Assert_Statement => - null; - when Iir_Kind_Psl_Endpoint_Declaration => - Create_Object_Info (Block_Info, El, Kind_PSL); - - when Iir_Kind_Simple_Simultaneous_Statement => - null; - - when Iir_Kind_Concurrent_Simple_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Conditional_Signal_Assignment => - -- In case concurrent signal assignemnts were not - -- canonicalized (for synthesis). - null; - - when others => - Error_Kind ("annotate_concurrent_statements_list", El); - end case; - El := Get_Chain (El); - end loop; - end Annotate_Concurrent_Statements_List; - - procedure Annotate_Entity (Decl: Iir_Entity_Declaration) - is - Entity_Info: Sim_Info_Acc; - begin - Entity_Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Decl, - Inst_Slot => Invalid_Instance_Slot, - Nbr_Objects => 0, - Nbr_Instances => 0); - Set_Info (Decl, Entity_Info); - - Annotate_Interface_List (Entity_Info, Get_Generic_Chain (Decl), True); - Annotate_Interface_List (Entity_Info, Get_Port_Chain (Decl), True); - - Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); - Annotate_Concurrent_Statements_List - (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); - end Annotate_Entity; - - procedure Annotate_Architecture (Decl: Iir_Architecture_Body) - is - Entity_Info : constant Sim_Info_Acc := Get_Info (Get_Entity (Decl)); - Saved_Info : constant Sim_Info_Type (Kind_Block) := Entity_Info.all; - Arch_Info: Sim_Info_Acc; - begin - -- No blocks no instantiation in entities. - pragma Assert (Entity_Info.Nbr_Instances = 0); - - -- Annotate architecture using the entity as the architecture extend - -- the scope of the entity, and the entity is the reference. - - Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); - Annotate_Concurrent_Statements_List - (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); - - Arch_Info := new Sim_Info_Type'(Entity_Info.all); - Entity_Info.all := Saved_Info; - Set_Info (Decl, Arch_Info); - end Annotate_Architecture; - - procedure Annotate_Component_Configuration - (Conf : Iir_Component_Configuration) - is - Block : constant Iir := Get_Block_Configuration (Conf); - begin - Annotate_Block_Configuration (Block); - end Annotate_Component_Configuration; - - procedure Annotate_Block_Configuration (Block : Iir_Block_Configuration) - is - El : Iir; - begin - if Block = Null_Iir then - return; - end if; - - -- Declaration are use_clause only. - El := Get_Configuration_Item_Chain (Block); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Block_Configuration => - Annotate_Block_Configuration (El); - when Iir_Kind_Component_Configuration => - Annotate_Component_Configuration (El); - when others => - Error_Kind ("annotate_block_configuration", El); - end case; - El := Get_Chain (El); - end loop; - end Annotate_Block_Configuration; - - procedure Annotate_Configuration_Declaration - (Block_Info : Sim_Info_Acc; Decl : Iir_Configuration_Declaration) - is - Config_Info: Sim_Info_Acc; - begin - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; - Config_Info := new Sim_Info_Type' - (Kind => Kind_Package, - Ref => Decl, - Nbr_Objects => 0, - Pkg_Slot => Block_Info.Nbr_Objects, - Pkg_Parent => Block_Info); - Set_Info (Decl, Config_Info); - - Annotate_Declaration_List (Config_Info, Get_Declaration_Chain (Decl)); - Annotate_Block_Configuration (Get_Block_Configuration (Decl)); - end Annotate_Configuration_Declaration; - - package Info_Node is new Tables - (Table_Component_Type => Sim_Info_Acc, - Table_Index_Type => Iir, - Table_Low_Bound => 2, - Table_Initial => 1024); - - procedure Annotate_Expand_Table - is - El: Iir; - begin - Info_Node.Increment_Last; - El := Info_Node.Last; - Info_Node.Set_Last (Get_Last_Node); - for I in El .. Info_Node.Last loop - Info_Node.Table (I) := null; - end loop; - end Annotate_Expand_Table; - - -- Decorate the tree in order to be usable with the internal simulator. - procedure Annotate (Unit : Iir_Design_Unit) - is - El : constant Iir := Get_Library_Unit (Unit); - begin - -- Expand info table. - Annotate_Expand_Table; - - case Get_Kind (El) is - when Iir_Kind_Entity_Declaration => - Annotate_Entity (El); - when Iir_Kind_Architecture_Body => - Annotate_Architecture (El); - when Iir_Kind_Package_Declaration => - declare - use Vhdl.Std_Package; - begin - if El = Standard_Package then - pragma Assert (Global_Info = null); - Global_Info := - new Sim_Info_Type'(Kind => Kind_Block, - Ref => El, - Nbr_Objects => 0, - Inst_Slot => Invalid_Instance_Slot, - Nbr_Instances => 0); - Annotate_Package_Declaration (Global_Info, El); - -- These types are not in std.standard! - Annotate_Type_Definition - (Get_Info (El), Convertible_Integer_Type_Definition); - Annotate_Type_Definition - (Get_Info (El), Convertible_Real_Type_Definition); - else - pragma Assert (Global_Info /= null); - Annotate_Package_Declaration (Global_Info, El); - end if; - end; - when Iir_Kind_Package_Body => - Annotate_Package_Body (El); - when Iir_Kind_Configuration_Declaration => - Annotate_Configuration_Declaration (Global_Info, El); - when Iir_Kind_Package_Instantiation_Declaration => - Annotate_Package_Declaration (Global_Info, El); - when Iir_Kind_Context_Declaration => - null; - when others => - Error_Kind ("annotate2", El); - end case; - end Annotate; - - -- Disp annotations for an iir node. - procedure Disp_Vhdl_Info (Node: Iir) - is - use Simple_IO; - Info : constant Sim_Info_Acc := Get_Info (Node); - begin - if Info = null then - return; - end if; - - case Info.Kind is - when Kind_Block => - Put_Line - ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); - - when Kind_Frame - | Kind_Protected - | Kind_Process - | Kind_Package => - Put_Line - ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); - - when Kind_Object | Kind_Signal | Kind_File - | Kind_Terminal - | Kind_Quantity - | Kind_PSL => - Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot)); - when Kind_Scalar_Types - | Kind_File_Type - | Kind_Extra => - null; - end case; - end Disp_Vhdl_Info; - - procedure Disp_Info (Info : Sim_Info_Acc) - is - use Simple_IO; - begin - if Info = null then - Put_Line ("*null*"); - return; - end if; - case Info.Kind is - when Kind_Block - | Kind_Frame - | Kind_Protected - | Kind_Process - | Kind_Package => - Put_Line ("nbr objects:" - & Object_Slot_Type'Image (Info.Nbr_Objects)); - case Info.Kind is - when Kind_Block => - Put ("inst_slot:" - & Instance_Slot_Type'Image (Info.Inst_Slot)); - Put_Line (", nbr instance:" - & Instance_Slot_Type'Image (Info.Nbr_Instances)); - when others => - null; - end case; - when Kind_Object | Kind_Signal | Kind_File - | Kind_Terminal | Kind_Quantity - | Kind_PSL => - Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot)); - when Kind_Extra => - Put_Line ("extra:" & Extra_Slot_Type'Image (Info.Extra_Slot)); - when Kind_Scalar_Types => - Put_Line ("scalar type"); - when Kind_File_Type => - Put ("file type: "); - if Info.File_Signature = null then - Put ("(no sig)"); - else - Put (Info.File_Signature.all); - end if; - New_Line; - end case; - end Disp_Info; - - procedure Disp_Tree_Info (Node: Iir) is - begin - Disp_Info (Get_Info (Node)); - end Disp_Tree_Info; - - procedure Set_Info (Target: Iir; Info: Sim_Info_Acc) is - begin - pragma Assert (Info_Node.Table (Target) = null); - Info_Node.Table (Target) := Info; - end Set_Info; - - function Get_Info (Target: Iir) return Sim_Info_Acc is - begin - return Info_Node.Table (Target); - end Get_Info; -end Simul.Annotations; diff --git a/src/vhdl/simulate/simul-annotations.ads b/src/vhdl/simulate/simul-annotations.ads deleted file mode 100644 index 52d637907..000000000 --- a/src/vhdl/simulate/simul-annotations.ads +++ /dev/null @@ -1,158 +0,0 @@ --- Annotations for interpreted simulation --- Copyright (C) 2014 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Vhdl.Nodes; use Vhdl.Nodes; - -package Simul.Annotations is - -- If True, annotate for synthesis. - Flag_Synthesis : Boolean := False; - - type Object_Slot_Type is new Natural; - - -- This slot is not used. - Invalid_Object_Slot : constant Object_Slot_Type := 0; - - type Block_Instance_Id is new Natural; - No_Block_Instance_Id : constant Block_Instance_Id := 0; - - -- For Kind_Extra: a number. Kind_Extra is not used by annotations, and - -- is free for another pass like preelab. - type Extra_Slot_Type is new Natural; - - -- The annotation depends on the kind of the node. - type Sim_Info_Kind is - ( - Kind_Block, Kind_Process, Kind_Frame, Kind_Protected, Kind_Package, - Kind_Bit_Type, Kind_Log_Type, - Kind_E8_Type, Kind_E32_Type, Kind_I64_Type, Kind_F64_Type, - Kind_File_Type, - Kind_Object, Kind_Signal, - Kind_File, - Kind_Terminal, Kind_Quantity, - Kind_PSL, - Kind_Extra - ); - - subtype Kind_Scalar_Types is Sim_Info_Kind range - Kind_Bit_Type .. - --Kind_Log_Type - --Kind_E8_Type - --Kind_E32_Type - --Kind_I64_Type - Kind_F64_Type; - - subtype Kind_Discrete_Types is Sim_Info_Kind range - Kind_Bit_Type .. - --Kind_Log_Type - --Kind_E8_Type - --Kind_E32_Type - Kind_I64_Type; - - subtype Kind_Enum_Types is Sim_Info_Kind range - Kind_Bit_Type .. - --Kind_Log_Type - --Kind_E8_Type - Kind_E32_Type; - - type Instance_Slot_Type is new Integer; - Invalid_Instance_Slot : constant Instance_Slot_Type := -1; - - type Sim_Info_Type (Kind : Sim_Info_Kind); - type Sim_Info_Acc is access all Sim_Info_Type; - - -- Annotation for an iir node in order to be able to simulate it. - type Sim_Info_Type (Kind: Sim_Info_Kind) is record - -- Redundant, to be used only for debugging. - Ref : Iir; - - case Kind is - when Kind_Block - | Kind_Frame - | Kind_Protected - | Kind_Process - | Kind_Package => - -- Number of objects/signals. - Nbr_Objects : Object_Slot_Type; - - case Kind is - when Kind_Block => - -- Slot number in the parent (for blocks). - Inst_Slot : Instance_Slot_Type; - - -- Number of children (blocks, generate, instantiation). - Nbr_Instances : Instance_Slot_Type; - - when Kind_Package => - Pkg_Slot : Object_Slot_Type; - Pkg_Parent : Sim_Info_Acc; - - when others => - null; - end case; - - when Kind_Object - | Kind_Signal - | Kind_File - | Kind_Terminal - | Kind_Quantity - | Kind_PSL => - -- Block in which this object is declared in. - Obj_Scope : Sim_Info_Acc; - - -- Variable index in the block. - Slot: Object_Slot_Type; - - when Kind_Bit_Type - | Kind_Log_Type - | Kind_E8_Type - | Kind_E32_Type - | Kind_I64_Type - | Kind_F64_Type=> - Width : Uns32; - - when Kind_File_Type => - File_Signature : String_Acc; - - when Kind_Extra => - Extra_Slot : Extra_Slot_Type; - end case; - end record; - - -- Decorate the tree in order to be usable with the internal simulator. - procedure Annotate (Unit : Iir_Design_Unit); - - -- Disp annotations for an iir node. - procedure Disp_Vhdl_Info (Node : Iir); - procedure Disp_Tree_Info (Node : Iir); - - Global_Info : Sim_Info_Acc; - - -- Annotations are used to collect informations for elaboration and to - -- locate iir_value_literal for signals, variables or constants. - - -- Get/Set annotation fied from/to an iir. - procedure Set_Info (Target : Iir; Info : Sim_Info_Acc); - pragma Inline (Set_Info); - function Get_Info (Target : Iir) return Sim_Info_Acc; - pragma Inline (Get_Info); - - -- Expand the annotation table. This is automatically done by Annotate, - -- to be used only by debugger. - procedure Annotate_Expand_Table; -end Simul.Annotations; diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb index 93f926048..e656e0ff6 100644 --- a/src/vhdl/simulate/simul-debugger.adb +++ b/src/vhdl/simulate/simul-debugger.adb @@ -31,7 +31,7 @@ with Vhdl.Canon; with Std_Names; with Libraries; with Vhdl.Std_Package; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; with Vhdl.Utils; use Vhdl.Utils; diff --git a/src/vhdl/simulate/simul-elaboration.ads b/src/vhdl/simulate/simul-elaboration.ads index 4c26b7d28..63fd11157 100644 --- a/src/vhdl/simulate/simul-elaboration.ads +++ b/src/vhdl/simulate/simul-elaboration.ads @@ -19,7 +19,7 @@ with Tables; with Types; use Types; with Vhdl.Nodes; use Vhdl.Nodes; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Simul.Environments; use Simul.Environments; with Grt.Types; use Grt.Types; diff --git a/src/vhdl/simulate/simul-environments.ads b/src/vhdl/simulate/simul-environments.ads index 30f49aae0..dd0ca8b55 100644 --- a/src/vhdl/simulate/simul-environments.ads +++ b/src/vhdl/simulate/simul-environments.ads @@ -18,7 +18,7 @@ with Ada.Unchecked_Deallocation; with Vhdl.Nodes; use Vhdl.Nodes; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Grt.Types; use Grt.Types; with Grt.Signals; use Grt.Signals; with Grt.Files; diff --git a/src/vhdl/simulate/simul-execution.ads b/src/vhdl/simulate/simul-execution.ads index e121a1bc8..567c13132 100644 --- a/src/vhdl/simulate/simul-execution.ads +++ b/src/vhdl/simulate/simul-execution.ads @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Vhdl.Nodes; use Vhdl.Nodes; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Simul.Environments; use Simul.Environments; with Simul.Elaboration; use Simul.Elaboration; with Areapools; use Areapools; diff --git a/src/vhdl/simulate/simul-file_operation.adb b/src/vhdl/simulate/simul-file_operation.adb index 98b1729c2..0b687ef1e 100644 --- a/src/vhdl/simulate/simul-file_operation.adb +++ b/src/vhdl/simulate/simul-file_operation.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Types; use Types; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Simul.Execution; use Simul.Execution; with Simul.Debugger; use Simul.Debugger; with Simul.Grt_Interface; use Simul.Grt_Interface; diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb index 25250706a..461aeaad0 100644 --- a/src/vhdl/simulate/simul-simulation-main.adb +++ b/src/vhdl/simulate/simul-simulation-main.adb @@ -30,7 +30,7 @@ with Vhdl.Std_Package; with Trans_Analyzes; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; -with Simul.Annotations; use Simul.Annotations; +with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Ieee.Std_Logic_1164; with Grt.Main; with Simul.Debugger; use Simul.Debugger; diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb new file mode 100644 index 000000000..ace106d4f --- /dev/null +++ b/src/vhdl/vhdl-annotations.adb @@ -0,0 +1,1315 @@ +-- Annotations for interpreted simulation +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Tables; +with Simple_IO; +with Vhdl.Std_Package; +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Ieee.Std_Logic_1164; + +package body Vhdl.Annotations is + procedure Annotate_Declaration_List + (Block_Info: Sim_Info_Acc; Decl_Chain: Iir); + procedure Annotate_Sequential_Statement_Chain + (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir); + procedure Annotate_Concurrent_Statements_List + (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir); + procedure Annotate_Block_Configuration + (Block : Iir_Block_Configuration); + procedure Annotate_Subprogram_Interfaces_Type + (Block_Info : Sim_Info_Acc; Subprg: Iir); + procedure Annotate_Subprogram_Specification + (Block_Info : Sim_Info_Acc; Subprg: Iir); + procedure Annotate_Interface_List + (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean); + + procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir); + + -- Annotate type definition DEF only if it is anonymous. + procedure Annotate_Anonymous_Type_Definition + (Block_Info: Sim_Info_Acc; Def: Iir); + + -- Add an annotation to object OBJ. + procedure Create_Object_Info (Block_Info : Sim_Info_Acc; + Obj : Iir; + Obj_Kind : Sim_Info_Kind := Kind_Object) + is + Info : Sim_Info_Acc; + begin + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; + case Obj_Kind is + when Kind_Object => + Info := new Sim_Info_Type'(Kind => Kind_Object, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + when Kind_File => + Info := new Sim_Info_Type'(Kind => Kind_File, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + when Kind_Signal => + Info := new Sim_Info_Type'(Kind => Kind_Signal, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + if not Flag_Synthesis then + -- Reserve one more slot for value, and initial driver value. + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 2; + end if; + when Kind_Terminal => + Info := new Sim_Info_Type'(Kind => Kind_Terminal, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + when Kind_Quantity => + Info := new Sim_Info_Type'(Kind => Kind_Quantity, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + when Kind_PSL => + Info := new Sim_Info_Type'(Kind => Kind_PSL, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); + when Kind_Block + | Kind_Process + | Kind_Frame + | Kind_Protected + | Kind_Package + | Kind_Scalar_Types + | Kind_File_Type + | Kind_Extra => + raise Internal_Error; + end case; + Set_Info (Obj, Info); + end Create_Object_Info; + + -- Add an annotation to SIGNAL. + procedure Create_Signal_Info (Block_Info: Sim_Info_Acc; Signal: Iir) is + begin + Create_Object_Info (Block_Info, Signal, Kind_Signal); + end Create_Signal_Info; + + procedure Add_Terminal_Info (Block_Info: Sim_Info_Acc; Terminal : Iir) is + begin + Create_Object_Info (Block_Info, Terminal, Kind_Terminal); + end Add_Terminal_Info; + + procedure Add_Quantity_Info (Block_Info: Sim_Info_Acc; Quantity : Iir) is + begin + Create_Object_Info (Block_Info, Quantity, Kind_Quantity); + end Add_Quantity_Info; + + -- If EXPR has not a literal value, create one. + -- This is necessary for subtype bounds. + procedure Annotate_Range_Expression + (Block_Info: Sim_Info_Acc; Expr: Iir_Range_Expression) is + begin + if Get_Info (Expr) /= null then + return; + end if; + Create_Object_Info (Block_Info, Expr); + end Annotate_Range_Expression; + + -- Annotate type definition DEF only if it is anonymous. + procedure Annotate_Anonymous_Type_Definition + (Block_Info: Sim_Info_Acc; Def: Iir) is + begin + if Is_Anonymous_Type_Definition (Def) then + Annotate_Type_Definition (Block_Info, Def); + end if; + end Annotate_Anonymous_Type_Definition; + + function Get_File_Signature_Length (Def : Iir) return Natural is + begin + case Get_Kind (Def) is + when Iir_Kinds_Scalar_Type_And_Subtype_Definition => + return 1; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + return 2 + + Get_File_Signature_Length (Get_Element_Subtype (Def)); + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + declare + List : constant Iir_Flist := + Get_Elements_Declaration_List (Get_Base_Type (Def)); + El : Iir; + Res : Natural; + begin + Res := 2; + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Res := Res + Get_File_Signature_Length (Get_Type (El)); + end loop; + return Res; + end; + when others => + Error_Kind ("get_file_signature_length", Def); + end case; + end Get_File_Signature_Length; + + procedure Get_File_Signature (Def : Iir; + Res : in out String; + Off : in out Natural) + is + Scalar_Map : constant array (Kind_Scalar_Types) of Character := "beeEIF"; + begin + case Get_Kind (Def) is + when Iir_Kinds_Scalar_Type_And_Subtype_Definition => + Res (Off) := Scalar_Map (Get_Info (Get_Base_Type (Def)).Kind); + Off := Off + 1; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + Res (Off) := '['; + Off := Off + 1; + Get_File_Signature (Get_Element_Subtype (Def), Res, Off); + Res (Off) := ']'; + Off := Off + 1; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + declare + List : constant Iir_Flist := + Get_Elements_Declaration_List (Get_Base_Type (Def)); + El : Iir; + begin + Res (Off) := '<'; + Off := Off + 1; + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Get_File_Signature (Get_Type (El), Res, Off); + end loop; + Res (Off) := '>'; + Off := Off + 1; + end; + when others => + Error_Kind ("get_file_signature", Def); + end case; + end Get_File_Signature; + + procedure Annotate_Protected_Type_Declaration (Block_Info : Sim_Info_Acc; + Prot: Iir) + is + Decl : Iir; + Prot_Info: Sim_Info_Acc; + begin + -- First the interfaces type (they are elaborated in their context). + Decl := Get_Declaration_Chain (Prot); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); + when Iir_Kind_Use_Clause => + null; + when others => + -- FIXME: attribute + Error_Kind ("annotate_protected_type_declaration", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + + -- Note: if this protected type declaration appears in a generic + -- package declaration that is shared, the instances will always get + -- Nbr_Objects as 0... + Prot_Info := new Sim_Info_Type'(Kind => Kind_Protected, + Ref => Prot, + Nbr_Objects => 0); + Set_Info (Prot, Prot_Info); + + Decl := Get_Declaration_Chain (Prot); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Annotate_Subprogram_Specification (Block_Info, Decl); + when Iir_Kind_Use_Clause => + null; + when others => + Error_Kind ("annotate_protected_type_declaration", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + end Annotate_Protected_Type_Declaration; + + procedure Annotate_Protected_Type_Body (Block_Info : Sim_Info_Acc; + Prot: Iir) + is + pragma Unreferenced (Block_Info); + Prot_Info : constant Sim_Info_Acc := + Get_Info (Get_Protected_Type_Declaration (Prot)); + begin + Set_Info (Prot, Prot_Info); + + Annotate_Declaration_List (Prot_Info, Get_Declaration_Chain (Prot)); + end Annotate_Protected_Type_Body; + + procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir) + is + El: Iir; + begin + -- Happen only with universal types. + if Def = Null_Iir then + return; + end if; + + case Get_Kind (Def) is + when Iir_Kind_Enumeration_Type_Definition => + declare + Info : Sim_Info_Acc; + Nbr_Enums : Natural; + begin + if Def = Vhdl.Std_Package.Boolean_Type_Definition + or else Def = Vhdl.Std_Package.Bit_Type_Definition + then + Info := new Sim_Info_Type'(Kind => Kind_Bit_Type, + Ref => Def, + Width => 1); + elsif Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type + or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type + then + Info := new Sim_Info_Type'(Kind => Kind_Log_Type, + Ref => Def, + Width => 1); + else + Nbr_Enums := Get_Nbr_Elements + (Get_Enumeration_Literal_List (Def)); + if Nbr_Enums <= 256 then + Info := new Sim_Info_Type'(Kind => Kind_E8_Type, + Ref => Def, + Width => 0); + else + Info := new Sim_Info_Type'(Kind => Kind_E32_Type, + Ref => Def, + Width => 0); + end if; + end if; + Set_Info (Def, Info); + if not Flag_Synthesis then + Annotate_Range_Expression + (Block_Info, Get_Range_Constraint (Def)); + end if; + end; + + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition => + El := Get_Range_Constraint (Def); + if El /= Null_Iir then + case Get_Kind (El) is + when Iir_Kind_Range_Expression => + if not Flag_Synthesis then + Annotate_Range_Expression (Block_Info, El); + end if; + -- A physical subtype may be defined by an integer range. + if Get_Kind (Def) = Iir_Kind_Physical_Subtype_Definition + then + null; + -- FIXME + -- Convert_Int_To_Phys (Get_Info (El).Value); + end if; + when Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => + null; + when others => + Error_Kind ("annotate_type_definition (rc)", El); + end case; + end if; + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def); + end if; + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Base_Type (Def)); + + when Iir_Kind_Integer_Type_Definition => + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, + Ref => Def, + Width => 0)); + + when Iir_Kind_Floating_Type_Definition => + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_F64_Type, + Ref => Def, + Width => 0)); + + when Iir_Kind_Physical_Type_Definition => + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, + Ref => Def, + Width => 0)); + + when Iir_Kind_Array_Type_Definition => + El := Get_Element_Subtype (Def); + Annotate_Anonymous_Type_Definition (Block_Info, El); + + when Iir_Kind_Array_Subtype_Definition => + if Flag_Synthesis then + -- For the bounds. + Create_Object_Info (Block_Info, Def); + else + declare + List : constant Iir_Flist := Get_Index_Subtype_List (Def); + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Index_Type (List, I); + Annotate_Anonymous_Type_Definition (Block_Info, El); + end loop; + end; + end if; + + when Iir_Kind_Record_Type_Definition => + declare + List : constant Iir_Flist := + Get_Elements_Declaration_List (Def); + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Type (El)); + end loop; + end; + + when Iir_Kind_Record_Subtype_Definition => + null; + + when Iir_Kind_Access_Type_Definition => + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Designated_Type (Def)); + + when Iir_Kind_Access_Subtype_Definition => + null; + + when Iir_Kind_File_Type_Definition => + declare + Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def)); + Res : String_Acc; + begin + if Get_Text_File_Flag (Def) + or else + (Get_Kind (Type_Name) + in Iir_Kinds_Scalar_Type_And_Subtype_Definition) + then + Res := null; + else + declare + Sig : String + (1 .. Get_File_Signature_Length (Type_Name) + 2); + Off : Natural := Sig'First; + begin + Get_File_Signature (Type_Name, Sig, Off); + Sig (Off + 0) := '.'; + Sig (Off + 1) := ASCII.NUL; + Res := new String'(Sig); + end; + end if; + Set_Info (Def, + new Sim_Info_Type'(Kind => Kind_File_Type, + Ref => Def, + File_Signature => Res)); + end; + + when Iir_Kind_Protected_Type_Declaration => + Annotate_Protected_Type_Declaration (Block_Info, Def); + + when Iir_Kind_Incomplete_Type_Definition => + null; + + when others => + Error_Kind ("annotate_type_definition", Def); + end case; + end Annotate_Type_Definition; + + procedure Annotate_Interface_List_Subtype + (Block_Info: Sim_Info_Acc; Decl_Chain: Iir) + is + El: Iir; + begin + El := Decl_Chain; + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => + Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El)); + when others => + Error_Kind ("annotate_interface_list_subtype", El); + end case; + El := Get_Chain (El); + end loop; + end Annotate_Interface_List_Subtype; + + procedure Annotate_Interface_Package_Declaration + (Block_Info: Sim_Info_Acc; Inter : Iir) + is + Package_Info : Sim_Info_Acc; + begin + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; + Package_Info := new Sim_Info_Type' + (Kind => Kind_Package, + Ref => Inter, + Nbr_Objects => 0, + Pkg_Slot => Block_Info.Nbr_Objects, + Pkg_Parent => Block_Info); + Set_Info (Inter, Package_Info); + + Annotate_Interface_List + (Package_Info, Get_Generic_Chain (Inter), True); + Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Inter)); + end Annotate_Interface_Package_Declaration; + + procedure Annotate_Interface_List + (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean) + is + Decl : Iir; + begin + Decl := Decl_Chain; + while Decl /= Null_Iir loop + if With_Types + and then Get_Kind (Decl) in Iir_Kinds_Interface_Object_Declaration + then + Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + end if; + case Get_Kind (Decl) is + when Iir_Kind_Interface_Signal_Declaration => + Create_Signal_Info (Block_Info, Decl); + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => + Create_Object_Info (Block_Info, Decl); + when Iir_Kind_Interface_Package_Declaration => + Annotate_Interface_Package_Declaration (Block_Info, Decl); + when Iir_Kinds_Interface_Subprogram_Declaration + | Iir_Kind_Interface_Type_Declaration => + -- Macro-expanded + null; + when others => + Error_Kind ("annotate_interface_list", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + end Annotate_Interface_List; + + procedure Annotate_Subprogram_Interfaces_Type + (Block_Info : Sim_Info_Acc; Subprg: Iir) + is + Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg); + begin + -- See LRM93 12.3.1.1 (Subprogram declarations and bodies). The type + -- of the interfaces are elaborated in the outer context. + Annotate_Interface_List_Subtype (Block_Info, Interfaces); + + if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then + -- FIXME: can this create a new annotation ? + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Return_Type (Subprg)); + end if; + end Annotate_Subprogram_Interfaces_Type; + + procedure Annotate_Subprogram_Specification + (Block_Info : Sim_Info_Acc; Subprg: Iir) + is + pragma Unreferenced (Block_Info); + Subprg_Info: Sim_Info_Acc; + Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg); + begin + Subprg_Info := new Sim_Info_Type'(Kind => Kind_Frame, + Ref => Subprg, + Nbr_Objects => 0); + Set_Info (Subprg, Subprg_Info); + + Annotate_Interface_List (Subprg_Info, Interfaces, False); + end Annotate_Subprogram_Specification; + + procedure Annotate_Subprogram_Body + (Block_Info : Sim_Info_Acc; Subprg: Iir) + is + pragma Unreferenced (Block_Info); + Spec : constant Iir := Get_Subprogram_Specification (Subprg); + Subprg_Info : constant Sim_Info_Acc := Get_Info (Spec); + begin + Set_Info (Subprg, Subprg_Info); + + -- Do not annotate body of foreign subprograms. + if Get_Foreign_Flag (Spec) then + return; + end if; + + Annotate_Declaration_List + (Subprg_Info, Get_Declaration_Chain (Subprg)); + + Annotate_Sequential_Statement_Chain + (Subprg_Info, Get_Sequential_Statement_Chain (Subprg)); + end Annotate_Subprogram_Body; + + procedure Annotate_Component_Declaration (Comp: Iir_Component_Declaration) + is + Info : Sim_Info_Acc; + begin + Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Comp, + Inst_Slot => Invalid_Instance_Slot, + Nbr_Objects => 0, + Nbr_Instances => 1); -- For the instance. + Set_Info (Comp, Info); + + Annotate_Interface_List (Info, Get_Generic_Chain (Comp), True); + Annotate_Interface_List (Info, Get_Port_Chain (Comp), True); + end Annotate_Component_Declaration; + + -- For package declaration or package instantiation declaration. + procedure Annotate_Package_Declaration + (Block_Info : Sim_Info_Acc; Decl: Iir) + is + Package_Info : Sim_Info_Acc; + Header : Iir; + begin + Package_Info := new Sim_Info_Type' + (Kind => Kind_Package, + Ref => Decl, + Nbr_Objects => 0, + Pkg_Slot => Invalid_Object_Slot, + Pkg_Parent => null); + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration + or else not Is_Uninstantiated_Package (Decl) + then + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; + Package_Info.Pkg_Slot := Block_Info.Nbr_Objects; + Package_Info.Pkg_Parent := Block_Info; + end if; + + Set_Info (Decl, Package_Info); + + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then + Annotate_Interface_List + (Package_Info, Get_Generic_Chain (Decl), True); + else + Header := Get_Package_Header (Decl); + if Header /= Null_Iir then + Annotate_Interface_List + (Package_Info, Get_Generic_Chain (Header), True); + end if; + end if; + -- declarations + Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); + + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then + declare + Bod : constant Iir := Get_Instance_Package_Body (Decl); + begin + if Bod /= Null_Iir then + Set_Info (Bod, Package_Info); + Annotate_Declaration_List + (Package_Info, Get_Declaration_Chain (Bod)); + else + declare + Uninst : constant Iir := + Get_Uninstantiated_Package_Decl (Decl); + Uninst_Info : constant Sim_Info_Acc := Get_Info (Uninst); + begin + -- There is not corresponding body for an instantiation, so + -- also add objects for the shared body. + Package_Info.Nbr_Objects := Uninst_Info.Nbr_Objects; + end; + end if; + end; + end if; + end Annotate_Package_Declaration; + + procedure Annotate_Package_Body (Decl: Iir) + is + Package_Info : constant Sim_Info_Acc := Get_Info (Get_Package (Decl)); + begin + -- Set info field of package body declaration. + Set_Info (Decl, Package_Info); + + -- declarations + Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); + end Annotate_Package_Body; + + procedure Annotate_Declaration_Type (Block_Info: Sim_Info_Acc; Decl: Iir) + is + Ind : constant Iir := Get_Subtype_Indication (Decl); + begin + if Ind = Null_Iir or else Get_Kind (Ind) in Iir_Kinds_Denoting_Name then + return; + end if; + Annotate_Type_Definition (Block_Info, Ind); + end Annotate_Declaration_Type; + + procedure Annotate_Declaration (Block_Info: Sim_Info_Acc; Decl: Iir) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration => + Annotate_Package_Declaration (Block_Info, Decl); + + when Iir_Kind_Package_Body => + Annotate_Package_Body (Decl); + + when Iir_Kind_Signal_Attribute_Declaration => + declare + Attr : Iir; + begin + Attr := Get_Signal_Attribute_Chain (Decl); + while Is_Valid (Attr) loop + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Type (Attr)); + Create_Signal_Info (Block_Info, Attr); + Attr := Get_Attr_Chain (Attr); + end loop; + end; + + when Iir_Kind_Signal_Declaration => + Annotate_Declaration_Type (Block_Info, Decl); + Create_Signal_Info (Block_Info, Decl); + + when Iir_Kind_Variable_Declaration + | Iir_Kind_Iterator_Declaration => + Annotate_Declaration_Type (Block_Info, Decl); + Create_Object_Info (Block_Info, Decl); + + when Iir_Kind_Constant_Declaration => + if Get_Deferred_Declaration (Decl) = Null_Iir + or else Get_Deferred_Declaration_Flag (Decl) + then + -- Create the slot only if the constant is not a full constant + -- declaration. + Annotate_Declaration_Type (Block_Info, Decl); + Create_Object_Info (Block_Info, Decl); + end if; + + when Iir_Kind_File_Declaration => + Annotate_Declaration_Type (Block_Info, Decl); + Create_Object_Info (Block_Info, Decl, Kind_File); + + when Iir_Kind_Terminal_Declaration => + Add_Terminal_Info (Block_Info, Decl); + when Iir_Kinds_Branch_Quantity_Declaration => + Annotate_Declaration_Type (Block_Info, Decl); + Add_Quantity_Info (Block_Info, Decl); + + when Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration => + Annotate_Type_Definition (Block_Info, Get_Type_Definition (Decl)); + when Iir_Kind_Subtype_Declaration => + Annotate_Type_Definition (Block_Info, Get_Type (Decl)); + + when Iir_Kind_Protected_Type_Body => + Annotate_Protected_Type_Body (Block_Info, Decl); + + when Iir_Kind_Component_Declaration => + Annotate_Component_Declaration (Decl); + + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + if Get_Implicit_Definition (Decl) in Iir_Predefined_Explicit + and then not Is_Second_Subprogram_Specification (Decl) + then + Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); + Annotate_Subprogram_Specification (Block_Info, Decl); + end if; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Annotate_Subprogram_Body (Block_Info, Decl); + + when Iir_Kind_Object_Alias_Declaration => + Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + Create_Object_Info (Block_Info, Decl); + + when Iir_Kind_Non_Object_Alias_Declaration => + null; + + when Iir_Kind_Attribute_Declaration => + null; + when Iir_Kind_Attribute_Specification => + declare + Value : Iir_Attribute_Value; + begin + Value := Get_Attribute_Value_Spec_Chain (Decl); + while Value /= Null_Iir loop + if not Flag_Synthesis then + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Type (Value)); + end if; + Create_Object_Info (Block_Info, Value); + Value := Get_Spec_Chain (Value); + end loop; + end; + when Iir_Kind_Disconnection_Specification => + null; + + when Iir_Kind_Group_Template_Declaration => + null; + when Iir_Kind_Group_Declaration => + null; + when Iir_Kind_Use_Clause => + null; + + when Iir_Kind_Configuration_Specification => + null; + +-- when Iir_Kind_Implicit_Signal_Declaration => +-- declare +-- Nsig : Iir; +-- begin +-- Nsig := Decl; +-- loop +-- Nsig := Get_Implicit_Signal_Chain (Nsig); +-- exit when Nsig = Null_Iir; +-- Add_Signal_Info (Block_Info, Nsig); +-- end loop; +-- end; + + when Iir_Kind_Nature_Declaration => + null; + + when Iir_Kind_Psl_Default_Clock => + null; + + when others => + Error_Kind ("annotate_declaration", Decl); + end case; + end Annotate_Declaration; + + procedure Annotate_Declaration_List + (Block_Info: Sim_Info_Acc; Decl_Chain: Iir) + is + El: Iir; + begin + El := Decl_Chain; + while El /= Null_Iir loop + Annotate_Declaration (Block_Info, El); + El := Get_Chain (El); + end loop; + end Annotate_Declaration_List; + + procedure Annotate_Sequential_Statement_Chain + (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir) + is + El: Iir; + Max_Nbr_Objects : Object_Slot_Type; + Current_Nbr_Objects : Object_Slot_Type; + + procedure Save_Nbr_Objects is + begin + -- Objects used by loop statements can be reused later by + -- other (ie following) loop statements. + -- Furthermore, this allow to correctly check elaboration + -- order. + Max_Nbr_Objects := Object_Slot_Type'Max + (Block_Info.Nbr_Objects, Max_Nbr_Objects); + Block_Info.Nbr_Objects := Current_Nbr_Objects; + end Save_Nbr_Objects; + begin + Current_Nbr_Objects := Block_Info.Nbr_Objects; + Max_Nbr_Objects := Current_Nbr_Objects; + + El := Stmt_Chain; + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Null_Statement => + null; + when Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + null; + when Iir_Kind_Return_Statement => + null; + when Iir_Kind_Simple_Signal_Assignment_Statement + | Iir_Kind_Selected_Waveform_Assignment_Statement + | Iir_Kind_Variable_Assignment_Statement => + null; + when Iir_Kind_Procedure_Call_Statement => + null; + when Iir_Kind_Exit_Statement + | Iir_Kind_Next_Statement => + null; + when Iir_Kind_Wait_Statement => + null; + + when Iir_Kind_If_Statement => + declare + Clause: Iir := El; + begin + loop + Annotate_Sequential_Statement_Chain + (Block_Info, Get_Sequential_Statement_Chain (Clause)); + Clause := Get_Else_Clause (Clause); + exit when Clause = Null_Iir; + Save_Nbr_Objects; + end loop; + end; + + when Iir_Kind_Case_Statement => + declare + Assoc: Iir; + begin + Assoc := Get_Case_Statement_Alternative_Chain (El); + loop + Annotate_Sequential_Statement_Chain + (Block_Info, Get_Associated_Chain (Assoc)); + Assoc := Get_Chain (Assoc); + exit when Assoc = Null_Iir; + Save_Nbr_Objects; + end loop; + end; + + when Iir_Kind_For_Loop_Statement => + Annotate_Declaration + (Block_Info, Get_Parameter_Specification (El)); + Annotate_Sequential_Statement_Chain + (Block_Info, Get_Sequential_Statement_Chain (El)); + + when Iir_Kind_While_Loop_Statement => + Annotate_Sequential_Statement_Chain + (Block_Info, Get_Sequential_Statement_Chain (El)); + + when others => + Error_Kind ("annotate_sequential_statement_chain", El); + end case; + + Save_Nbr_Objects; + + El := Get_Chain (El); + end loop; + Block_Info.Nbr_Objects := Max_Nbr_Objects; + end Annotate_Sequential_Statement_Chain; + + procedure Annotate_Block_Statement + (Block_Info : Sim_Info_Acc; Block : Iir_Block_Statement) + is + Info : Sim_Info_Acc; + Header : Iir_Block_Header; + Guard : Iir; + begin + Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Block, + Inst_Slot => Block_Info.Nbr_Instances, + Nbr_Objects => 0, + Nbr_Instances => 0); + Set_Info (Block, Info); + + Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + + Guard := Get_Guard_Decl (Block); + if Guard /= Null_Iir then + Create_Signal_Info (Info, Guard); + end if; + Header := Get_Block_Header (Block); + if Header /= Null_Iir then + Annotate_Interface_List (Info, Get_Generic_Chain (Header), True); + Annotate_Interface_List (Info, Get_Port_Chain (Header), True); + end if; + Annotate_Declaration_List (Info, Get_Declaration_Chain (Block)); + Annotate_Concurrent_Statements_List + (Info, Get_Concurrent_Statement_Chain (Block)); + end Annotate_Block_Statement; + + procedure Annotate_Generate_Statement_Body + (Block_Info : Sim_Info_Acc; Bod : Iir; It : Iir) + is + Info : Sim_Info_Acc; + begin + Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Bod, + Inst_Slot => Block_Info.Nbr_Instances, + Nbr_Objects => 0, + Nbr_Instances => 0); + Set_Info (Bod, Info); + + Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + + if It /= Null_Iir then + Annotate_Declaration (Info, It); + end if; + Annotate_Declaration_List (Info, Get_Declaration_Chain (Bod)); + Annotate_Concurrent_Statements_List + (Info, Get_Concurrent_Statement_Chain (Bod)); + end Annotate_Generate_Statement_Body; + + procedure Annotate_If_Generate_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Annotate_Generate_Statement_Body + (Block_Info, Get_Generate_Statement_Body (Clause), Null_Iir); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end Annotate_If_Generate_Statement; + + procedure Annotate_For_Generate_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) is + begin + Annotate_Generate_Statement_Body + (Block_Info, + Get_Generate_Statement_Body (Stmt), + Get_Parameter_Specification (Stmt)); + end Annotate_For_Generate_Statement; + + procedure Annotate_Case_Generate_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + Assoc : Iir; + begin + Assoc := Get_Case_Statement_Alternative_Chain (Stmt); + while Assoc /= Null_Iir loop + if not Get_Same_Alternative_Flag (Assoc) then + Annotate_Generate_Statement_Body + (Block_Info, Get_Associated_Block (Assoc), Null_Iir); + end if; + Assoc := Get_Chain (Assoc); + end loop; + end Annotate_Case_Generate_Statement; + + procedure Annotate_Component_Instantiation_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + Info: Sim_Info_Acc; + begin + -- Add a slot just to put the instance. + Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Stmt, + Inst_Slot => Block_Info.Nbr_Instances, + Nbr_Objects => 0, + Nbr_Instances => 1); + Set_Info (Stmt, Info); + Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + end Annotate_Component_Instantiation_Statement; + + procedure Annotate_Process_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + pragma Unreferenced (Block_Info); + Info : Sim_Info_Acc; + begin + Info := new Sim_Info_Type'(Kind => Kind_Process, + Ref => Stmt, + Nbr_Objects => 0); + Set_Info (Stmt, Info); + + Annotate_Declaration_List + (Info, Get_Declaration_Chain (Stmt)); + Annotate_Sequential_Statement_Chain + (Info, Get_Sequential_Statement_Chain (Stmt)); + end Annotate_Process_Statement; + + procedure Annotate_Concurrent_Statements_List + (Block_Info: Sim_Info_Acc; Stmt_Chain : Iir) + is + El : Iir; + begin + El := Stmt_Chain; + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Annotate_Process_Statement (Block_Info, El); + + when Iir_Kind_Component_Instantiation_Statement => + Annotate_Component_Instantiation_Statement (Block_Info, El); + + when Iir_Kind_Block_Statement => + Annotate_Block_Statement (Block_Info, El); + + when Iir_Kind_If_Generate_Statement => + Annotate_If_Generate_Statement (Block_Info, El); + when Iir_Kind_For_Generate_Statement => + Annotate_For_Generate_Statement (Block_Info, El); + when Iir_Kind_Case_Generate_Statement => + Annotate_Case_Generate_Statement (Block_Info, El); + + when Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Declaration => + null; + + when Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Psl_Assert_Statement => + null; + when Iir_Kind_Psl_Endpoint_Declaration => + Create_Object_Info (Block_Info, El, Kind_PSL); + + when Iir_Kind_Simple_Simultaneous_Statement => + null; + + when Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment => + -- In case concurrent signal assignemnts were not + -- canonicalized (for synthesis). + null; + + when others => + Error_Kind ("annotate_concurrent_statements_list", El); + end case; + El := Get_Chain (El); + end loop; + end Annotate_Concurrent_Statements_List; + + procedure Annotate_Entity (Decl: Iir_Entity_Declaration) + is + Entity_Info: Sim_Info_Acc; + begin + Entity_Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Decl, + Inst_Slot => Invalid_Instance_Slot, + Nbr_Objects => 0, + Nbr_Instances => 0); + Set_Info (Decl, Entity_Info); + + Annotate_Interface_List (Entity_Info, Get_Generic_Chain (Decl), True); + Annotate_Interface_List (Entity_Info, Get_Port_Chain (Decl), True); + + Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); + Annotate_Concurrent_Statements_List + (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); + end Annotate_Entity; + + procedure Annotate_Architecture (Decl: Iir_Architecture_Body) + is + Entity_Info : constant Sim_Info_Acc := Get_Info (Get_Entity (Decl)); + Saved_Info : constant Sim_Info_Type (Kind_Block) := Entity_Info.all; + Arch_Info: Sim_Info_Acc; + begin + -- No blocks no instantiation in entities. + pragma Assert (Entity_Info.Nbr_Instances = 0); + + -- Annotate architecture using the entity as the architecture extend + -- the scope of the entity, and the entity is the reference. + + Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); + Annotate_Concurrent_Statements_List + (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); + + Arch_Info := new Sim_Info_Type'(Entity_Info.all); + Entity_Info.all := Saved_Info; + Set_Info (Decl, Arch_Info); + end Annotate_Architecture; + + procedure Annotate_Component_Configuration + (Conf : Iir_Component_Configuration) + is + Block : constant Iir := Get_Block_Configuration (Conf); + begin + Annotate_Block_Configuration (Block); + end Annotate_Component_Configuration; + + procedure Annotate_Block_Configuration (Block : Iir_Block_Configuration) + is + El : Iir; + begin + if Block = Null_Iir then + return; + end if; + + -- Declaration are use_clause only. + El := Get_Configuration_Item_Chain (Block); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Block_Configuration => + Annotate_Block_Configuration (El); + when Iir_Kind_Component_Configuration => + Annotate_Component_Configuration (El); + when others => + Error_Kind ("annotate_block_configuration", El); + end case; + El := Get_Chain (El); + end loop; + end Annotate_Block_Configuration; + + procedure Annotate_Configuration_Declaration + (Block_Info : Sim_Info_Acc; Decl : Iir_Configuration_Declaration) + is + Config_Info: Sim_Info_Acc; + begin + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; + Config_Info := new Sim_Info_Type' + (Kind => Kind_Package, + Ref => Decl, + Nbr_Objects => 0, + Pkg_Slot => Block_Info.Nbr_Objects, + Pkg_Parent => Block_Info); + Set_Info (Decl, Config_Info); + + Annotate_Declaration_List (Config_Info, Get_Declaration_Chain (Decl)); + Annotate_Block_Configuration (Get_Block_Configuration (Decl)); + end Annotate_Configuration_Declaration; + + package Info_Node is new Tables + (Table_Component_Type => Sim_Info_Acc, + Table_Index_Type => Iir, + Table_Low_Bound => 2, + Table_Initial => 1024); + + procedure Annotate_Expand_Table + is + El: Iir; + begin + Info_Node.Increment_Last; + El := Info_Node.Last; + Info_Node.Set_Last (Get_Last_Node); + for I in El .. Info_Node.Last loop + Info_Node.Table (I) := null; + end loop; + end Annotate_Expand_Table; + + -- Decorate the tree in order to be usable with the internal simulator. + procedure Annotate (Unit : Iir_Design_Unit) + is + El : constant Iir := Get_Library_Unit (Unit); + begin + -- Expand info table. + Annotate_Expand_Table; + + case Get_Kind (El) is + when Iir_Kind_Entity_Declaration => + Annotate_Entity (El); + when Iir_Kind_Architecture_Body => + Annotate_Architecture (El); + when Iir_Kind_Package_Declaration => + declare + use Vhdl.Std_Package; + begin + if El = Standard_Package then + pragma Assert (Global_Info = null); + Global_Info := + new Sim_Info_Type'(Kind => Kind_Block, + Ref => El, + Nbr_Objects => 0, + Inst_Slot => Invalid_Instance_Slot, + Nbr_Instances => 0); + Annotate_Package_Declaration (Global_Info, El); + -- These types are not in std.standard! + Annotate_Type_Definition + (Get_Info (El), Convertible_Integer_Type_Definition); + Annotate_Type_Definition + (Get_Info (El), Convertible_Real_Type_Definition); + else + pragma Assert (Global_Info /= null); + Annotate_Package_Declaration (Global_Info, El); + end if; + end; + when Iir_Kind_Package_Body => + Annotate_Package_Body (El); + when Iir_Kind_Configuration_Declaration => + Annotate_Configuration_Declaration (Global_Info, El); + when Iir_Kind_Package_Instantiation_Declaration => + Annotate_Package_Declaration (Global_Info, El); + when Iir_Kind_Context_Declaration => + null; + when others => + Error_Kind ("annotate2", El); + end case; + end Annotate; + + -- Disp annotations for an iir node. + procedure Disp_Vhdl_Info (Node: Iir) + is + use Simple_IO; + Info : constant Sim_Info_Acc := Get_Info (Node); + begin + if Info = null then + return; + end if; + + case Info.Kind is + when Kind_Block => + Put_Line + ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); + + when Kind_Frame + | Kind_Protected + | Kind_Process + | Kind_Package => + Put_Line + ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); + + when Kind_Object | Kind_Signal | Kind_File + | Kind_Terminal + | Kind_Quantity + | Kind_PSL => + Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot)); + when Kind_Scalar_Types + | Kind_File_Type + | Kind_Extra => + null; + end case; + end Disp_Vhdl_Info; + + procedure Disp_Info (Info : Sim_Info_Acc) + is + use Simple_IO; + begin + if Info = null then + Put_Line ("*null*"); + return; + end if; + case Info.Kind is + when Kind_Block + | Kind_Frame + | Kind_Protected + | Kind_Process + | Kind_Package => + Put_Line ("nbr objects:" + & Object_Slot_Type'Image (Info.Nbr_Objects)); + case Info.Kind is + when Kind_Block => + Put ("inst_slot:" + & Instance_Slot_Type'Image (Info.Inst_Slot)); + Put_Line (", nbr instance:" + & Instance_Slot_Type'Image (Info.Nbr_Instances)); + when others => + null; + end case; + when Kind_Object | Kind_Signal | Kind_File + | Kind_Terminal | Kind_Quantity + | Kind_PSL => + Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot)); + when Kind_Extra => + Put_Line ("extra:" & Extra_Slot_Type'Image (Info.Extra_Slot)); + when Kind_Scalar_Types => + Put_Line ("scalar type"); + when Kind_File_Type => + Put ("file type: "); + if Info.File_Signature = null then + Put ("(no sig)"); + else + Put (Info.File_Signature.all); + end if; + New_Line; + end case; + end Disp_Info; + + procedure Disp_Tree_Info (Node: Iir) is + begin + Disp_Info (Get_Info (Node)); + end Disp_Tree_Info; + + procedure Set_Info (Target: Iir; Info: Sim_Info_Acc) is + begin + pragma Assert (Info_Node.Table (Target) = null); + Info_Node.Table (Target) := Info; + end Set_Info; + + function Get_Info (Target: Iir) return Sim_Info_Acc is + begin + return Info_Node.Table (Target); + end Get_Info; +end Vhdl.Annotations; diff --git a/src/vhdl/vhdl-annotations.ads b/src/vhdl/vhdl-annotations.ads new file mode 100644 index 000000000..5da4ed175 --- /dev/null +++ b/src/vhdl/vhdl-annotations.ads @@ -0,0 +1,158 @@ +-- Annotations for interpreted simulation +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Vhdl.Nodes; use Vhdl.Nodes; + +package Vhdl.Annotations is + -- If True, annotate for synthesis. + Flag_Synthesis : Boolean := False; + + type Object_Slot_Type is new Natural; + + -- This slot is not used. + Invalid_Object_Slot : constant Object_Slot_Type := 0; + + type Block_Instance_Id is new Natural; + No_Block_Instance_Id : constant Block_Instance_Id := 0; + + -- For Kind_Extra: a number. Kind_Extra is not used by annotations, and + -- is free for another pass like preelab. + type Extra_Slot_Type is new Natural; + + -- The annotation depends on the kind of the node. + type Sim_Info_Kind is + ( + Kind_Block, Kind_Process, Kind_Frame, Kind_Protected, Kind_Package, + Kind_Bit_Type, Kind_Log_Type, + Kind_E8_Type, Kind_E32_Type, Kind_I64_Type, Kind_F64_Type, + Kind_File_Type, + Kind_Object, Kind_Signal, + Kind_File, + Kind_Terminal, Kind_Quantity, + Kind_PSL, + Kind_Extra + ); + + subtype Kind_Scalar_Types is Sim_Info_Kind range + Kind_Bit_Type .. + --Kind_Log_Type + --Kind_E8_Type + --Kind_E32_Type + --Kind_I64_Type + Kind_F64_Type; + + subtype Kind_Discrete_Types is Sim_Info_Kind range + Kind_Bit_Type .. + --Kind_Log_Type + --Kind_E8_Type + --Kind_E32_Type + Kind_I64_Type; + + subtype Kind_Enum_Types is Sim_Info_Kind range + Kind_Bit_Type .. + --Kind_Log_Type + --Kind_E8_Type + Kind_E32_Type; + + type Instance_Slot_Type is new Integer; + Invalid_Instance_Slot : constant Instance_Slot_Type := -1; + + type Sim_Info_Type (Kind : Sim_Info_Kind); + type Sim_Info_Acc is access all Sim_Info_Type; + + -- Annotation for an iir node in order to be able to simulate it. + type Sim_Info_Type (Kind: Sim_Info_Kind) is record + -- Redundant, to be used only for debugging. + Ref : Iir; + + case Kind is + when Kind_Block + | Kind_Frame + | Kind_Protected + | Kind_Process + | Kind_Package => + -- Number of objects/signals. + Nbr_Objects : Object_Slot_Type; + + case Kind is + when Kind_Block => + -- Slot number in the parent (for blocks). + Inst_Slot : Instance_Slot_Type; + + -- Number of children (blocks, generate, instantiation). + Nbr_Instances : Instance_Slot_Type; + + when Kind_Package => + Pkg_Slot : Object_Slot_Type; + Pkg_Parent : Sim_Info_Acc; + + when others => + null; + end case; + + when Kind_Object + | Kind_Signal + | Kind_File + | Kind_Terminal + | Kind_Quantity + | Kind_PSL => + -- Block in which this object is declared in. + Obj_Scope : Sim_Info_Acc; + + -- Variable index in the block. + Slot: Object_Slot_Type; + + when Kind_Bit_Type + | Kind_Log_Type + | Kind_E8_Type + | Kind_E32_Type + | Kind_I64_Type + | Kind_F64_Type=> + Width : Uns32; + + when Kind_File_Type => + File_Signature : String_Acc; + + when Kind_Extra => + Extra_Slot : Extra_Slot_Type; + end case; + end record; + + -- Decorate the tree in order to be usable with the internal simulator. + procedure Annotate (Unit : Iir_Design_Unit); + + -- Disp annotations for an iir node. + procedure Disp_Vhdl_Info (Node : Iir); + procedure Disp_Tree_Info (Node : Iir); + + Global_Info : Sim_Info_Acc; + + -- Annotations are used to collect informations for elaboration and to + -- locate iir_value_literal for signals, variables or constants. + + -- Get/Set annotation fied from/to an iir. + procedure Set_Info (Target : Iir; Info : Sim_Info_Acc); + pragma Inline (Set_Info); + function Get_Info (Target : Iir) return Sim_Info_Acc; + pragma Inline (Get_Info); + + -- Expand the annotation table. This is automatically done by Annotate, + -- to be used only by debugger. + procedure Annotate_Expand_Table; +end Vhdl.Annotations; -- cgit v1.2.3