diff options
Diffstat (limited to 'src/vhdl/simulate')
| -rw-r--r-- | src/vhdl/simulate/annotations.adb | 163 | ||||
| -rw-r--r-- | src/vhdl/simulate/annotations.ads | 43 | ||||
| -rw-r--r-- | src/vhdl/simulate/debugger.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 20 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.ads | 5 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 46 |
6 files changed, 157 insertions, 123 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index bdd9ad8..d36a469 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -24,7 +24,7 @@ with Iirs_Utils; use Iirs_Utils; package body Annotations is -- Current scope level. - Current_Scope_Level: Scope_Level_Type := Scope_Level_Global; + Current_Scope_Level: Scope_Level_Type := (Kind => Scope_Kind_None); procedure Annotate_Declaration_List (Block_Info: Sim_Info_Acc; Decl_Chain: Iir); @@ -45,22 +45,20 @@ package body Annotations is procedure Annotate_Anonymous_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir); - -- Be sure the node contains no informations. - procedure Assert_No_Info (Node: in Iir) is - begin - if Get_Info (Node) /= null then - raise Internal_Error; - end if; - end Assert_No_Info; - procedure Increment_Current_Scope_Level is begin - if Current_Scope_Level < Scope_Level_Global then - -- For a subprogram in a package - Current_Scope_Level := Scope_Level_Global + 1; - else - Current_Scope_Level := Current_Scope_Level + 1; - end if; + case Current_Scope_Level.Kind is + when Scope_Kind_None + | Scope_Kind_Package + | Scope_Kind_Pkg_Inst => + -- For a subprogram in a package + Current_Scope_Level := (Scope_Kind_Frame, Scope_Depth_Type'First); + when Scope_Kind_Frame => + Current_Scope_Level := (Scope_Kind_Frame, + Current_Scope_Level.Depth + 1); + when Scope_Kind_Component => + raise Internal_Error; + end case; end Increment_Current_Scope_Level; -- Add an annotation to object OBJ. @@ -126,7 +124,6 @@ package body Annotations is if Get_Info (Expr) /= null then return; end if; - Assert_No_Info (Expr); -- if Expr = null or else Get_Info (Expr) /= null then -- return; -- end if; @@ -218,6 +215,7 @@ package body Annotations is is Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; Decl : Iir; + Prot_Info: Sim_Info_Acc; begin -- First the interfaces type (they are elaborated in their context). Decl := Get_Declaration_Chain (Prot); @@ -239,6 +237,14 @@ package body Annotations is -- for the protected object. Increment_Current_Scope_Level; + Prot_Info := + new Sim_Info_Type'(Kind => Kind_Frame, + Inst_Slot => 0, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 0); + Set_Info (Prot, Prot_Info); + Decl := Get_Declaration_Chain (Prot); while Decl /= Null_Iir loop case Get_Kind (Decl) is @@ -263,18 +269,11 @@ package body Annotations is Prot_Info: Sim_Info_Acc; Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin - Increment_Current_Scope_Level; - - Assert_No_Info (Prot); - - Prot_Info := - new Sim_Info_Type'(Kind => Kind_Frame, - Inst_Slot => 0, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0); + Prot_Info := Get_Info (Get_Protected_Type_Declaration (Prot)); Set_Info (Prot, Prot_Info); + Current_Scope_Level := Prot_Info.Frame_Scope_Level; + Annotate_Declaration_List (Prot_Info, Get_Declaration_Chain (Prot)); @@ -453,7 +452,6 @@ package body Annotations is if With_Types then Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); end if; - Assert_No_Info (Decl); case Get_Kind (Decl) is when Iir_Kind_Interface_Signal_Declaration => Add_Signal_Info (Block_Info, Decl); @@ -500,8 +498,6 @@ package body Annotations is begin Increment_Current_Scope_Level; - Assert_No_Info (Subprg); - Subprg_Info := new Sim_Info_Type'(Kind => Kind_Frame, Inst_Slot => 0, @@ -528,6 +524,8 @@ package body Annotations is return; end if; + Set_Info (Subprg, Subprg_Info); + Current_Scope_Level := Subprg_Info.Frame_Scope_Level; Annotate_Declaration_List @@ -543,12 +541,9 @@ package body Annotations is (Comp: Iir_Component_Declaration) is Info: Sim_Info_Acc; - Prev_Scope_Level : Scope_Level_Type; + Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin - Prev_Scope_Level := Current_Scope_Level; - Current_Scope_Level := Scope_Level_Component; - - Assert_No_Info (Comp); + Current_Scope_Level := (Kind => Scope_Kind_Component); Info := new Sim_Info_Type'(Kind => Kind_Frame, Inst_Slot => Invalid_Instance_Slot, @@ -571,13 +566,11 @@ package body Annotations is | Iir_Kind_Quiet_Attribute | Iir_Kind_Transaction_Attribute | Iir_Kind_Signal_Declaration => - Assert_No_Info (Decl); Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); Add_Signal_Info (Block_Info, Decl); when Iir_Kind_Variable_Declaration | Iir_Kind_Iterator_Declaration => - Assert_No_Info (Decl); Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); Create_Object_Info (Block_Info, Decl); @@ -587,7 +580,6 @@ package body Annotations is then -- Create the slot only if the constant is not a full constant -- declaration. - Assert_No_Info (Decl); Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); Create_Object_Info (Block_Info, Decl); @@ -596,15 +588,12 @@ package body Annotations is end if; when Iir_Kind_File_Declaration => - Assert_No_Info (Decl); Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); Create_Object_Info (Block_Info, Decl, Kind_File); when Iir_Kind_Terminal_Declaration => - Assert_No_Info (Decl); Add_Terminal_Info (Block_Info, Decl); when Iir_Kinds_Branch_Quantity_Declaration => - Assert_No_Info (Decl); Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); Add_Quantity_Info (Block_Info, Decl); @@ -792,9 +781,8 @@ package body Annotations is Info : Sim_Info_Acc; Header : Iir_Block_Header; Guard : Iir; + Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin - Assert_No_Info (Block); - Increment_Current_Scope_Level; Info := new Sim_Info_Type'(Kind => Kind_Block, @@ -821,16 +809,15 @@ package body Annotations is Annotate_Concurrent_Statements_List (Info, Get_Concurrent_Statement_Chain (Block)); - Current_Scope_Level := Current_Scope_Level - 1; + Current_Scope_Level := Prev_Scope_Level; end Annotate_Block_Statement; procedure Annotate_Generate_Statement_Body (Block_Info : Sim_Info_Acc; Bod : Iir; It : Iir) is Info : Sim_Info_Acc; + Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin - Assert_No_Info (Bod); - Increment_Current_Scope_Level; Info := new Sim_Info_Type'(Kind => Kind_Block, @@ -849,7 +836,7 @@ package body Annotations is Annotate_Concurrent_Statements_List (Info, Get_Concurrent_Statement_Chain (Bod)); - Current_Scope_Level := Current_Scope_Level - 1; + Current_Scope_Level := Prev_Scope_Level; end Annotate_Generate_Statement_Body; procedure Annotate_If_Generate_Statement @@ -878,28 +865,30 @@ package body Annotations is (Block_Info : Sim_Info_Acc; Stmt : Iir) is Info: Sim_Info_Acc; + Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin + Increment_Current_Scope_Level; + -- Add a slot just to put the instance. - Assert_No_Info (Stmt); Info := new Sim_Info_Type'(Kind => Kind_Block, Inst_Slot => Block_Info.Nbr_Instances, - Frame_Scope_Level => Current_Scope_Level + 1, + Frame_Scope_Level => Current_Scope_Level, Nbr_Objects => 0, Nbr_Instances => 1); Set_Info (Stmt, Info); Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + + Current_Scope_Level := Prev_Scope_Level; 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; + Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level; begin Increment_Current_Scope_Level; - -- Add a slot just to put the instance. - Assert_No_Info (Stmt); - Info := new Sim_Info_Type'(Kind => Kind_Process, Inst_Slot => Invalid_Instance_Slot, Frame_Scope_Level => Current_Scope_Level, @@ -912,7 +901,7 @@ package body Annotations is Annotate_Sequential_Statement_Chain (Info, Get_Sequential_Statement_Chain (Stmt)); - Current_Scope_Level := Current_Scope_Level - 1; + Current_Scope_Level := Prev_Scope_Level; end Annotate_Process_Statement; procedure Annotate_Concurrent_Statements_List @@ -948,12 +937,12 @@ package body Annotations is end loop; end Annotate_Concurrent_Statements_List; - procedure Annotate_Entity (Decl: Iir_Entity_Declaration) is + procedure Annotate_Entity (Decl: Iir_Entity_Declaration) + is Entity_Info: Sim_Info_Acc; begin - Assert_No_Info (Decl); - - Current_Scope_Level := Scope_Level_Entity; + pragma Assert (Current_Scope_Level.Kind = Scope_Kind_None); + Increment_Current_Scope_Level; Entity_Info := new Sim_Info_Type'(Kind => Kind_Block, @@ -977,18 +966,17 @@ package body Annotations is -- processes. Annotate_Concurrent_Statements_List (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); + + Current_Scope_Level := (Kind => Scope_Kind_None); end Annotate_Entity; procedure Annotate_Architecture (Decl: Iir_Architecture_Body) is - Entity_Info: Sim_Info_Acc; + Entity_Info : constant Sim_Info_Acc := Get_Info (Get_Entity (Decl)); Arch_Info: Sim_Info_Acc; begin - Assert_No_Info (Decl); - - Current_Scope_Level := Scope_Level_Entity; - - Entity_Info := Get_Info (Get_Entity (Decl)); + pragma Assert (Current_Scope_Level.Kind = Scope_Kind_None); + Current_Scope_Level := Entity_Info.Frame_Scope_Level; Arch_Info := new Sim_Info_Type' (Kind => Kind_Block, @@ -1006,16 +994,18 @@ package body Annotations is -- processes. Annotate_Concurrent_Statements_List (Arch_Info, Get_Concurrent_Statement_Chain (Decl)); + + Current_Scope_Level := (Kind => Scope_Kind_None); end Annotate_Architecture; procedure Annotate_Package (Decl: Iir_Package_Declaration) is Package_Info: Sim_Info_Acc; begin - Assert_No_Info (Decl); + pragma Assert (Current_Scope_Level.Kind = Scope_Kind_None); Nbr_Packages := Nbr_Packages + 1; - Current_Scope_Level := Scope_Level_Type (-Nbr_Packages); + Current_Scope_Level := (Scope_Kind_Package, Nbr_Packages); Package_Info := new Sim_Info_Type' (Kind => Kind_Block, @@ -1029,14 +1019,14 @@ package body Annotations is -- declarations Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); - Current_Scope_Level := Scope_Level_Global; + Current_Scope_Level := (Kind => Scope_Kind_None); end Annotate_Package; procedure Annotate_Package_Body (Decl: Iir) is Package_Info: Sim_Info_Acc; begin - Assert_No_Info (Decl); + pragma Assert (Current_Scope_Level.Kind = Scope_Kind_None); -- Set info field of package body declaration. Package_Info := Get_Info (Get_Package (Decl)); @@ -1046,6 +1036,8 @@ package body Annotations is -- declarations Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); + + Current_Scope_Level := (Kind => Scope_Kind_None); end Annotate_Package_Body; procedure Annotate_Component_Configuration @@ -1063,7 +1055,6 @@ package body Annotations is if Block = Null_Iir then return; end if; - Assert_No_Info (Block); -- Declaration are use_clause only. El := Get_Configuration_Item_Chain (Block); @@ -1085,19 +1076,20 @@ package body Annotations is is Config_Info: Sim_Info_Acc; begin - Assert_No_Info (Decl); + pragma Assert (Current_Scope_Level.Kind = Scope_Kind_None); + Increment_Current_Scope_Level; Config_Info := new Sim_Info_Type' (Kind => Kind_Block, Inst_Slot => Invalid_Instance_Slot, - Frame_Scope_Level => Scope_Level_Global, + Frame_Scope_Level => Current_Scope_Level, Nbr_Objects => 0, Nbr_Instances => 0); - Current_Scope_Level := Scope_Level_Global; - Annotate_Declaration_List (Config_Info, Get_Declaration_Chain (Decl)); Annotate_Block_Configuration (Get_Block_Configuration (Decl)); + + Current_Scope_Level := (Kind => Scope_Kind_None); end Annotate_Configuration_Declaration; package Info_Node is new GNAT.Table @@ -1158,6 +1150,22 @@ package body Annotations is end case; end Annotate; + function Image (Scope : Scope_Level_Type) return String is + begin + case Scope.Kind is + when Scope_Kind_None => + return "none"; + when Scope_Kind_Component => + return "component"; + when Scope_Kind_Frame => + return "frame" & Scope_Depth_Type'Image (Scope.Depth); + 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); + end case; + end Image; + -- Disp annotations for an iir node. procedure Disp_Vhdl_Info (Node: Iir) is use Ada.Text_IO; @@ -1172,8 +1180,7 @@ package body Annotations is ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); when Kind_Frame | Kind_Process => - Put_Line ("-- scope level:" & - Scope_Level_Type'Image (Info.Frame_Scope_Level)); + Put_Line ("-- scope:" & Image (Info.Frame_Scope_Level)); Set_Col (Indent); Put_Line ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); @@ -1181,8 +1188,7 @@ package body Annotations is when Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity => Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot) - & ", scope:" - & Scope_Level_Type'Image (Info.Scope_Level)); + & ", scope:" & Image (Info.Scope_Level)); when Kind_Scalar_Type | Kind_File_Type => null; @@ -1206,8 +1212,7 @@ package body Annotations is end if; case Info.Kind is when Kind_Block | Kind_Frame | Kind_Process => - Put_Line ("scope level:" & - Scope_Level_Type'Image (Info.Frame_Scope_Level)); + Put_Line ("scope:" & Image (Info.Frame_Scope_Level)); Set_Col (Indent); Put_Line ("inst_slot:" & Instance_Slot_Type'Image (Info.Inst_Slot)); @@ -1220,8 +1225,7 @@ package body Annotations is when Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity => Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot) - & ", scope:" - & Scope_Level_Type'Image (Info.Scope_Level)); + & ", scope:" & Image (Info.Scope_Level)); when Kind_Range => Put_Line ("range slot:" & Object_Slot_Type'Image (Info.Slot)); when Kind_Scalar_Type => @@ -1245,6 +1249,7 @@ package body Annotations is 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; diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads index e9b48d0..482edd3 100644 --- a/src/vhdl/simulate/annotations.ads +++ b/src/vhdl/simulate/annotations.ads @@ -30,6 +30,12 @@ package Annotations is procedure Disp_Vhdl_Info (Node: Iir); procedure Disp_Tree_Info (Node: Iir); + type Object_Slot_Type is new Natural; + subtype Parameter_Slot_Type is Object_Slot_Type range 0 .. 2**15; + + type Pkg_Index_Type is new Natural; + Nbr_Packages : Pkg_Index_Type := 0; + -- Annotations are used to collect informations for elaboration and to -- locate iir_value_literal for signals, variables or constants. @@ -46,17 +52,35 @@ package Annotations is -- -- Scope_Level_Component is set to a maximum, since there is at -- most one scope after it (the next one is an entity). - type Scope_Level_Type is new Integer; - Scope_Level_Global: constant Scope_Level_Type := 0; - Scope_Level_Entity: constant Scope_Level_Type := 1; - Scope_Level_Component : constant Scope_Level_Type := - Scope_Level_Type'Last - 1; + type Scope_Level_Kind is + ( + -- For a package, the depth is + Scope_Kind_Package, + Scope_Kind_Component, + Scope_Kind_Frame, + Scope_Kind_Pkg_Inst, + Scope_Kind_None + ); + type Scope_Depth_Type is range 0 .. 2**15; + type Scope_Level_Type (Kind : Scope_Level_Kind := Scope_Kind_None) is + record + case Kind is + when Scope_Kind_Package => + Pkg_Index : Pkg_Index_Type; + when Scope_Kind_Component => + null; + when Scope_Kind_Frame => + Depth : Scope_Depth_Type; + when Scope_Kind_Pkg_Inst => + Pkg_Inst : Parameter_Slot_Type; + when Scope_Kind_None => + null; + end case; + end record; type Instance_Slot_Type is new Integer; Invalid_Instance_Slot : constant Instance_Slot_Type := -1; - type Object_Slot_Type is new Integer; - -- The annotation depends on the kind of the node. type Sim_Info_Kind is (Kind_Block, Kind_Process, Kind_Frame, @@ -106,8 +130,6 @@ package Annotations is end case; end record; - Nbr_Packages : Iir_Index32 := 0; - -- Get/Set annotation fied from/to an iir. procedure Set_Info (Target: Iir; Info: Sim_Info_Acc); pragma Inline (Set_Info); @@ -117,4 +139,7 @@ package Annotations is -- Expand the annotation table. This is automatically done by Annotate, -- to be used only by debugger. procedure Annotate_Expand_Table; + + -- For debugging. + function Image (Scope : Scope_Level_Type) return String; end Annotations; diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index 4bceea9..5966fc3 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -274,8 +274,7 @@ package body Debugger is -- Used to debug. procedure Disp_Block_Instance (Instance: Block_Instance_Acc) is begin - Put_Line ("scope level:" - & Scope_Level_Type'Image (Instance.Scope_Level)); + Put_Line ("scope:" & Image (Instance.Scope_Level)); Put_Line ("Objects:"); for I in Instance.Objects'Range loop Put (Object_Slot_Type'Image (I) & ": "); diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 71e86a0..25bc7ff 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -265,7 +265,7 @@ package body Elaboration is Actuals_Ref => null, Result => null); - Package_Instances (Package_Info.Inst_Slot) := Instance; + Package_Instances (Package_Info.Frame_Scope_Level.Pkg_Index) := Instance; if Trace_Elaboration then Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl)); @@ -280,8 +280,7 @@ package body Elaboration is Package_Info : constant Sim_Info_Acc := Get_Info (Decl); Instance : Block_Instance_Acc; begin - Instance := Package_Instances - (Instance_Slot_Type (-Package_Info.Frame_Scope_Level)); + Instance := Package_Instances (Package_Info.Frame_Scope_Level.Pkg_Index); if Trace_Elaboration then Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl)); @@ -323,7 +322,9 @@ package body Elaboration is Info : constant Sim_Info_Acc := Get_Info (Library_Unit); Body_Design: Iir_Design_Unit; begin - if Package_Instances (Info.Inst_Slot) = null then + if Package_Instances (Info.Frame_Scope_Level.Pkg_Index) + = null + then -- Package not yet elaborated. -- Load the body now, as it can add objects in the @@ -1100,8 +1101,6 @@ package body Elaboration is return; end if; - Current_Component := Formal_Instance; - Assoc := Map; while Assoc /= Null_Iir loop -- Elaboration of a port association list consists of the elaboration @@ -1188,8 +1187,6 @@ package body Elaboration is end case; Assoc := Get_Chain (Assoc); end loop; - - Current_Component := null; end Elaborate_Port_Map_Aspect; -- LRM93 §12.2 Elaboration of a block header @@ -1413,6 +1410,7 @@ package body Elaboration is -- component instance and [...] Frame := Create_Block_Instance (Instance, Component, Stmt); + Current_Component := Frame; Elaborate_Generic_Clause (Frame, Get_Generic_Chain (Component)); Elaborate_Generic_Map_Aspect (Frame, Instance, Get_Generic_Map_Aspect_Chain (Stmt)); @@ -1420,6 +1418,7 @@ package body Elaboration is Elaborate_Port_Map_Aspect (Frame, Instance, Get_Port_Chain (Component), Get_Port_Map_Aspect_Chain (Stmt)); + Current_Component := null; end; else -- Direct instantiation @@ -2478,11 +2477,13 @@ package body Elaboration is -- block. Elaborate_Dependence (Get_Design_Unit (Arch)); + Current_Component := Parent_Instance; Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Entity)); Elaborate_Generic_Map_Aspect (Instance, Parent_Instance, Generic_Map); Elaborate_Port_Clause (Instance, Get_Port_Chain (Entity)); Elaborate_Port_Map_Aspect (Instance, Parent_Instance, Get_Port_Chain (Entity), Port_Map); + Current_Component := null; Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Entity)); @@ -2512,8 +2513,7 @@ package body Elaboration is Generic_Map : Iir; Port_Map : Iir; begin - Package_Instances := - new Block_Instance_Acc_Array (1 .. Instance_Slot_Type (Nbr_Packages)); + Package_Instances := new Package_Instances_Array (1 .. Nbr_Packages); -- Use a 'fake' process to execute code during elaboration. Current_Process := No_Process; diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads index 5a9ea8d..8d6afc8 100644 --- a/src/vhdl/simulate/elaboration.ads +++ b/src/vhdl/simulate/elaboration.ads @@ -128,7 +128,10 @@ package Elaboration is Block_Instance_Acc; type Block_Instance_Acc_Array_Acc is access Block_Instance_Acc_Array; - Package_Instances : Block_Instance_Acc_Array_Acc; + type Package_Instances_Array is array (Pkg_Index_Type range <>) of + Block_Instance_Acc; + type Package_Instances_Array_Acc is access Package_Instances_Array; + Package_Instances : Package_Instances_Array_Acc; -- Disconnections. For each disconnection specification, the elaborator -- adds an entry in the table. diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 2321fa2..85a2d55 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -66,30 +66,30 @@ package body Execution is is Current: Block_Instance_Acc := Instance; begin - while Current /= null loop - if Current.Scope_Level = Scope_Level then - return Current; - end if; - Current := Current.Up_Block; - end loop; - -- Global scope (packages) - if Scope_Level < Scope_Level_Global then - return Package_Instances (Instance_Slot_Type (-Scope_Level)); - end if; - if Current_Component /= null - and then Current_Component.Scope_Level = Scope_Level - then - return Current_Component; - end if; - if Scope_Level = Scope_Level_Global then - return null; - end if; - raise Internal_Error; + case Scope_Level.Kind is + when Scope_Kind_Frame => + while Current /= null loop + if Current.Scope_Level = Scope_Level then + return Current; + end if; + Current := Current.Up_Block; + end loop; + raise Internal_Error; + when Scope_Kind_Package => + -- Global scope (packages) + return Package_Instances (Scope_Level.Pkg_Index); + when Scope_Kind_Component => + pragma Assert (Current_Component /= null); + return Current_Component; + when Scope_Kind_None => + raise Internal_Error; + when Scope_Kind_Pkg_Inst => + raise Internal_Error; + end case; end Get_Instance_By_Scope_Level; function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir) - return Block_Instance_Acc - is + return Block_Instance_Acc is begin return Get_Instance_By_Scope_Level (Instance, Get_Info (Decl).Scope_Level); @@ -3223,8 +3223,10 @@ package body Execution is Up_Block: Block_Instance_Acc; Res : Block_Instance_Acc; 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_Level - (Instance, Func_Info.Frame_Scope_Level - 1); + (Instance, Get_Info (Get_Parent (Imp)).Frame_Scope_Level); Res := To_Block_Instance_Acc (Alloc_Block_Instance |