diff options
| -rw-r--r-- | src/vhdl/canon.adb | 151 | ||||
| -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 |
10 files changed, 358 insertions, 164 deletions
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 0e907835a..40af63e34 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -1026,7 +1026,7 @@ package body Canon is -- Create simple variable assignment. Asgn := Create_Iir (Iir_Kind_Variable_Assignment_Statement); Location_Copy (Asgn, Cond_Expr); - Set_Parent (Asgn, El); + Set_Parent (Asgn, Res); Set_Target (Asgn, Target); Expr := Get_Expression (Cond_Expr); if Canon_Flag_Expressions then @@ -1058,27 +1058,36 @@ package body Canon is -- Inner loop if any; used to canonicalize exit/next statement. Cur_Loop : Iir; - procedure Canon_Sequential_Stmts (First : Iir) + function Canon_Sequential_Stmts (First : Iir) return Iir is Stmt: Iir; - Expr: Iir; - Prev_Loop : Iir; + N_Stmt : Iir; + Res, Last : Iir; begin + Sub_Chain_Init (Res, Last); + Stmt := First; while Stmt /= Null_Iir loop + + -- Keep the same statement by default. + N_Stmt := Stmt; + case Get_Kind (Stmt) is when Iir_Kind_If_Statement => declare Cond: Iir; - Clause: Iir := Stmt; + Clause: Iir; + Stmts : Iir; begin + Clause := Stmt; while Clause /= Null_Iir loop Cond := Get_Condition (Clause); if Cond /= Null_Iir then Canon_Expression (Cond); end if; - Canon_Sequential_Stmts - (Get_Sequential_Statement_Chain (Clause)); + Stmts := Get_Sequential_Statement_Chain (Clause); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Sequential_Statement_Chain (Clause, Stmts); Clause := Get_Else_Clause (Clause); end loop; end; @@ -1087,10 +1096,17 @@ package body Canon is Canon_Expression (Get_Target (Stmt)); Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List); + when Iir_Kind_Conditional_Signal_Assignment_Statement => + N_Stmt := Canon_Conditional_Signal_Assignment_Statement (Stmt); + when Iir_Kind_Variable_Assignment_Statement => Canon_Expression (Get_Target (Stmt)); Canon_Expression (Get_Expression (Stmt)); + when Iir_Kind_Conditional_Variable_Assignment_Statement => + N_Stmt := + Canon_Conditional_Variable_Assignment_Statement (Stmt); + when Iir_Kind_Wait_Statement => declare Expr: Iir; @@ -1116,54 +1132,76 @@ package body Canon is Canon_Expression (Get_Expression (Stmt)); declare Choice: Iir; + Stmts : Iir; begin Choice := Get_Case_Statement_Alternative_Chain (Stmt); while Choice /= Null_Iir loop -- FIXME: canon choice expr. - Canon_Sequential_Stmts (Get_Associated_Chain (Choice)); + Stmts := Get_Associated_Chain (Choice); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Associated_Chain (Choice, Stmts); Choice := Get_Chain (Choice); end loop; end; when Iir_Kind_Assertion_Statement | Iir_Kind_Report_Statement => - if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then - Canon_Expression (Get_Assertion_Condition (Stmt)); - end if; - Expr := Get_Report_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Expr := Get_Severity_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; + declare + Expr: Iir; + begin + if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then + Canon_Expression (Get_Assertion_Condition (Stmt)); + end if; + Expr := Get_Report_Expression (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Expr := Get_Severity_Expression (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + end; when Iir_Kind_For_Loop_Statement => - -- FIXME: decl. - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - if Canon_Flag_Expressions then - Canon_Discrete_Range - (Get_Type (Get_Parameter_Specification (Stmt))); - end if; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; + declare + Prev_Loop : constant Iir := Cur_Loop; + Stmts : Iir; + begin + -- FIXME: decl. + Cur_Loop := Stmt; + if Canon_Flag_Expressions then + Canon_Discrete_Range + (Get_Type (Get_Parameter_Specification (Stmt))); + end if; + Stmts := Get_Sequential_Statement_Chain (Stmt); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Sequential_Statement_Chain (Stmt, Stmts); + Cur_Loop := Prev_Loop; + end; when Iir_Kind_While_Loop_Statement => - Expr := Get_Condition (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; + declare + Expr : Iir; + Stmts : Iir; + Prev_Loop : Iir; + begin + Expr := Get_Condition (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Prev_Loop := Cur_Loop; + Cur_Loop := Stmt; + Stmts := Get_Sequential_Statement_Chain (Stmt); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Sequential_Statement_Chain (Stmt, Stmts); + Cur_Loop := Prev_Loop; + end; when Iir_Kind_Next_Statement | Iir_Kind_Exit_Statement => declare Loop_Label : Iir; + Expr: Iir; begin Expr := Get_Condition (Stmt); if Expr /= Null_Iir then @@ -1187,8 +1225,13 @@ package body Canon is when others => Error_Kind ("canon_sequential_stmts", Stmt); end case; + + Sub_Chain_Append (Res, Last, N_Stmt); + Stmt := Get_Chain (Stmt); end loop; + + return Res; end Canon_Sequential_Stmts; -- Create a statement transform from concurrent_signal_assignment @@ -1456,12 +1499,23 @@ package body Canon is while Cond_Wf /= Null_Iir loop Expr := Get_Condition (Cond_Wf); + + -- Canon waveform. Wf := Get_Waveform_Chain (Cond_Wf); Wf := Canon_Wave_Transform (Conc_Stmt, Wf, Proc); - Set_Parent (Wf, Parent); + if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then + -- A conditional assignment that is in fact a simple one. Usual + -- case for concurrent signal assignment in vhdl 93. + pragma Assert (Get_Chain (Cond_Wf) = Null_Iir); + + Set_Parent (Wf, Parent); Res1 := Wf; + Stmt := Res1; else + -- A real conditional signal assignment. + + -- Canon condition (if any). if Expr /= Null_Iir then if Canon_Flag_Expressions then Canon_Expression (Expr); @@ -1474,19 +1528,17 @@ package body Canon is if Stmt = Null_Iir then Res1 := Create_Iir (Iir_Kind_If_Statement); Set_Parent (Res1, Parent); + Stmt := Res1; else Res1 := Create_Iir (Iir_Kind_Elsif); + Set_Else_Clause (Last_Res, Res1); end if; Location_Copy (Res1, Cond_Wf); Set_Condition (Res1, Expr); Set_Sequential_Statement_Chain (Res1, Wf); + Set_Parent (Wf, Stmt); + Last_Res := Res1; end if; - if Stmt = Null_Iir then - Stmt := Res1; - else - Set_Else_Clause (Last_Res, Res1); - end if; - Last_Res := Res1; Cond_Wf := Get_Chain (Cond_Wf); end loop; return Stmt; @@ -1679,7 +1731,13 @@ package body Canon is | Iir_Kind_Process_Statement => Canon_Declarations (Top, El, Null_Iir); if Canon_Flag_Sequentials_Stmts then - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El)); + declare + Stmts : Iir; + begin + Stmts := Get_Sequential_Statement_Chain (El); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Sequential_Statement_Chain (El, Stmts); + end; end if; if Canon_Flag_All_Sensitivity and then Canon_Flag_Sequentials_Stmts @@ -2357,13 +2415,16 @@ package body Canon is Parent : Iir; Decl_Parent : Iir) is + Stmts : Iir; begin case Get_Kind (Decl) is when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => Canon_Declarations (Top, Decl, Null_Iir); if Canon_Flag_Sequentials_Stmts then - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl)); + Stmts := Get_Sequential_Statement_Chain (Decl); + Stmts := Canon_Sequential_Stmts (Stmts); + Set_Sequential_Statement_Chain (Decl, Stmts); end if; when Iir_Kind_Procedure_Declaration 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; |