diff options
Diffstat (limited to 'src/vhdl/simulate')
| -rw-r--r-- | src/vhdl/simulate/annotations.adb | 116 | ||||
| -rw-r--r-- | src/vhdl/simulate/annotations.ads | 52 | ||||
| -rw-r--r-- | src/vhdl/simulate/debugger.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 81 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.ads | 6 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 79 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.ads | 8 | ||||
| -rw-r--r-- | src/vhdl/simulate/iir_values.adb | 17 | ||||
| -rw-r--r-- | src/vhdl/simulate/iir_values.ads | 6 |
9 files changed, 252 insertions, 119 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index 17c9e4fd9..b5dcef417 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -39,6 +39,8 @@ package body Annotations is (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); @@ -95,8 +97,9 @@ package body Annotations is Slot => Block_Info.Nbr_Objects); when Kind_Environment => Info := new Sim_Info_Type'(Kind => Kind_Environment, - Obj_Scope => Current_Scope, - Slot => Block_Info.Nbr_Objects); + Env_Slot => Block_Info.Nbr_Objects, + Frame_Scope => Current_Scope, + Nbr_Objects => 0); when Kind_Block | Kind_Process | Kind_Frame @@ -248,10 +251,8 @@ package body Annotations is Prot_Info := new Sim_Info_Type'(Kind => Kind_Frame, - Inst_Slot => Invalid_Instance_Slot, Frame_Scope => Current_Scope, - Nbr_Objects => 0, - Nbr_Instances => 0); + Nbr_Objects => 0); Set_Info (Prot, Prot_Info); Decl := Get_Declaration_Chain (Prot); @@ -449,15 +450,36 @@ package body Annotations is end loop; end Annotate_Interface_List_Subtype; - procedure Annotate_Create_Interface_List + procedure Annotate_Interface_Package_Declaration + (Block_Info: Sim_Info_Acc; Inter : Iir) + is + Prev_Scope : constant Scope_Type := Current_Scope; + Package_Info : Sim_Info_Acc; + begin + Create_Object_Info (Block_Info, Inter, Kind_Environment); + Package_Info := Get_Info (Inter); + + Current_Scope := (Kind => Scope_Kind_Pkg_Inst, + Pkg_Param => 0, + Pkg_Parent => Package_Info); + + Annotate_Interface_List + (Package_Info, Get_Generic_Chain (Inter), True); + Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Inter)); + + Current_Scope := Prev_Scope; + end Annotate_Interface_Package_Declaration; + + procedure Annotate_Interface_List (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean) is Decl : Iir; - N : Object_Slot_Type; begin Decl := Decl_Chain; while Decl /= Null_Iir loop - if With_Types then + 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 @@ -467,18 +489,14 @@ package body Annotations is | 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 others => - Error_Kind ("annotate_create_interface_list", Decl); + Error_Kind ("annotate_interface_list", Decl); end case; - N := Block_Info.Nbr_Objects; - -- Annotation of the default value must not create objects. - -- FIXME: Is it true ??? - if Block_Info.Nbr_Objects /= N then - raise Internal_Error; - end if; Decl := Get_Chain (Decl); end loop; - end Annotate_Create_Interface_List; + end Annotate_Interface_List; procedure Annotate_Subprogram_Interfaces_Type (Block_Info : Sim_Info_Acc; Subprg: Iir) @@ -508,13 +526,11 @@ package body Annotations is Subprg_Info := new Sim_Info_Type'(Kind => Kind_Frame, - Inst_Slot => Invalid_Instance_Slot, Frame_Scope => Current_Scope, - Nbr_Objects => 0, - Nbr_Instances => 0); + Nbr_Objects => 0); Set_Info (Subprg, Subprg_Info); - Annotate_Create_Interface_List (Subprg_Info, Interfaces, False); + Annotate_Interface_List (Subprg_Info, Interfaces, False); Current_Scope := Prev_Scope; end Annotate_Subprogram_Specification; @@ -553,15 +569,15 @@ package body Annotations is begin Current_Scope := (Kind => Scope_Kind_Component); - Info := new Sim_Info_Type'(Kind => Kind_Frame, - Inst_Slot => Invalid_Instance_Slot, + Info := new Sim_Info_Type'(Kind => Kind_Block, Frame_Scope => Current_Scope, + Inst_Slot => Invalid_Instance_Slot, Nbr_Objects => 0, Nbr_Instances => 1); -- For the instance. Set_Info (Comp, Info); - Annotate_Create_Interface_List (Info, Get_Generic_Chain (Comp), True); - Annotate_Create_Interface_List (Info, Get_Port_Chain (Comp), True); + Annotate_Interface_List (Info, Get_Generic_Chain (Comp), True); + Annotate_Interface_List (Info, Get_Port_Chain (Comp), True); Current_Scope := Prev_Scope; end Annotate_Component_Declaration; @@ -676,9 +692,6 @@ 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; @@ -811,10 +824,8 @@ package body Annotations is end if; Header := Get_Block_Header (Block); if Header /= Null_Iir then - Annotate_Create_Interface_List - (Info, Get_Generic_Chain (Header), True); - Annotate_Create_Interface_List - (Info, Get_Port_Chain (Header), True); + 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 @@ -901,10 +912,8 @@ package body Annotations is Increment_Current_Scope; Info := new Sim_Info_Type'(Kind => Kind_Process, - Inst_Slot => Invalid_Instance_Slot, Frame_Scope => Current_Scope, - Nbr_Objects => 0, - Nbr_Instances => 0); + Nbr_Objects => 0); Set_Info (Stmt, Info); Annotate_Declaration_List @@ -964,12 +973,10 @@ package body Annotations is Set_Info (Decl, Entity_Info); -- generic list. - Annotate_Create_Interface_List - (Entity_Info, Get_Generic_Chain (Decl), True); + Annotate_Interface_List (Entity_Info, Get_Generic_Chain (Decl), True); -- Port list. - Annotate_Create_Interface_List - (Entity_Info, Get_Port_Chain (Decl), True); + Annotate_Interface_List (Entity_Info, Get_Port_Chain (Decl), True); -- declarations Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); @@ -989,6 +996,9 @@ package body Annotations is pragma Assert (Current_Scope.Kind = Scope_Kind_None); Current_Scope := Entity_Info.Frame_Scope; + -- No blocks nor instantiation in entities. + pragma Assert (Entity_Info.Nbr_Instances = 0); + Arch_Info := new Sim_Info_Type' (Kind => Kind_Block, Inst_Slot => 0, -- Slot for a component @@ -1017,8 +1027,14 @@ package body Annotations is begin pragma Assert (Current_Scope.Kind = Scope_Kind_None); - Nbr_Packages := Nbr_Packages + 1; - Current_Scope := (Scope_Kind_Package, Nbr_Packages); + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration + or else not Is_Uninstantiated_Package (Decl) + then + Nbr_Packages := Nbr_Packages + 1; + Current_Scope := (Scope_Kind_Package, Nbr_Packages); + else + Increment_Current_Scope; + end if; Package_Info := new Sim_Info_Type' (Kind => Kind_Block, @@ -1030,18 +1046,30 @@ package body Annotations is Set_Info (Decl, Package_Info); if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then - Annotate_Create_Interface_List + Annotate_Interface_List (Package_Info, Get_Generic_Chain (Decl), True); else Header := Get_Package_Header (Decl); if Header /= Null_Iir then - Annotate_Create_Interface_List + 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 + Uninst : constant Iir := + Get_Named_Entity (Get_Uninstantiated_Package_Name (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; + Current_Scope := Prev_Scope; end Annotate_Package; @@ -1173,6 +1201,8 @@ package body Annotations is Annotate_Configuration_Declaration (El); when Iir_Kind_Package_Instantiation_Declaration => Annotate_Package (El); + when Iir_Kind_Context_Declaration => + null; when others => Error_Kind ("annotate2", El); end case; @@ -1190,7 +1220,7 @@ package body Annotations is when Scope_Kind_Package => return "package" & Pkg_Index_Type'Image (Scope.Pkg_Index); when Scope_Kind_Pkg_Inst => - return "pkg inst" & Parameter_Slot_Type'Image (Scope.Pkg_Inst); + return "pkg inst" & Parameter_Slot_Type'Image (Scope.Pkg_Param); end case; end Image; diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads index a307e5394..3c605373a 100644 --- a/src/vhdl/simulate/annotations.ads +++ b/src/vhdl/simulate/annotations.ads @@ -39,6 +39,18 @@ package Annotations is -- Annotations are used to collect informations for elaboration and to -- locate iir_value_literal for signals, variables or constants. + -- The annotation depends on the kind of the node. + type Sim_Info_Kind is + (Kind_Block, Kind_Process, Kind_Frame, + Kind_Scalar_Type, Kind_File_Type, + Kind_Object, Kind_Signal, Kind_Range, + Kind_File, + Kind_Terminal, Kind_Quantity, + Kind_Environment); + + type Sim_Info_Type (Kind: Sim_Info_Kind); + type Sim_Info_Acc is access all Sim_Info_Type; + -- Scope corresponding to an object. type Scope_Kind_Type is ( @@ -59,7 +71,8 @@ package Annotations is when Scope_Kind_Frame => Depth : Scope_Depth_Type; when Scope_Kind_Pkg_Inst => - Pkg_Inst : Parameter_Slot_Type; + Pkg_Param : Parameter_Slot_Type; + Pkg_Parent : Sim_Info_Acc; when Scope_Kind_None => null; end case; @@ -68,43 +81,40 @@ package Annotations is type Instance_Slot_Type is new Integer; Invalid_Instance_Slot : constant Instance_Slot_Type := -1; - -- The annotation depends on the kind of the node. - type Sim_Info_Kind is - (Kind_Block, Kind_Process, Kind_Frame, - Kind_Scalar_Type, Kind_File_Type, - Kind_Object, Kind_Signal, Kind_Range, - Kind_File, - Kind_Terminal, Kind_Quantity, - Kind_Environment); - - 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 case Kind is when Kind_Block | Kind_Frame - | Kind_Process => - -- Slot number in the parent (for blocks). - Inst_Slot : Instance_Slot_Type; - + | Kind_Process + | Kind_Environment => -- Scope level for this frame. Frame_Scope : Scope_Type; -- Number of objects/signals. Nbr_Objects : Object_Slot_Type; - -- Number of children (blocks, generate, instantiation). - Nbr_Instances : Instance_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_Environment => + Env_Slot : Object_Slot_Type; + + when others => + null; + end case; when Kind_Object | Kind_Signal | Kind_Range | Kind_File | Kind_Terminal - | Kind_Quantity - | Kind_Environment => + | Kind_Quantity => -- Block in which this object is declared in. Obj_Scope : Scope_Type; diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index a08f87fcb..9155d8556 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -192,6 +192,9 @@ package body Debugger is | Iir_Kinds_Process_Statement | Iir_Kind_Package_Declaration => return Image_Identifier (Name); + when Iir_Kind_Generate_Statement_Body => + return Image_Identifier (Get_Parent (Name)) + & '(' & Image_Identifier (Name) & ')'; when Iir_Kind_Iterator_Declaration => return Image_Identifier (Get_Parent (Name)) & '(' & Execute_Image_Attribute @@ -248,7 +251,8 @@ package body Debugger is when Iir_Kind_Block_Statement => Put ("[block]"); when Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement => + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body => Put ("[generate]"); when Iir_Kind_Iterator_Declaration => Put ("[iterator]"); diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 5c634caf8..184d187df 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -285,7 +285,7 @@ package body Elaboration is Actuals_Ref => null, Result => null); - if Father /= null then + if Father /= null and then Obj_Info.Kind = Kind_Block then Res.Brother := Father.Children; Father.Children := Res; end if; @@ -314,6 +314,17 @@ package body Elaboration is -- Elaborate objects declarations. Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl)); + + if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then + -- Elaborate the body now. + declare + Uninst : constant Iir := + Get_Named_Entity (Get_Uninstantiated_Package_Name (Decl)); + begin + Elaborate_Declarative_Part + (Instance, Get_Declaration_Chain (Get_Package_Body (Uninst))); + end; + end if; end Elaborate_Package; procedure Elaborate_Package_Body (Decl: Iir) @@ -390,8 +401,9 @@ package body Elaboration is Info : constant Sim_Info_Acc := Get_Info (Library_Unit); Body_Design: Iir_Design_Unit; begin - if Package_Instances (Info.Frame_Scope.Pkg_Index) = null - and then not Is_Uninstantiated_Package (Library_Unit) + if not Is_Uninstantiated_Package (Library_Unit) + and then + Package_Instances (Info.Frame_Scope.Pkg_Index) = null then -- Package not yet elaborated. @@ -443,7 +455,9 @@ package body Elaboration is Elaborate_Dependence (Design); when Iir_Kind_Package_Body => -- For package instantiation. - null; + Elaborate_Dependence (Design); + when Iir_Kind_Context_Declaration => + Elaborate_Dependence (Design); when others => Error_Kind ("elaborate_dependence", Library_Unit); end case; @@ -606,9 +620,8 @@ package body Elaboration is end case; end Init_To_Default; - procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) - is - Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + procedure Create_Object + (Instance : Block_Instance_Acc; Slot : Object_Slot_Type) is begin -- Check elaboration order. -- Note: this is not done for package since objects from package are @@ -623,6 +636,13 @@ package body Elaboration is Instance.Elab_Objects := Slot; end Create_Object; + procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) + is + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + begin + Create_Object (Instance, Slot); + end Create_Object; + procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir) is Info : constant Sim_Info_Acc := Get_Info (Decl); @@ -966,26 +986,37 @@ package body Elaboration is end Elaborate_Nature_Definition; -- LRM93 12.2.1 The Generic Clause + -- LRM08 14.3.2 Generic clause procedure Elaborate_Generic_Clause (Instance : Block_Instance_Acc; Generic_Chain : Iir) is Decl : Iir_Interface_Constant_Declaration; begin + -- LRM08 14.3.2 Generic clause -- Elaboration of a generic clause consists of the elaboration of each -- of the equivalent single generic declarations contained in the -- clause, in the order given. Decl := Generic_Chain; while Decl /= Null_Iir loop - -- The elaboration of a generic declaration consists of elaborating - -- the subtype indication and then creating a generic constant of - -- that subtype. - Elaborate_Subtype_Indication_If_Anonymous (Instance, Get_Type (Decl)); - Create_Object (Instance, Decl); - -- The value of a generic constant is not defined until a subsequent - -- generic map aspect is evaluated, or in the absence of a generic - -- map aspect, until the default expression associated with the - -- generic constant is evaluated to determine the value of the - -- constant. + case Get_Kind (Decl) is + when Iir_Kind_Interface_Constant_Declaration => + -- LRM93 12.2.2 The generic clause + -- The elaboration of a generic declaration consists of + -- elaborating the subtype indication and then creating a + -- generic constant of that subtype. + Elaborate_Subtype_Indication_If_Anonymous + (Instance, Get_Type (Decl)); + Create_Object (Instance, Decl); + -- The value of a generic constant is not defined until a + -- subsequent generic map aspect is evaluated, or in the + -- absence of a generic map aspect, until the default + -- expression associated with the generic constant is evaluated + -- to determine the value of the constant. + when Iir_Kind_Interface_Package_Declaration => + Create_Object (Instance, Get_Info (Decl).Env_Slot); + when others => + Error_Kind ("elaborate_generic_clause", Decl); + end case; Decl := Get_Chain (Decl); end loop; end Elaborate_Generic_Clause; @@ -1065,6 +1096,22 @@ package body Elaboration is Target_Instance.Objects (Get_Info (Inter).Slot) := Last_Individual; goto Continue; + when Iir_Kind_Association_Element_Package => + declare + Actual : constant Iir := + Strip_Denoting_Name (Get_Actual (Assoc)); + Info : constant Sim_Info_Acc := Get_Info (Actual); + Pkg_Block : Block_Instance_Acc; + begin + Pkg_Block := Get_Instance_By_Scope + (Local_Instance, Info.Frame_Scope); + Environment_Table.Append (Pkg_Block); + Val := Create_Environment_Value (Environment_Table.Last); + Target_Instance.Objects (Get_Info (Inter).Env_Slot) := + Unshare (Val, Instance_Pool); + end; + + goto Continue; when others => Error_Kind ("elaborate_generic_map_aspect", Assoc); end case; diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads index d28751f96..dd2da32be 100644 --- a/src/vhdl/simulate/elaboration.ads +++ b/src/vhdl/simulate/elaboration.ads @@ -215,4 +215,10 @@ package Elaboration is Table_Index_Type => Protected_Index_Type, Table_Low_Bound => 1, Table_Initial => 2); + + package Environment_Table is new Tables + (Table_Component_Type => Block_Instance_Acc, + Table_Index_Type => Environment_Index_Type, + Table_Low_Bound => 1, + Table_Initial => 2); end Elaboration; diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 25774f1e9..e2af70587 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -63,19 +63,30 @@ package body Execution is function Get_Instance_By_Scope (Instance: Block_Instance_Acc; Scope: Scope_Type) - return Block_Instance_Acc - is - Current: Block_Instance_Acc := Instance; + return Block_Instance_Acc is begin case Scope.Kind is when Scope_Kind_Frame => - while Current /= null loop - if Current.Block_Scope = Scope then - return Current; + declare + Current : Block_Instance_Acc; + Last : Block_Instance_Acc; + begin + Current := Instance; + while Current /= null loop + if Current.Block_Scope = Scope then + return Current; + end if; + Last := Current; + Current := Current.Up_Block; + end loop; + if Scope.Depth = 0 + and then Last.Block_Scope.Kind = Scope_Kind_Package + then + -- For instantiated packages. + return Last; end if; - Current := Current.Up_Block; - end loop; - raise Internal_Error; + raise Internal_Error; + end; when Scope_Kind_Package => -- Global scope (packages) return Package_Instances (Scope.Pkg_Index); @@ -3223,9 +3234,8 @@ package body Execution is end Execute_Monadic_Association; -- Create a block instance for subprogram IMP. - function Create_Subprogram_Instance (Instance : Block_Instance_Acc; - Imp : Iir) - return Block_Instance_Acc + function Create_Subprogram_Instance + (Instance : Block_Instance_Acc; Imp : Iir) return Block_Instance_Acc is Func_Info : constant Sim_Info_Acc := Get_Info (Imp); @@ -3236,20 +3246,36 @@ package body Execution is Alloc_On_Pool_Addr (Block_Type); Up_Block: Block_Instance_Acc; + Up_Info : Sim_Info_Acc; Res : Block_Instance_Acc; + + Origin : Iir; + Label : Iir; begin pragma Assert (Get_Kind (Imp) in Iir_Kinds_Subprogram_Declaration - or else Get_Kind (Imp) = Iir_Kind_Protected_Type_Body); - Up_Block := Get_Instance_By_Scope - (Instance, Get_Info (Get_Parent (Imp)).Frame_Scope); + or else Get_Kind (Imp) = Iir_Kind_Protected_Type_Body); + + Up_Info := Get_Info (Get_Parent (Imp)); + Up_Block := Get_Instance_By_Scope (Instance, Up_Info.Frame_Scope); + + Origin := Sem_Inst.Get_Origin (Imp); + if Origin /= Null_Iir then + Label := Origin; + if Up_Info.Kind = Kind_Environment then + Up_Block := Environment_Table.Table + (Up_Block.Objects (Up_Info.Env_Slot).Environment); + end if; + else + Label := Imp; + end if; Res := To_Block_Instance_Acc (Alloc_Block_Instance (Instance_Pool, Block_Instance_Type'(Max_Objs => Func_Info.Nbr_Objects, - Block_Scope => Func_Info.Frame_Scope, + Block_Scope => Get_Info (Label).Frame_Scope, Up_Block => Up_Block, - Label => Imp, + Label => Label, Stmt => Null_Iir, Parent => Instance, Children => null, @@ -3272,18 +3298,12 @@ package body Execution is (Instance, Get_Declaration_Chain (Subprg_Body)); end Execute_Subprogram_Call_Final; - function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir) + function Execute_Function_Body (Instance : Block_Instance_Acc) return Iir_Value_Literal_Acc is - Subprg_Body : Iir; + Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label); 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 @@ -3296,7 +3316,8 @@ package body Execution is if Instance.Result = null then Error_Msg_Exec - ("function scope exited without a return statement", Func); + ("function scope exited without a return statement", + Instance.Label); end if; -- Free variables, slots... @@ -3329,7 +3350,7 @@ package body Execution is -- FIXME: implicit conversion Instance.Objects (Get_Info (Inter).Slot) := Val; - Res := Execute_Function_Body (Instance, Func); + Res := Execute_Function_Body (Instance); Res := Unshare (Res, Expr_Pool'Access); Release (Marker, Instance_Pool.all); return Res; @@ -3691,7 +3712,7 @@ package body Execution is if Get_Foreign_Flag (Imp) then Res := Execute_Foreign_Function_Call (Subprg_Block, Expr, Imp); else - Res := Execute_Function_Body (Subprg_Block, Imp); + Res := Execute_Function_Body (Subprg_Block); end if; -- Unfortunately, we don't know where the result has been allocated, @@ -3902,7 +3923,7 @@ package body Execution is Elaboration.Create_Object (Instance, Inter); Instance.Objects (Get_Info (Inter).Slot) := Arr; - return Execute_Function_Body (Instance, Imp); + return Execute_Function_Body (Instance); end Execute_Resolution_Function; procedure Execute_Signal_Assignment diff --git a/src/vhdl/simulate/execution.ads b/src/vhdl/simulate/execution.ads index 033e48854..17d05f4a0 100644 --- a/src/vhdl/simulate/execution.ads +++ b/src/vhdl/simulate/execution.ads @@ -20,6 +20,7 @@ with Types; use Types; with Iirs; use Iirs; with Iir_Values; use Iir_Values; with Elaboration; use Elaboration; +with Annotations; with Areapools; use Areapools; package Execution is @@ -111,6 +112,10 @@ package Execution is function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc) return Iir_Value_Literal_Acc; + function Get_Instance_By_Scope + (Instance: Block_Instance_Acc; Scope: Annotations.Scope_Type) + return Block_Instance_Acc; + function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir) return Block_Instance_Acc; @@ -167,9 +172,6 @@ package Execution is Imp : Iir) return Block_Instance_Acc; - function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir) - return Iir_Value_Literal_Acc; - function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc; Expr_Type : Iir) return String; diff --git a/src/vhdl/simulate/iir_values.adb b/src/vhdl/simulate/iir_values.adb index ab9ad5215..3d308e7f6 100644 --- a/src/vhdl/simulate/iir_values.adb +++ b/src/vhdl/simulate/iir_values.adb @@ -362,6 +362,17 @@ package body Iir_Values is (Kind => Iir_Value_Quantity, Quantity => Quantity))); end Create_Quantity_Value; + function Create_Environment_Value (Env : Environment_Index_Type) + return Iir_Value_Literal_Acc + is + subtype Environment_Value is Iir_Value_Literal (Iir_Value_Environment); + function Alloc is new Alloc_On_Pool_Addr (Environment_Value); + begin + return To_Iir_Value_Literal_Acc + (Alloc (Global_Pool'Access, + (Kind => Iir_Value_Environment, Environment => Env))); + end Create_Environment_Value; + function Create_Protected_Value (Prot : Protected_Index_Type) return Iir_Value_Literal_Acc is @@ -639,9 +650,11 @@ package body Iir_Values is pragma Assert (Src.Sig = null); return Create_Signal_Value (Src.Sig); + when Iir_Value_Environment => + return Create_Environment_Value (Src.Environment); + when Iir_Value_Quantity - | Iir_Value_Terminal - | Iir_Value_Environment => + | Iir_Value_Terminal => raise Internal_Error; end case; end Copy; diff --git a/src/vhdl/simulate/iir_values.ads b/src/vhdl/simulate/iir_values.ads index 92f8cefd4..aeb9b4f49 100644 --- a/src/vhdl/simulate/iir_values.ads +++ b/src/vhdl/simulate/iir_values.ads @@ -202,13 +202,13 @@ package Iir_Values is Instance_Pool : Areapool_Acc; function Create_Signal_Value (Sig : Ghdl_Signal_Ptr) - return Iir_Value_Literal_Acc; - + return Iir_Value_Literal_Acc; function Create_Terminal_Value (Terminal : Terminal_Index_Type) return Iir_Value_Literal_Acc; - function Create_Quantity_Value (Quantity : Quantity_Index_Type) return Iir_Value_Literal_Acc; + function Create_Environment_Value (Env : Environment_Index_Type) + return Iir_Value_Literal_Acc; function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc; |