diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-02-02 20:48:55 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-02-06 04:45:30 +0100 |
commit | d8b55e17cad36f3f34f57434ab6c97b2c2afa964 (patch) | |
tree | 0223bb1eb0a13ef50add7fc280eed51499a38529 /src | |
parent | e332c2d9a3b29f3a8606be7c912a4a8ada45d5da (diff) | |
download | ghdl-d8b55e17cad36f3f34f57434ab6c97b2c2afa964.tar.gz ghdl-d8b55e17cad36f3f34f57434ab6c97b2c2afa964.tar.bz2 ghdl-d8b55e17cad36f3f34f57434ab6c97b2c2afa964.zip |
simul: support of package instantiation.
Diffstat (limited to 'src')
-rw-r--r-- | src/vhdl/simulate/annotations.adb | 36 | ||||
-rw-r--r-- | src/vhdl/simulate/annotations.ads | 6 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.adb | 45 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.adb | 9 |
4 files changed, 85 insertions, 11 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index 47aa0e87f..17c9e4fd9 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -93,7 +93,16 @@ package body Annotations is Info := new Sim_Info_Type'(Kind => Kind_Quantity, Obj_Scope => Current_Scope, Slot => Block_Info.Nbr_Objects); - when others => + when Kind_Environment => + Info := new Sim_Info_Type'(Kind => Kind_Environment, + Obj_Scope => Current_Scope, + Slot => Block_Info.Nbr_Objects); + when Kind_Block + | Kind_Process + | Kind_Frame + | Kind_Range + | Kind_Scalar_Type + | Kind_File_Type => raise Internal_Error; end case; Set_Info (Obj, Info); @@ -667,6 +676,9 @@ package body Annotations is when Iir_Kind_Nature_Declaration => null; + when Iir_Kind_Package_Instantiation_Declaration => + Create_Object_Info (Block_Info, Decl, Kind_Environment); + when others => Error_Kind ("annotate_declaration", Decl); end case; @@ -999,7 +1011,9 @@ package body Annotations is procedure Annotate_Package (Decl: Iir_Package_Declaration) is + Prev_Scope : constant Scope_Type := Current_Scope; Package_Info: Sim_Info_Acc; + Header : Iir; begin pragma Assert (Current_Scope.Kind = Scope_Kind_None); @@ -1015,10 +1029,20 @@ package body Annotations is Set_Info (Decl, Package_Info); + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then + Annotate_Create_Interface_List + (Package_Info, Get_Generic_Chain (Decl), True); + else + Header := Get_Package_Header (Decl); + if Header /= Null_Iir then + Annotate_Create_Interface_List + (Package_Info, Get_Generic_Chain (Header), True); + end if; + end if; -- declarations Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); - Current_Scope := (Kind => Scope_Kind_None); + Current_Scope := Prev_Scope; end Annotate_Package; procedure Annotate_Package_Body (Decl: Iir) @@ -1147,6 +1171,8 @@ package body Annotations is Annotate_Package_Body (El); when Iir_Kind_Configuration_Declaration => Annotate_Configuration_Declaration (El); + when Iir_Kind_Package_Instantiation_Declaration => + Annotate_Package (El); when others => Error_Kind ("annotate2", El); end case; @@ -1188,7 +1214,9 @@ package body Annotations is ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); when Kind_Object | Kind_Signal | Kind_File - | Kind_Terminal | Kind_Quantity => + | Kind_Terminal + | Kind_Quantity + | Kind_Environment => Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Image (Info.Obj_Scope)); when Kind_Scalar_Type @@ -1225,7 +1253,7 @@ package body Annotations is Put_Line ("nbr instance:" & Instance_Slot_Type'Image (Info.Nbr_Instances)); when Kind_Object | Kind_Signal | Kind_File - | Kind_Terminal | Kind_Quantity => + | Kind_Terminal | Kind_Quantity | Kind_Environment => Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Image (Info.Obj_Scope)); when Kind_Range => diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads index 7401c606c..a307e5394 100644 --- a/src/vhdl/simulate/annotations.ads +++ b/src/vhdl/simulate/annotations.ads @@ -74,7 +74,8 @@ package Annotations is Kind_Scalar_Type, Kind_File_Type, Kind_Object, Kind_Signal, Kind_Range, Kind_File, - Kind_Terminal, Kind_Quantity); + Kind_Terminal, Kind_Quantity, + Kind_Environment); type Sim_Info_Type (Kind: Sim_Info_Kind); type Sim_Info_Acc is access all Sim_Info_Type; @@ -102,7 +103,8 @@ package Annotations is | Kind_Range | Kind_File | Kind_Terminal - | Kind_Quantity => + | Kind_Quantity + | Kind_Environment => -- Block in which this object is declared in. Obj_Scope : Scope_Type; diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 1ad2e02b5..5c634caf8 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -46,6 +46,13 @@ package body Elaboration is (Instance : Block_Instance_Acc; Decl : Iir) return Iir_Value_Literal_Acc; + procedure Elaborate_Generic_Clause + (Instance : Block_Instance_Acc; Generic_Chain : Iir); + procedure Elaborate_Generic_Map_Aspect + (Target_Instance : Block_Instance_Acc; + Local_Instance : Block_Instance_Acc; + Map : Iir); + -- CONF is the block_configuration for components of ARCH. function Elaborate_Architecture (Arch : Iir_Architecture_Body; Conf : Iir_Block_Configuration; @@ -299,6 +306,12 @@ package body Elaboration is Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl)); end if; + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then + Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Decl)); + Elaborate_Generic_Map_Aspect + (Instance, Instance, Get_Generic_Map_Aspect_Chain (Decl)); + end if; + -- Elaborate objects declarations. Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl)); end Elaborate_Package; @@ -378,6 +391,7 @@ package body Elaboration is Body_Design: Iir_Design_Unit; begin if Package_Instances (Info.Frame_Scope.Pkg_Index) = null + and then not Is_Uninstantiated_Package (Library_Unit) then -- Package not yet elaborated. @@ -408,10 +422,28 @@ package body Elaboration is end if; end if; end; + when Iir_Kind_Package_Instantiation_Declaration => + declare + Info : constant Sim_Info_Acc := Get_Info (Library_Unit); + begin + if Package_Instances (Info.Frame_Scope.Pkg_Index) = null + then + -- Package not yet elaborated. + + -- First the packages on which DESIGN depends. + Elaborate_Dependence (Design); + + -- Then the declaration. + Elaborate_Package (Library_Unit); + end if; + end; when Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Architecture_Body => Elaborate_Dependence (Design); + when Iir_Kind_Package_Body => + -- For package instantiation. + null; when others => Error_Kind ("elaborate_dependence", Library_Unit); end case; @@ -933,7 +965,7 @@ package body Elaboration is end case; end Elaborate_Nature_Definition; - -- LRM93 §12.2.1 The Generic Clause + -- LRM93 12.2.1 The Generic Clause procedure Elaborate_Generic_Clause (Instance : Block_Instance_Acc; Generic_Chain : Iir) is @@ -989,6 +1021,7 @@ package body Elaboration is Value : Iir; Val : Iir_Value_Literal_Acc; Last_Individual : Iir_Value_Literal_Acc; + Marker : Mark_Type; begin -- Elaboration of a generic map aspect consists of elaborating the -- generic association list. @@ -997,6 +1030,7 @@ package body Elaboration is -- elaboration of each generic association element in the -- association list. Assoc := Map; + Mark (Marker, Expr_Pool); while Assoc /= Null_Iir loop -- Elaboration of a generic association element consists of the -- elaboration of the formal part and the evaluation of the actual @@ -1067,6 +1101,7 @@ package body Elaboration is end if; <<Continue>> null; + Release (Marker, Expr_Pool); Assoc := Get_Chain (Assoc); end loop; end Elaborate_Generic_Map_Aspect; @@ -2601,6 +2636,8 @@ package body Elaboration is -- Use a 'fake' process to execute code during elaboration. Current_Process := No_Process; + pragma Assert (Is_Empty (Expr_Pool)); + -- Find architecture and configuration for the top unit case Get_Kind (Unit) is when Iir_Kind_Architecture_Body => @@ -2619,12 +2656,12 @@ package body Elaboration is Arch_Unit := Get_Design_Unit (Arch); Entity := Get_Entity (Arch); + pragma Assert (Is_Empty (Expr_Pool)); + Elaborate_Dependence (Arch_Unit); -- Sanity check: memory area for expressions must be empty. - if not Is_Empty (Expr_Pool) then - raise Internal_Error; - end if; + pragma Assert (Is_Empty (Expr_Pool)); -- Use default values for top entity generics and ports. Generic_Map := Create_Default_Association diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index b299d648e..25774f1e9 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -42,6 +42,7 @@ with Grt_Interface; with Grt.Values; with Grt.Errors; with Grt.Std_Logic_1164; +with Sem_Inst; package body Execution is @@ -3274,9 +3275,15 @@ package body Execution is function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir) return Iir_Value_Literal_Acc is - Subprg_Body : constant Iir := Get_Subprogram_Body (Func); + Subprg_Body : Iir; Res : Iir_Value_Literal_Acc; begin + Subprg_Body := Get_Subprogram_Body (Func); + if Subprg_Body = Null_Iir then + pragma Assert (Sem_Inst.Get_Origin (Func) /= Null_Iir); + Subprg_Body := Get_Subprogram_Body (Sem_Inst.Get_Origin (Func)); + end if; + Current_Process.Instance := Instance; Elaborate_Declarative_Part |