diff options
| -rw-r--r-- | simulate/annotations.adb | 159 | ||||
| -rw-r--r-- | simulate/annotations.ads | 22 | ||||
| -rw-r--r-- | simulate/debugger.adb | 378 | ||||
| -rw-r--r-- | simulate/debugger.ads | 5 | ||||
| -rw-r--r-- | simulate/elaboration.adb | 484 | ||||
| -rw-r--r-- | simulate/elaboration.ads | 42 | ||||
| -rw-r--r-- | simulate/execution.adb | 219 | ||||
| -rw-r--r-- | simulate/execution.ads | 3 | ||||
| -rw-r--r-- | simulate/iir_values.adb | 2 | ||||
| -rw-r--r-- | simulate/simulation.adb | 107 |
10 files changed, 851 insertions, 570 deletions
diff --git a/simulate/annotations.adb b/simulate/annotations.adb index 66435d7..1b241d2 100644 --- a/simulate/annotations.adb +++ b/simulate/annotations.adb @@ -267,13 +267,12 @@ package body Annotations is 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, - Elaborated => False); + 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); Annotate_Declaration_List @@ -442,7 +441,7 @@ package body Annotations is (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean) is Decl : Iir; - N : Iir_Index32; + N : Object_Slot_Type; begin Decl := Decl_Chain; while Decl /= Null_Iir loop @@ -498,13 +497,12 @@ package body Annotations is Assert_No_Info (Subprg); - Subprg_Info := new Sim_Info_Type' - (Kind => Kind_Frame, - Inst_Slot => 0, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Subprg_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 (Subprg, Subprg_Info); Annotate_Create_Interface_List (Subprg_Info, Interfaces, False); @@ -547,13 +545,11 @@ package body Annotations is Assert_No_Info (Comp); - Info := new Sim_Info_Type' - (Kind => Kind_Frame, - Inst_Slot => Invalid_Slot, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 1, -- For the instance. - Elaborated => False); + Info := new Sim_Info_Type'(Kind => Kind_Frame, + Inst_Slot => Invalid_Instance_Slot, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 1); -- For the instance. Set_Info (Comp, Info); Annotate_Create_Interface_List (Info, Get_Generic_Chain (Comp), True); @@ -699,8 +695,8 @@ package body Annotations is (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir) is El: Iir; - Max_Nbr_Objects : Iir_Index32; - Current_Nbr_Objects : Iir_Index32; + Max_Nbr_Objects : Object_Slot_Type; + Current_Nbr_Objects : Object_Slot_Type; begin Current_Nbr_Objects := Block_Info.Nbr_Objects; Max_Nbr_Objects := Block_Info.Nbr_Objects; @@ -765,7 +761,7 @@ package body Annotations is -- other (ie following) loop statements. -- Furthermore, this allow to correctly check elaboration -- order. - Max_Nbr_Objects := Iir_Index32'Max + Max_Nbr_Objects := Object_Slot_Type'Max (Block_Info.Nbr_Objects, Max_Nbr_Objects); Block_Info.Nbr_Objects := Current_Nbr_Objects; El := Get_Chain (El); @@ -784,13 +780,11 @@ package body Annotations is Increment_Current_Scope_Level; - Info := new Sim_Info_Type' - (Kind => Kind_Block, - Inst_Slot => Block_Info.Nbr_Instances, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Info := new Sim_Info_Type'(Kind => Kind_Block, + Inst_Slot => Block_Info.Nbr_Instances, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 0); Set_Info (Block, Info); Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; @@ -825,13 +819,11 @@ package body Annotations is Increment_Current_Scope_Level; - Info := new Sim_Info_Type' - (Kind => Kind_Block, - Inst_Slot => Block_Info.Nbr_Instances, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Info := new Sim_Info_Type'(Kind => Kind_Block, + Inst_Slot => Block_Info.Nbr_Instances, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 0); Set_Info (Stmt, Info); Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; @@ -853,20 +845,18 @@ package body Annotations is begin -- 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, - Nbr_Objects => 0, - Nbr_Instances => 1, - Elaborated => False); + Info := new Sim_Info_Type'(Kind => Kind_Block, + Inst_Slot => Block_Info.Nbr_Instances, + Frame_Scope_Level => Current_Scope_Level + 1, + 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) + procedure Annotate_Process_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) is + pragma Unreferenced (Block_Info); Info: Sim_Info_Acc; begin Increment_Current_Scope_Level; @@ -874,17 +864,13 @@ package body Annotations is -- Add a slot just to put the instance. Assert_No_Info (Stmt); - Info := new Sim_Info_Type' - (Kind => Kind_Process, - Inst_Slot => Block_Info.Nbr_Instances, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Info := new Sim_Info_Type'(Kind => Kind_Process, + Inst_Slot => Invalid_Instance_Slot, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 0); Set_Info (Stmt, Info); - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; - Annotate_Declaration_List (Info, Get_Declaration_Chain (Stmt)); Annotate_Sequential_Statement_Chain @@ -931,13 +917,12 @@ package body Annotations is Current_Scope_Level := Scope_Level_Entity; - Entity_Info := new Sim_Info_Type' - (Kind => Kind_Block, - Inst_Slot => Invalid_Slot, - Frame_Scope_Level => Current_Scope_Level, - Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Entity_Info := + new Sim_Info_Type'(Kind => Kind_Block, + Inst_Slot => Invalid_Instance_Slot, + Frame_Scope_Level => Current_Scope_Level, + Nbr_Objects => 0, + Nbr_Instances => 0); Set_Info (Decl, Entity_Info); -- generic list. @@ -971,8 +956,7 @@ package body Annotations is Inst_Slot => 0, -- Slot for a component Frame_Scope_Level => Current_Scope_Level, Nbr_Objects => Entity_Info.Nbr_Objects, - Nbr_Instances => Entity_Info.Nbr_Instances, -- Should be 0. - Elaborated => False); + Nbr_Instances => Entity_Info.Nbr_Instances); -- Should be 0. Set_Info (Decl, Arch_Info); -- FIXME: annotate the default configuration for the arch ? @@ -995,11 +979,10 @@ package body Annotations is Package_Info := new Sim_Info_Type' (Kind => Kind_Block, - Inst_Slot => Nbr_Packages, + Inst_Slot => Instance_Slot_Type (Nbr_Packages), Frame_Scope_Level => Current_Scope_Level, Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Nbr_Instances => 0); Set_Info (Decl, Package_Info); @@ -1066,11 +1049,10 @@ package body Annotations is Config_Info := new Sim_Info_Type' (Kind => Kind_Block, - Inst_Slot => Invalid_Slot, + Inst_Slot => Invalid_Instance_Slot, Frame_Scope_Level => Scope_Level_Global, Nbr_Objects => 0, - Nbr_Instances => 0, - Elaborated => False); + Nbr_Instances => 0); Current_Scope_Level := Scope_Level_Global; @@ -1085,18 +1067,25 @@ package body Annotations is Table_Initial => 1024, Table_Increment => 100); - -- Decorate the tree in order to be usable with the internal simulator. - procedure Annotate (Tree: Iir_Design_Unit) + procedure Annotate_Expand_Table is El: Iir; begin - -- Expand info table. 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 (Tree: Iir_Design_Unit) + is + El: Iir; + begin + -- Expand info table. + Annotate_Expand_Table; El := Get_Library_Unit (Tree); if Trace_Annotation then @@ -1140,18 +1129,18 @@ package body Annotations is case Info.Kind is when Kind_Block => Put_Line - ("-- nbr objects:" & Iir_Index32'Image (Info.Nbr_Objects)); + ("-- 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)); Set_Col (Indent); Put_Line - ("-- nbr objects:" & Iir_Index32'Image (Info.Nbr_Objects)); + ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); when Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity => - Put_Line ("-- slot:" & Iir_Index32'Image (Info.Slot) + Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Scope_Level_Type'Image (Info.Scope_Level)); when Kind_Scalar_Type @@ -1159,7 +1148,7 @@ package body Annotations is null; when Kind_Range => Put ("${"); - Put (Iir_Index32'Image (Info.Slot)); + Put (Object_Slot_Type'Image (Info.Slot)); Put ("}"); end case; end Disp_Vhdl_Info; @@ -1180,19 +1169,21 @@ package body Annotations is Put_Line ("scope level:" & Scope_Level_Type'Image (Info.Frame_Scope_Level)); Set_Col (Indent); - Put_Line ("inst_slot:" & Iir_Index32'Image (Info.Inst_Slot)); + Put_Line ("inst_slot:" + & Instance_Slot_Type'Image (Info.Inst_Slot)); Set_Col (Indent); - Put_Line ("nbr objects:" & Iir_Index32'Image (Info.Nbr_Objects)); + Put_Line ("nbr objects:" + & Object_Slot_Type'Image (Info.Nbr_Objects)); Set_Col (Indent); Put_Line ("nbr instance:" - & Iir_Index32'Image (Info.Nbr_Instances)); + & Instance_Slot_Type'Image (Info.Nbr_Instances)); when Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity => - Put_Line ("slot:" & Iir_Index32'Image (Info.Slot) + Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Scope_Level_Type'Image (Info.Scope_Level)); when Kind_Range => - Put_Line ("range slot:" & Iir_Index32'Image (Info.Slot)); + Put_Line ("range slot:" & Object_Slot_Type'Image (Info.Slot)); when Kind_Scalar_Type => Put_Line ("scalar type: " & Iir_Value_Kind'Image (Info.Scalar_Mode)); diff --git a/simulate/annotations.ads b/simulate/annotations.ads index cf650c9..e9b48d0 100644 --- a/simulate/annotations.ads +++ b/simulate/annotations.ads @@ -52,7 +52,10 @@ package Annotations is Scope_Level_Component : constant Scope_Level_Type := Scope_Level_Type'Last - 1; - Invalid_Slot : constant Iir_Index32 := Iir_Index32'Last; + 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 @@ -71,19 +74,17 @@ package Annotations is when Kind_Block | Kind_Frame | Kind_Process => - -- Only for packages: true if elaborated. - Elaborated: Boolean; - -- Slot number. - Inst_Slot : Iir_Index32; + Inst_Slot : Instance_Slot_Type; -- scope level for this frame. Frame_Scope_Level: Scope_Level_Type; -- Number of objects/signals. - Nbr_Objects: Iir_Index32; + Nbr_Objects : Object_Slot_Type; - Nbr_Instances : Iir_Index32; + -- Number of children (blocks, generate, instantiation). + Nbr_Instances : Instance_Slot_Type; when Kind_Object | Kind_Signal @@ -95,7 +96,7 @@ package Annotations is Scope_Level: Scope_Level_Type; -- Variable index. - Slot: Iir_Index32; + Slot: Object_Slot_Type; when Kind_Scalar_Type => Scalar_Mode : Iir_Value_Kind; @@ -106,11 +107,14 @@ package Annotations is end record; Nbr_Packages : Iir_Index32 := 0; - -- Packages_Last_Info: Sim_Info_Acc := null; -- 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 Annotations; diff --git a/simulate/debugger.adb b/simulate/debugger.adb index f669b09..b20c4e7 100644 --- a/simulate/debugger.adb +++ b/simulate/debugger.adb @@ -134,29 +134,35 @@ package body Debugger is function Get_Instance_Local_Name (Instance : Block_Instance_Acc; Short : Boolean := False) - return String is + return String + is + Name : constant Iir := Instance.Label; begin - if Instance.Name = Null_Iir then + if Name = Null_Iir then return "<anon>"; end if; - case Get_Kind (Instance.Name) is + case Get_Kind (Name) is when Iir_Kind_Block_Statement | Iir_Kind_Generate_Statement - | Iir_Kind_Iterator_Declaration | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Procedure_Declaration | Iir_Kinds_Process_Statement => - return Image_Identifier (Instance.Name); + return Image_Identifier (Name); + when Iir_Kind_Iterator_Declaration => + return Image_Identifier (Get_Parent (Name)) & '(' + & Execute_Image_Attribute + (Instance.Objects (Get_Info (Name).Slot), Get_Type (Name)) + & ')'; when Iir_Kind_Architecture_Declaration => if Short then - return Image_Identifier (Get_Entity (Instance.Name)); + return Image_Identifier (Get_Entity (Name)); else - return Image_Identifier (Get_Entity (Instance.Name)) - & '(' & Image_Identifier (Instance.Name) & ')'; + return Image_Identifier (Get_Entity (Name)) + & '(' & Image_Identifier (Name) & ')'; end if; when others => - Error_Kind ("disp_instance_local_name", Instance.Name); + Error_Kind ("disp_instance_local_name", Name); end case; end Get_Instance_Local_Name; @@ -185,30 +191,9 @@ package body Debugger is return Parent_Name & Get_Instance_Local_Name (Instance); end Get_Instance_Name; - procedure Disp_All_Instances1 (Inst : Block_Instance_Acc) is + procedure Disp_Instances_Tree_Name (Inst : Block_Instance_Acc) is begin if Inst = null then - return; - end if; - Put (Get_Instance_Local_Name (Inst)); - New_Line; - - if Inst.Instances /= null then - for I in Inst.Instances'Range loop - Disp_All_Instances1 (Inst.Instances (I)); - end loop; - end if; - end Disp_All_Instances1; - - procedure Disp_All_Instances is - begin - Disp_All_Instances1 (Top_Instance); - end Disp_All_Instances; - - procedure Disp_Instances_Tree1 (Inst : Block_Instance_Acc; Pfx : String) is - begin - Put (Pfx); - if Inst = null then Put ("*null*"); New_Line; return; @@ -216,7 +201,7 @@ package body Debugger is Put (Get_Instance_Local_Name (Inst)); Put (" "); - case Get_Kind (Inst.Name) is + case Get_Kind (Inst.Label) is when Iir_Kind_Block_Statement => Put ("[block]"); when Iir_Kind_Generate_Statement => @@ -230,20 +215,40 @@ package body Debugger is when Iir_Kind_Architecture_Declaration => Put ("[entity]"); when others => - Error_Kind ("disp_instances_tree1", Inst.Name); + Error_Kind ("disp_instances_tree1", Inst.Label); end case; New_Line; + end Disp_Instances_Tree_Name; - if Inst.Instances /= null then - for I in Inst.Instances'Range loop - Disp_Instances_Tree1 - (Inst.Instances (I), Pfx & Iir_Index32'Image (I) & ": "); - end loop; + procedure Disp_Instances_Tree1 (Inst : Block_Instance_Acc; Pfx : String) + is + Child : Block_Instance_Acc; + begin + Child := Inst.Children; + if Child = null then + return; end if; + + loop + if Child.Brother /= null then + Put (Pfx & "+-"); + Disp_Instances_Tree_Name (Child); + + Disp_Instances_Tree1 (Child, Pfx & "| "); + Child := Child.Brother; + else + Put (Pfx & "`-"); + Disp_Instances_Tree_Name (Child); + + Disp_Instances_Tree1 (Child, Pfx & " "); + exit; + end if; + end loop; end Disp_Instances_Tree1; procedure Disp_Instances_Tree is begin + Disp_Instances_Tree_Name (Top_Instance); Disp_Instances_Tree1 (Top_Instance, ""); end Disp_Instances_Tree; @@ -255,7 +260,7 @@ package body Debugger is & Scope_Level_Type'Image (Instance.Scope_Level)); Put_Line ("Objects:"); for I in Instance.Objects'Range loop - Put (Iir_Index32'Image (I) & ": "); + Put (Object_Slot_Type'Image (I) & ": "); Disp_Value_Tab (Instance.Objects (I), 3); New_Line; end loop; @@ -316,7 +321,6 @@ package body Debugger is | Iir_Value_B2 | Iir_Value_Access => Disp_Iir_Value (Value, A_Type); - --Disp_Signal_Status (Signals.Table (Indirect.Index), Status); when Iir_Value_Array => Disp_Signal_Array (Value, A_Type, 1); when Iir_Value_Record => @@ -338,48 +342,76 @@ package body Debugger is is Info : constant Sim_Info_Acc := Get_Info (Decl); begin + Put (" "); Put (Name_Table.Image (Get_Identifier (Decl))); Put (" = "); Disp_Signal (Instance.Objects (Info.Slot), Get_Type (Decl)); - New_Line; end Disp_Instance_Signal; + procedure Disp_Instance_Signals_Of_Chain (Instance: Block_Instance_Acc; + Chain : Iir) + is + El : Iir; + begin + El := Chain; + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + Disp_Instance_Signal (Instance, El); + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end Disp_Instance_Signals_Of_Chain; + procedure Disp_Instance_Signals (Instance: Block_Instance_Acc) is - Blk : constant Iir := Instance.Name; + Blk : constant Iir := Instance.Label; Child: Block_Instance_Acc; begin case Get_Kind (Blk) is when Iir_Kind_Architecture_Declaration => declare Ent : constant Iir := Get_Entity (Blk); - El : Iir; begin - El := Get_Port_Chain (Ent); - while El /= Null_Iir loop - Disp_Instance_Signal (Instance, El); - El := Get_Chain (El); - end loop; - - El := Get_Declaration_Chain (Blk); - while El /= Null_Iir loop - if Get_Kind (El) = Iir_Kind_Signal_Declaration then - Disp_Instance_Signal (Instance, El); - end if; - El := Get_Chain (El); - end loop; + Disp_Instance_Name (Instance); + Put_Line (" [architecture]:"); + + Disp_Instance_Signals_Of_Chain + (Instance, Get_Port_Chain (Ent)); + Disp_Instance_Signals_Of_Chain + (Instance, Get_Declaration_Chain (Ent)); end; + when Iir_Kind_Block_Statement => + Disp_Instance_Name (Instance); + Put_Line (" [block]:"); + + -- FIXME: ports. + Disp_Instance_Signals_Of_Chain + (Instance, Get_Declaration_Chain (Blk)); + when Iir_Kind_Generate_Statement => + Disp_Instance_Name (Instance); + Put_Line (" [generate]:"); + + Disp_Instance_Signals_Of_Chain + (Instance, Get_Declaration_Chain (Blk)); + when Iir_Kind_Component_Instantiation_Statement => + null; + when Iir_Kinds_Process_Statement => + null; + when Iir_Kind_Iterator_Declaration => + null; when others => - Error_Kind ("disp_instance_signals", Instance.Name); + Error_Kind ("disp_instance_signals", Instance.Label); end case; - if Trace_All_Signals then - Child := Instance.Children; - while Child /= null loop - Disp_Instance_Signals (Child); - Child := Child.Brother; - end loop; - end if; + Child := Instance.Children; + while Child /= null loop + Disp_Instance_Signals (Child); + Child := Child.Brother; + end loop; end Disp_Instance_Signals; -- Disp all signals name and values. @@ -464,7 +496,7 @@ package body Debugger is procedure Disp_Objects (Instance : Block_Instance_Acc) is - Decl : constant Iir := Instance.Name; + Decl : constant Iir := Instance.Label; begin Disp_Instance_Name (Instance); New_Line; @@ -498,6 +530,138 @@ package body Debugger is end Disp_Objects; pragma Unreferenced (Disp_Objects); + procedure Disp_Process_Stats + is + Proc : Iir; + Stmt : Iir; + Nbr_User_Sensitized_Processes : Natural := 0; + Nbr_User_If_Sensitized_Processes : Natural := 0; + Nbr_Conc_Sensitized_Processes : Natural := 0; + Nbr_User_Non_Sensitized_Processes : Natural := 0; + Nbr_Conc_Non_Sensitized_Processes : Natural := 0; + begin + for I in Processes_Table.First .. Processes_Table.Last loop + Proc := Processes_Table.Table (I).Label; + case Get_Kind (Proc) is + when Iir_Kind_Sensitized_Process_Statement => + if Get_Process_Origin (Proc) = Null_Iir then + Stmt := Get_Sequential_Statement_Chain (Proc); + if Stmt /= Null_Iir + and then Get_Kind (Stmt) = Iir_Kind_If_Statement + and then Get_Chain (Stmt) = Null_Iir + then + Nbr_User_If_Sensitized_Processes := + Nbr_User_If_Sensitized_Processes + 1; + else + Nbr_User_Sensitized_Processes := + Nbr_User_Sensitized_Processes + 1; + end if; + else + Nbr_Conc_Sensitized_Processes := + Nbr_Conc_Sensitized_Processes + 1; + end if; + when Iir_Kind_Process_Statement => + if Get_Process_Origin (Proc) = Null_Iir then + Nbr_User_Non_Sensitized_Processes := + Nbr_User_Non_Sensitized_Processes + 1; + else + Nbr_Conc_Non_Sensitized_Processes := + Nbr_Conc_Non_Sensitized_Processes + 1; + end if; + when others => + raise Internal_Error; + end case; + end loop; + + Put (Natural'Image (Nbr_User_If_Sensitized_Processes)); + Put_Line (" user sensitized processes with only a if stmt"); + Put (Natural'Image (Nbr_User_Sensitized_Processes)); + Put_Line (" user sensitized processes (others)"); + Put (Natural'Image (Nbr_User_Non_Sensitized_Processes)); + Put_Line (" user non sensitized processes"); + Put (Natural'Image (Nbr_Conc_Sensitized_Processes)); + Put_Line (" sensitized concurrent statements"); + Put (Natural'Image (Nbr_Conc_Non_Sensitized_Processes)); + Put_Line (" non sensitized concurrent statements"); + Put (Process_Index_Type'Image (Processes_Table.Last)); + Put_Line (" processes (total)"); + end Disp_Process_Stats; + + procedure Disp_Signals_Stats + is + type Counters_Type is array (Signal_Type_Kind) of Natural; + Counters : Counters_Type := (others => 0); + Nbr_Signal_Elements : Natural := 0; + begin + for I in Signals_Table.First .. Signals_Table.Last loop + declare + Ent : Signal_Entry renames Signals_Table.Table (I); + begin + if Ent.Kind = User_Signal then + Nbr_Signal_Elements := Nbr_Signal_Elements + + Get_Nbr_Of_Scalars (Signals_Table.Table (I).Sig); + end if; + Counters (Ent.Kind) := Counters (Ent.Kind) + 1; + end; + end loop; + Put (Integer'Image (Counters (User_Signal))); + Put_Line (" declared user signals or ports"); + Put (Integer'Image (Nbr_Signal_Elements)); + Put_Line (" user signals sub-elements"); + Put (Integer'Image (Counters (Implicit_Quiet))); + Put_Line (" 'quiet implicit signals"); + Put (Integer'Image (Counters (Implicit_Stable))); + Put_Line (" 'stable implicit signals"); + Put (Integer'Image (Counters (Implicit_Delayed))); + Put_Line (" 'delayed implicit signals"); + Put (Integer'Image (Counters (Implicit_Transaction))); + Put_Line (" 'transaction implicit signals"); + Put (Integer'Image (Counters (Guard_Signal))); + Put_Line (" guard signals"); + end Disp_Signals_Stats; + + procedure Disp_Design_Stats is + begin + Disp_Process_Stats; + + New_Line; + + Disp_Signals_Stats; + + New_Line; + + Put (Integer'Image (Connect_Table.Last)); + Put_Line (" connections"); + end Disp_Design_Stats; + + procedure Disp_Design_Non_Sensitized + is + Instance : Block_Instance_Acc; + Proc : Iir; + begin + for I in Processes_Table.First .. Processes_Table.Last loop + Instance := Processes_Table.Table (I); + Proc := Processes_Table.Table (I).Label; + if Get_Kind (Proc) = Iir_Kind_Process_Statement then + Disp_Instance_Name (Instance); + New_Line; + Put_Line (" at " & Disp_Location (Proc)); + end if; + end loop; + end Disp_Design_Non_Sensitized; + + procedure Disp_Design_Connections is + begin + for I in Connect_Table.First .. Connect_Table.Last loop + declare + Conn : Connect_Entry renames Connect_Table.Table (I); + begin + Disp_Iir_Location (Conn.Assoc); + New_Line; + end; + end loop; + end Disp_Design_Connections; + function Walk_Files (Cb : Walk_Cb) return Walk_Status is Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain; @@ -649,6 +813,8 @@ package body Debugger is return P; end Skip_Blanks; + -- Return the position of the last character of the word (the last + -- non-blank character). function Get_Word (S : String) return Positive is P : Positive := S'First; @@ -656,15 +822,15 @@ package body Debugger is while P <= S'Last and then not Is_Blank (S (P)) loop P := P + 1; end loop; - return P; + return P - 1; end Get_Word; procedure Disp_A_Frame (Instance: Block_Instance_Acc) is begin - Put (Disp_Node (Instance.Name)); - if Instance.Cur_Stmt /= Null_Iir then + Put (Disp_Node (Instance.Label)); + if Instance.Stmt /= Null_Iir then Put (" at "); - Put (Get_Location_Str (Get_Location (Instance.Cur_Stmt))); + Put (Get_Location_Str (Get_Location (Instance.Stmt))); end if; New_Line; end Disp_A_Frame; @@ -842,7 +1008,7 @@ package body Debugger is if Top_Instance = null then Put_Line ("design not yet fully elaborated"); else - Disp_All_Instances; + Disp_Instances_Tree; end if; end Info_Tree_Proc; @@ -853,7 +1019,7 @@ package body Debugger is Params : Iir; begin Check_Current_Process; - Decl := Dbg_Cur_Frame.Name; + Decl := Dbg_Cur_Frame.Label; if Decl = Null_Iir or else Get_Kind (Decl) not in Iir_Kinds_Subprogram_Declaration then @@ -930,6 +1096,32 @@ package body Debugger is return Walk_Continue; end Cb_Disp_File; + procedure Info_Stats_Proc (Line : String) is + P : Natural := Line'First; + E : Natural; + begin + P := Skip_Blanks (Line (P .. Line'Last)); + if P > Line'Last then + -- No parameters. + Disp_Design_Stats; + return; + end if; + + E := Get_Word (Line (P .. Line'Last)); + if Line (P .. E) = "global" then + Disp_Design_Stats; + elsif Line (P .. E) = "non-sensitized" then + Disp_Design_Non_Sensitized; + null; + elsif Line (P .. E) = "connections" then + Disp_Design_Connections; + -- TODO: nbr of conversions + else + Put_Line ("options are: global, non-sensitized, connections"); + -- TODO: signals: nbr of scalars, nbr of non-user... + end if; + end Info_Stats_Proc; + procedure Info_Files_Proc (Line : String) is pragma Unreferenced (Line); Status : Walk_Status; @@ -1048,7 +1240,9 @@ package body Debugger is | Iir_Kind_While_Loop_Statement => Foreach_Scopes (Get_Parent (N), Handler); - when Iir_Kind_For_Loop_Statement => + when Iir_Kind_For_Loop_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => Foreach_Scopes (Get_Parent (N), Handler); Handler.all (N); @@ -1104,6 +1298,14 @@ package body Debugger is when Iir_Kind_For_Loop_Statement => Open_Declarative_Region; Add_Name (Get_Iterator_Scheme (N)); + when Iir_Kind_Block_Statement => + Open_Declarative_Region; + Add_Declarations (Get_Declaration_Chain (N), False); + Add_Declarations_Of_Concurrent_Statement (N); + when Iir_Kind_Generate_Statement => + Open_Declarative_Region; + Add_Declarations (Get_Declaration_Chain (N), False); + Add_Declarations_Of_Concurrent_Statement (N); when others => Error_Kind ("enter_scope(2)", N); end case; @@ -1137,10 +1339,12 @@ package body Debugger is | Iir_Kind_Package_Body | Iir_Kind_Procedure_Body | Iir_Kind_Function_Body - | Iir_Kind_For_Loop_Statement => + | Iir_Kind_For_Loop_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => Close_Declarative_Region; when others => - Error_Kind ("Leave_scope(2)", N); + Error_Kind ("Decl_Decls_For", N); end case; end Del_Decls_For; @@ -1197,9 +1401,9 @@ package body Debugger is return; end if; - Enter_Scope (Dbg_Cur_Frame.Cur_Stmt); + Enter_Scope (Dbg_Cur_Frame.Stmt); Expr := Sem_Expr.Sem_Expression_Universal (Expr); - Leave_Scope (Dbg_Cur_Frame.Cur_Stmt); + Leave_Scope (Dbg_Cur_Frame.Stmt); if Expr = Null_Iir or else Nbr_Errors /= 0 @@ -1212,13 +1416,15 @@ package body Debugger is Disp_Vhdl.Disp_Expression (Expr); New_Line; + Annotate_Expand_Table; + Mark (Marker, Expr_Pool); Res := Execute_Expression (Dbg_Cur_Frame, Expr); if Opt_Value then Disp_Value (Res); else - Disp_Signal (Res, Get_Type (Expr)); + Disp_Iir_Value (Res, Get_Type (Expr)); end if; New_Line; @@ -1246,10 +1452,16 @@ package body Debugger is end loop; end Cont_Proc; + Menu_Info_Stats : aliased Menu_Entry := + (Kind => Menu_Command, + Name => new String'("stats"), + Next => null, + Proc => Info_Stats_Proc'Access); + Menu_Info_Tree : aliased Menu_Entry := (Kind => Menu_Command, Name => new String'("tree"), - Next => null, + Next => Menu_Info_Stats'Access, Proc => Info_Tree_Proc'Access); Menu_Info_Params : aliased Menu_Entry := @@ -1441,11 +1653,11 @@ package body Debugger is return; end if; E := Get_Word (Line (P .. Line'Last)); - Menu := Find_Menu (Menu, Line (P .. E - 1)); + Menu := Find_Menu (Menu, Line (P .. E)); if Menu = null then - Put_Line ("command '" & Line (P .. E - 1) & "' not found"); + Put_Line ("command '" & Line (P .. E) & "' not found"); end if; - P := E; + P := E + 1; end Parse_Command; procedure Help_Proc (Line : String) is @@ -1494,7 +1706,7 @@ package body Debugger is function Breakpoint_Hit return Natural is - Stmt : constant Iir := Current_Process.Instance.Cur_Stmt; + Stmt : constant Iir := Current_Process.Instance.Stmt; begin for I in Breakpoints.First .. Breakpoints.Last loop if Stmt = Breakpoints.Table (I).Stmt then @@ -1556,7 +1768,7 @@ package body Debugger is end case; Set_Top_Frame (Current_Process.Instance); declare - Stmt : constant Iir := Dbg_Cur_Frame.Cur_Stmt; + Stmt : constant Iir := Dbg_Cur_Frame.Stmt; begin Put ("stopped at: "); Disp_Iir_Location (Stmt); diff --git a/simulate/debugger.ads b/simulate/debugger.ads index 86a77c2..5e8c7ac 100644 --- a/simulate/debugger.ads +++ b/simulate/debugger.ads @@ -33,8 +33,6 @@ package Debugger is procedure Warning_Msg_Exec (Msg: String; Loc: Iir); - Trace_All_Signals : Boolean := False; - -- Disp a block instance, in a human readable way. -- Used to debug. procedure Disp_Block_Instance (Instance: Block_Instance_Acc); @@ -58,6 +56,9 @@ package Debugger is procedure Disp_Objects_Value; + -- Disp stats about the design (number of process, number of signals...) + procedure Disp_Design_Stats; + -- The reason why the debugger is invoked. type Debug_Reason is (-- Called from an external debugger while debugging ghdl. diff --git a/simulate/elaboration.adb b/simulate/elaboration.adb index 86941d7..eb0d14b 100644 --- a/simulate/elaboration.adb +++ b/simulate/elaboration.adb @@ -17,6 +17,7 @@ -- 02111-1307, USA. with Ada.Text_IO; +with Types; use Types; with Errorout; use Errorout; with Execution; use Execution; with Simulation; use Simulation; @@ -104,7 +105,7 @@ package body Elaboration is Sig : Iir_Value_Literal_Acc; Def : Iir_Value_Literal_Acc; - Slot : constant Iir_Index32 := Get_Info (Signal).Slot; + Slot : constant Object_Slot_Type := Get_Info (Signal).Slot; begin Sig := Create_Signal (Default); Def := Unshare (Default, Global_Pool'Access); @@ -248,26 +249,19 @@ package body Elaboration is Package_Info : constant Sim_Info_Acc := Get_Info (Decl); Instance : Block_Instance_Acc; begin - if Package_Info.Elaborated then - return; - end if; - - -- Create packages_instance only if it was not already created. Instance := new Block_Instance_Type' (Max_Objs => Package_Info.Nbr_Objects, Scope_Level => Package_Info.Frame_Scope_Level, Up_Block => null, - Name => Decl, + Label => Decl, + Stmt => Null_Iir, Parent => null, Children => null, Brother => null, - Configuration => Null_Iir, Marker => Empty_Marker, Objects => (others => null), Elab_Objects => 0, - Instances => null, In_Wait_Flag => False, - Cur_Stmt => Null_Iir, Actuals_Ref => null, Result => null); @@ -279,7 +273,6 @@ package body Elaboration is -- Elaborate objects declarations. Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl)); - Package_Info.Elaborated := True; end Elaborate_Package; procedure Elaborate_Package_Body (Decl: Iir) @@ -287,8 +280,8 @@ package body Elaboration is Package_Info : constant Sim_Info_Acc := Get_Info (Decl); Instance : Block_Instance_Acc; begin - Instance := - Package_Instances (Iir_Index32 (-Package_Info.Frame_Scope_Level)); + Instance := Package_Instances + (Instance_Slot_Type (-Package_Info.Frame_Scope_Level)); if Trace_Elaboration then Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl)); @@ -309,8 +302,6 @@ package body Elaboration is Depend_List: Iir_Design_Unit_List; Design: Iir; Library_Unit: Iir; - Body_Design: Iir_Design_Unit; - Need_A_Body: Boolean; begin Depend_List := Get_Dependence_List (Design_Unit); @@ -328,24 +319,38 @@ package body Elaboration is -- Elaborates only non-elaborated packages. case Get_Kind (Library_Unit) is when Iir_Kind_Package_Declaration => - if not Get_Info (Library_Unit).Elaborated then - Body_Design := Libraries.Load_Secondary_Unit - (Design, Null_Identifier, Design_Unit); - -- First the packages on which DESIGN depends. - Elaborate_Dependence (Design); - -- Then the declaration. - Elaborate_Package (Library_Unit); - Need_A_Body := Get_Need_Body (Library_Unit); - if Body_Design = Null_Iir then - if Need_A_Body then - Error_Msg_Elab ("no package body for `" & - Image_Identifier (Library_Unit) & '''); + declare + Info : constant Sim_Info_Acc := Get_Info (Library_Unit); + Body_Design: Iir_Design_Unit; + begin + if Package_Instances (Info.Inst_Slot) = null then + -- Package not yet elaborated. + + -- Load the body now, as it can add objects in the + -- package instance. + Body_Design := Libraries.Load_Secondary_Unit + (Design, Null_Identifier, Design_Unit); + + -- First the packages on which DESIGN depends. + Elaborate_Dependence (Design); + + -- Then the declaration. + Elaborate_Package (Library_Unit); + + -- And then the body (if any). + if Body_Design = Null_Iir then + if Get_Need_Body (Library_Unit) then + Error_Msg_Elab + ("no package body for `" & + Image_Identifier (Library_Unit) & '''); + end if; + else + -- Note: the body can elaborate some packages. + Elaborate_Package_Body + (Get_Library_Unit (Body_Design)); end if; - else - -- Then the body (this can elaborate some packages). - Elaborate_Package_Body (Get_Library_Unit (Body_Design)); end if; - end if; + end; when Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Architecture_Declaration => @@ -374,26 +379,21 @@ package body Elaboration is (Max_Objs => Obj_Info.Nbr_Objects, Scope_Level => Obj_Info.Frame_Scope_Level, Up_Block => Father, - Name => Stmt, + Label => Stmt, + Stmt => Obj, Parent => Father, Children => null, Brother => null, - Configuration => Null_Iir, Marker => Empty_Marker, Objects => (others => null), Elab_Objects => 0, - Instances => null, In_Wait_Flag => False, - Cur_Stmt => Null_Iir, Actuals_Ref => null, Result => null); - Res.Instances := - new Block_Instance_Acc_Array (0 .. Obj_Info.Nbr_Instances - 1); if Father /= null then Res.Brother := Father.Children; Father.Children := Res; - Father.Instances (Get_Info (Stmt).Inst_Slot) := Res; end if; return Res; @@ -496,7 +496,7 @@ package body Elaboration is procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) is - Slot : constant Iir_Index32 := Get_Info (Decl).Slot; + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; begin -- Check elaboration order. -- Note: this is not done for package since objects from package are @@ -514,7 +514,7 @@ package body Elaboration is procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir) is Info : constant Sim_Info_Acc := Get_Info (Decl); - Slot : constant Iir_Index32 := Info.Slot; + Slot : constant Object_Slot_Type := Info.Slot; begin if Slot /= Instance.Elab_Objects or else Info.Scope_Level /= Instance.Scope_Level @@ -529,7 +529,7 @@ package body Elaboration is procedure Create_Signal (Instance : Block_Instance_Acc; Decl : Iir) is - Slot : constant Iir_Index32 := Get_Info (Decl).Slot; + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; begin if Slot /= Instance.Elab_Objects + 1 or else Instance.Objects (Slot) /= null @@ -560,9 +560,8 @@ package body Elaboration is procedure Create_Terminal (Instance : Block_Instance_Acc; Decl : Iir) is - Slot : Iir_Index32; + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; begin - Slot := Get_Info (Decl).Slot; if Slot + 1 = Instance.Elab_Objects then -- Reference terminal of nature declaration may have already been -- elaborated. @@ -607,10 +606,9 @@ package body Elaboration is function Create_Quantity (Instance : Block_Instance_Acc; Decl : Iir) return Iir_Value_Literal_Acc is - Slot : Iir_Index32; + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; Res : Iir_Value_Literal_Acc; begin - Slot := Get_Info (Decl).Slot; if Slot /= Instance.Elab_Objects then Error_Msg_Elab ("bad elaboration order"); raise Internal_Error; @@ -1137,17 +1135,37 @@ package body Elaboration is Actual_Expr := null; end if; end if; - if Get_Whole_Association_Flag (Assoc) then - Elaborate_Signal (Formal_Instance, Inter, Init_Expr); - end if; - -- Elaboration of a port association element consists of the - -- elaboration of the formal part; the port or subelement - -- or slice thereof designated by the formal part is then - -- associated with the signal or expression designated - -- by the actual part. - Elab_Connect - (Formal_Instance, Actual_Instance, Actual_Expr, Assoc); + if Get_Whole_Association_Flag (Assoc) + and then Get_Collapse_Signal_Flag (Assoc) + then + declare + Slot : constant Object_Slot_Type := + Get_Info (Inter).Slot; + Actual_Sig : Iir_Value_Literal_Acc; + begin + Actual_Sig := + Execute_Name (Actual_Instance, Actual, True); + Implicit_Array_Conversion + (Formal_Instance, Actual_Sig, + Get_Type (Inter), Actual); + Formal_Instance.Objects (Slot) := Unshare_Bounds + (Actual_Sig, Global_Pool'Access); + Formal_Instance.Objects (Slot + 1) := Init_Expr; + end; + else + if Get_Whole_Association_Flag (Assoc) then + Elaborate_Signal (Formal_Instance, Inter, Init_Expr); + end if; + + -- Elaboration of a port association element consists of the + -- elaboration of the formal part; the port or subelement + -- or slice thereof designated by the formal part is then + -- associated with the signal or expression designated + -- by the actual part. + Elab_Connect + (Formal_Instance, Actual_Instance, Actual_Expr, Assoc); + end if; when Iir_Kind_Association_Element_Open => -- Note that an open cannot be associated with a formal that @@ -1427,13 +1445,6 @@ package body Elaboration is (Arch, Config, Instance, Stmt, Get_Generic_Map_Aspect_Chain (Stmt), Get_Port_Map_Aspect_Chain (Stmt)); - - -- FIXME Create_Block_Instance. - -- Make the difference between the father in the hierachy and - -- the father in instances. Be sure that architecture is - -- elaborated. - Frame.Up_Block := null; -- Packages_Instance; - Frame.Name := Arch; end; end if; end Elaborate_Component_Instantiation; @@ -1475,45 +1486,19 @@ package body Elaboration is procedure Elaborate_Iterative_Generate_Statement (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement) is - Info : constant Sim_Info_Acc := Get_Info (Generate); Scheme : constant Iir_Iterator_Declaration := Get_Generation_Scheme (Generate); Ninstance : Block_Instance_Acc; + Sub_Instance : Block_Instance_Acc; Bound, Index : Iir_Value_Literal_Acc; - Shadow : Block_Instance_Acc; - Idx : Iir_Index32; begin -- LRM93 12.4.2 -- For a generate statement with a for generation scheme, elaboration -- consists of the elaboration of the discrete range - Shadow := new Block_Instance_Type' - (Max_Objs => 1, - Scope_Level => Info.Frame_Scope_Level, - Up_Block => Instance, - Name => Scheme, - Parent => Instance, - Children => null, - Brother => Instance.Children, - Configuration => Null_Iir, - Marker => Empty_Marker, - Objects => (others => null), - Elab_Objects => 0, - Instances => null, - In_Wait_Flag => False, - Cur_Stmt => Null_Iir, - Actuals_Ref => null, - Result => null); - Instance.Children := Shadow; - Instance.Instances (Info.Inst_Slot) := Shadow; - - Ninstance := Create_Block_Instance (null, Generate, Generate); - Ninstance.Parent := Shadow; - Ninstance.Up_Block := Instance; - + Ninstance := Create_Block_Instance (Instance, Generate, Generate); Elaborate_Declaration (Ninstance, Scheme); Bound := Execute_Bounds (Ninstance, Get_Type (Scheme)); - Shadow.Objects (1) := Bound; -- FIXME: should be in the instance pool. -- Index is the iterator value. Index := Unshare (Ninstance.Objects (Get_Info (Scheme).Slot), @@ -1528,29 +1513,24 @@ package body Elaboration is raise Internal_Error; return; end if; - Idx := 0; - Shadow.Instances := new Block_Instance_Acc_Array (0 .. Bound.Length - 1); + loop - Shadow.Instances (Idx) := Ninstance; - Ninstance.Brother := Shadow.Children; - Shadow.Children := Ninstance; + Sub_Instance := Create_Block_Instance (Ninstance, Generate, Scheme); + + -- FIXME: this is needed to copy iterator type (if any). But this + -- elaborates the subtype several times (what about side effects). + Elaborate_Declaration (Sub_Instance, Scheme); + + -- Store index. + Store (Sub_Instance.Objects (Get_Info (Scheme).Slot), Index); - -- Store index. - Store (Ninstance.Objects (Get_Info (Scheme).Slot), Index); Elaborate_Declarative_Part - (Ninstance, Get_Declaration_Chain (Generate)); + (Sub_Instance, Get_Declaration_Chain (Generate)); Elaborate_Statement_Part - (Ninstance, Get_Concurrent_Statement_Chain (Generate)); + (Sub_Instance, Get_Concurrent_Statement_Chain (Generate)); + Update_Loop_Index (Index, Bound); exit when not Is_In_Range (Index, Bound); - - -- Next instance. - Ninstance := Create_Block_Instance (null, Generate, Generate); - Ninstance.Parent := Shadow; - Ninstance.Up_Block := Instance; - - Elaborate_Declaration (Ninstance, Scheme); - Idx := Idx + 1; end loop; -- FIXME: destroy index ? end Elaborate_Iterative_Generate_Statement; @@ -1685,13 +1665,11 @@ package body Elaboration is procedure Elaborate_Component_Configuration (Stmt : Iir_Component_Instantiation_Statement; - Instance : Block_Instance_Acc; + Comp_Instance : Block_Instance_Acc; Conf : Iir_Component_Configuration) is Component : constant Iir_Component_Declaration := Get_Instantiated_Unit (Stmt); - Stmt_Info : constant Sim_Info_Acc := Get_Info (Stmt); - Frame : Block_Instance_Acc; Entity_Design : Iir_Design_Unit; Entity : Iir_Entity_Declaration; Arch_Name : Name_Id; @@ -1733,7 +1711,6 @@ package body Elaboration is -- elaboration of the implied block statement representing the -- component instance and [...] -- FIXME: extract frame. - Frame := Instance.Instances (Stmt_Info.Inst_Slot); -- and (within that block) the implied block statement representing the -- design entity to which the component instance is so bound. @@ -1835,71 +1812,115 @@ package body Elaboration is -- FIXME: Use Sub_Conf instead of Arch for Stmt ? (But need to add -- info for block configuration). Arch_Frame := Elaborate_Architecture - (Arch, Sub_Conf, Frame, Arch, + (Arch, Sub_Conf, Comp_Instance, Arch, Generic_Map_Aspect_Chain, Port_Map_Aspect_Chain); end Elaborate_Component_Configuration; procedure Elaborate_Block_Configuration (Conf : Iir_Block_Configuration; Instance : Block_Instance_Acc); - procedure Apply_Block_Configuration_To_Slice_Or_Index - (Instance : Block_Instance_Acc; Item : Iir) + procedure Apply_Block_Configuration_To_Iterative_Generate + (Stmt : Iir; Conf_Chain : Iir; Instance : Block_Instance_Acc) is - Spec : constant Iir := Get_Block_Specification (Item); - Generate : constant Iir_Generate_Statement := Get_Prefix (Spec); - Info : constant Sim_Info_Acc := Get_Info (Generate); - Sub_Instance : constant Block_Instance_Acc := - Instance.Instances (Info.Inst_Slot); - Bounds : constant Iir_Value_Literal_Acc := Sub_Instance.Objects (1); + Scheme : constant Iir := Get_Generation_Scheme (Stmt); + Bounds : constant Iir_Value_Literal_Acc := + Execute_Bounds (Instance, Get_Type (Scheme)); + + Sub_Instances : Block_Instance_Acc_Array + (0 .. Instance_Slot_Type (Bounds.Length - 1)); + + type Sub_Conf_Type is array (0 .. Instance_Slot_Type (Bounds.Length - 1)) + of Boolean; + Sub_Conf : Sub_Conf_Type := (others => False); + + Child : Block_Instance_Acc; + + Item : Iir; + Prev_Item : Iir; + Default_Item : Iir := Null_Iir; + Spec : Iir; Expr : Iir_Value_Literal_Acc; - Ind : Iir_Index32; + Ind : Instance_Slot_Type; begin - case Get_Kind (Spec) is - when Iir_Kind_Slice_Name => - Expr := Execute_Bounds (Instance, Get_Suffix (Spec)); - Ind := Get_Index_Offset (Execute_Low_Limit (Expr), Bounds, Spec); - for I in 1 .. Expr.Length loop - Elaborate_Block_Configuration - (Item, Sub_Instance.Instances (Ind + I - 1)); - end loop; - when Iir_Kind_Indexed_Name => - Expr := Execute_Expression - (Instance, Get_First_Element (Get_Index_List (Spec))); - Ind := Get_Index_Offset (Expr, Bounds, Spec); - Elaborate_Block_Configuration - (Item, Sub_Instance.Instances (Ind)); - when Iir_Kind_Selected_Name => - for I in Sub_Instance.Instances'Range loop - if Sub_Instance.Instances (I).Configuration = Null_Iir then + -- Gather children + Child := Instance.Children; + for I in reverse Sub_Instances'Range loop + Sub_Instances (I) := Child; + Child := Child.Brother; + end loop; + if Child /= null then + raise Internal_Error; + end if; + + -- Apply configuration items + Item := Conf_Chain; + while Item /= Null_Iir loop + Spec := Get_Block_Specification (Item); + Prev_Item := Get_Prev_Block_Configuration (Item); + + case Get_Kind (Spec) is + when Iir_Kind_Slice_Name => + Expr := Execute_Bounds (Instance, Get_Suffix (Spec)); + Ind := Instance_Slot_Type + (Get_Index_Offset (Execute_Low_Limit (Expr), Bounds, Spec)); + for I in 1 .. Instance_Slot_Type (Expr.Length) loop + Sub_Conf (Ind + I - 1) := True; Elaborate_Block_Configuration - (Item, Sub_Instance.Instances (I)); - end if; - end loop; - when others => - raise Internal_Error; - end case; - end Apply_Block_Configuration_To_Slice_Or_Index; + (Item, Sub_Instances (Ind + I - 1)); + end loop; + when Iir_Kind_Indexed_Name => + Expr := Execute_Expression + (Instance, Get_First_Element (Get_Index_List (Spec))); + Ind := Instance_Slot_Type + (Get_Index_Offset (Expr, Bounds, Spec)); + Sub_Conf (Ind) := True; + Elaborate_Block_Configuration (Item, Sub_Instances (Ind)); + when Iir_Kind_Selected_Name => + -- Must be the only default block configuration + pragma Assert (Default_Item = Null_Iir); + Default_Item := Item; + when Iir_Kind_Generate_Statement => + -- Must be the only block configuration + pragma Assert (Item = Conf_Chain); + pragma Assert (Prev_Item = Null_Iir); + for I in Sub_Instances'Range loop + Sub_Conf (I) := True; + Elaborate_Block_Configuration (Item, Sub_Instances (I)); + end loop; + when others => + raise Internal_Error; + end case; + Item := Prev_Item; + end loop; + + if Default_Item /= Null_Iir then + for I in Sub_Instances'Range loop + if not Sub_Conf (I) then + Elaborate_Block_Configuration + (Default_Item, Sub_Instances (I)); + end if; + end loop; + end if; + end Apply_Block_Configuration_To_Iterative_Generate; procedure Elaborate_Block_Configuration (Conf : Iir_Block_Configuration; Instance : Block_Instance_Acc) is + Blk_Info : constant Sim_Info_Acc := Get_Info (Instance.Stmt); + Sub_Instances : Block_Instance_Acc_Array + (0 .. Blk_Info.Nbr_Instances - 1); + type Iir_Array is array (Instance_Slot_Type range <>) of Iir; + Sub_Conf : Iir_Array (0 .. Blk_Info.Nbr_Instances - 1) := + (others => Null_Iir); + Item : Iir; - List : Iir_List; - El : Iir; - Comp : Iir_Component_Declaration; begin if Conf = Null_Iir then - raise Program_Error; - -- FIXME. - -- Clear_Instantiation_Configuration (Stmt_Chain); - return; - end if; - - if Instance.Configuration /= Null_Iir then raise Internal_Error; end if; - Instance.Configuration := Conf; + -- Associate configuration items with subinstance. Gather items for + -- for-generate statements. Item := Get_Configuration_Item_Chain (Conf); while Item /= Null_Iir loop case Get_Kind (Item) is @@ -1908,7 +1929,6 @@ package body Elaboration is Spec : Iir; Gen : Iir_Generate_Statement; Info : Sim_Info_Acc; - Sub_Instance : Block_Instance_Acc; begin Spec := Get_Block_Specification (Item); case Get_Kind (Spec) is @@ -1916,78 +1936,119 @@ package body Elaboration is | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Name => -- Block configuration for a generate statement. - if Get_Prev_Block_Configuration (Item) = Null_Iir then - Gen := Get_Prefix (Spec); - Set_Generate_Block_Configuration (Gen, Item); - end if; - Apply_Block_Configuration_To_Slice_Or_Index - (Instance, Item); + Gen := Get_Prefix (Spec); + Info := Get_Info (Gen); + Set_Prev_Block_Configuration + (Item, Sub_Conf (Info.Inst_Slot)); + Sub_Conf (Info.Inst_Slot) := Item; when Iir_Kind_Generate_Statement => - -- Block configuration for any blocks created by the - -- generate statement. Info := Get_Info (Spec); - Sub_Instance := Instance.Instances (Info.Inst_Slot); - if Get_Kind (Get_Generation_Scheme (Spec)) - = Iir_Kind_Iterator_Declaration - then - -- Iterative generate: apply to all instances - for I in Sub_Instance.Instances'Range loop - Elaborate_Block_Configuration - (Item, Sub_Instance.Instances (I)); - end loop; - else - -- Conditional generate: may not be instantiated - if Sub_Instance /= null then - Elaborate_Block_Configuration - (Item, Sub_Instance); - end if; + if Sub_Conf (Info.Inst_Slot) /= Null_Iir then + raise Internal_Error; end if; + Sub_Conf (Info.Inst_Slot) := Item; when Iir_Kind_Block_Statement => -- Block configuration for a block statement. Info := Get_Info (Spec); - Sub_Instance := Instance.Instances (Info.Inst_Slot); - Elaborate_Block_Configuration (Item, Sub_Instance); + if Sub_Conf (Info.Inst_Slot) /= Null_Iir then + raise Internal_Error; + end if; + Sub_Conf (Info.Inst_Slot) := Item; when others => Error_Kind ("elaborate_block_configuration1", Spec); end case; end; when Iir_Kind_Component_Configuration => - Comp := Get_Component_Name (Item); - List := Get_Instantiation_List (Item); - case List is - when Iir_List_All - | Iir_List_Others => - El := Null_Iir; --Stmt_Chain; - while El /= Null_Iir loop - if Get_Kind (El) = - Iir_Kind_Component_Instantiation_Statement - and then Get_Instantiated_Unit (El) = Comp - then - if List = Iir_List_All - or else - Get_Component_Configuration (El) = Null_Iir - then - Set_Component_Configuration (El, Item); - end if; - end if; - El := Get_Chain (El); - end loop; + declare + List : constant Iir_List := + Get_Instantiation_List (Item); + El : Iir; + Info : Sim_Info_Acc; + begin + if List = Iir_List_All or else List = Iir_List_Others then raise Internal_Error; - when others => - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Elaborate_Component_Configuration (El, Instance, Item); - -- Set_Component_Configuration (El, Item); - end loop; - end case; + end if; + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Info := Get_Info (El); + if Sub_Conf (Info.Inst_Slot) /= Null_Iir then + raise Internal_Error; + end if; + Sub_Conf (Info.Inst_Slot) := Item; + end loop; + end; when others => Error_Kind ("elaborate_block_configuration", Item); end case; Item := Get_Chain (Item); end loop; + + -- Gather children. + declare + Child : Block_Instance_Acc; + begin + Child := Instance.Children; + while Child /= null loop + declare + Slot : constant Instance_Slot_Type := + Get_Info (Child.Label).Inst_Slot; + begin + if Slot /= Invalid_Instance_Slot then + -- Processes have no slot. + if Sub_Instances (Slot) /= null then + raise Internal_Error; + end if; + Sub_Instances (Slot) := Child; + end if; + end; + Child := Child.Brother; + end loop; + end; + + -- Configure sub instances. + declare + Stmt : Iir; + Info : Sim_Info_Acc; + Slot : Instance_Slot_Type; + begin + Stmt := Get_Concurrent_Statement_Chain (Instance.Stmt); + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_Generate_Statement => + Info := Get_Info (Stmt); + Slot := Info.Inst_Slot; + if Get_Kind (Get_Generation_Scheme (Stmt)) + = Iir_Kind_Iterator_Declaration + then + -- Iterative generate: apply to all instances + Apply_Block_Configuration_To_Iterative_Generate + (Stmt, Sub_Conf (Slot), Sub_Instances (Slot)); + else + -- Conditional generate: may not be instantiated + if Sub_Instances (Slot) /= null then + Elaborate_Block_Configuration + (Sub_Conf (Slot), Sub_Instances (Slot)); + end if; + end if; + when Iir_Kind_Block_Statement => + Info := Get_Info (Stmt); + Slot := Info.Inst_Slot; + Elaborate_Block_Configuration + (Sub_Conf (Slot), Sub_Instances (Slot)); + when Iir_Kind_Component_Instantiation_Statement => + Info := Get_Info (Stmt); + Slot := Info.Inst_Slot; + Elaborate_Component_Configuration + (Stmt, Sub_Instances (Slot), Sub_Conf (Slot)); + when others => + null; + end case; + Stmt := Get_Chain (Stmt); + end loop; + end; end Elaborate_Block_Configuration; procedure Elaborate_Alias_Declaration @@ -2458,7 +2519,8 @@ package body Elaboration is Generic_Map : Iir; Port_Map : Iir; begin - Package_Instances := new Block_Instance_Acc_Array (1 .. Nbr_Packages); + Package_Instances := + new Block_Instance_Acc_Array (1 .. Instance_Slot_Type (Nbr_Packages)); -- Use a 'fake' process to execute code during elaboration. Current_Process := No_Process; diff --git a/simulate/elaboration.ads b/simulate/elaboration.ads index 375d400..5a9ea8d 100644 --- a/simulate/elaboration.ads +++ b/simulate/elaboration.ads @@ -18,7 +18,6 @@ with Ada.Unchecked_Deallocation; with GNAT.Table; -with Types; use Types; with Iirs; use Iirs; with Iir_Values; use Iir_Values; with Grt.Types; @@ -36,14 +35,13 @@ package Elaboration is type Block_Instance_Type; type Block_Instance_Acc is access Block_Instance_Type; - type Block_Instance_Acc_Array is array (Iir_Index32 range <>) of - Block_Instance_Acc; - type Block_Instance_Acc_Array_Acc is access Block_Instance_Acc_Array; + type Objects_Array is array (Object_Slot_Type range <>) of + Iir_Value_Literal_Acc; -- A block instance with its architecture/entity declaration is an -- instancied entity. - type Block_Instance_Type (Max_Objs : Iir_Index32) is record + type Block_Instance_Type (Max_Objs : Object_Slot_Type) is record -- Flag for wait statement: true if not yet executed. In_Wait_Flag : Boolean; @@ -52,26 +50,26 @@ package Elaboration is Scope_Level: Scope_Level_Type; Up_Block: Block_Instance_Acc; - -- Block, architecture or process for this instance. - -- null for the package (there is only one instance for all packages). - Name: Iir; + -- Block, architecture, package, process, component instantiation for + -- this instance. + Label : Iir; + + -- For blocks: corresponding block (different from label for direct + -- component instantiation statement and generate iterator). + -- For packages: Null_Iir + -- For subprograms and processes: statement being executed. + Stmt : Iir; - -- Instanciation tree. + -- Instanciation tree. + -- Parent is always set (but null for top-level block and packages) Parent: Block_Instance_Acc; + -- Not null only for blocks and processes. Children: Block_Instance_Acc; Brother: Block_Instance_Acc; - -- Pool marker for the child (only for subprograms). + -- Pool marker for the child (only for subprograms and processes). Marker : Areapools.Mark_Type; - -- Block configuration for this instance. - Configuration: Iir; - - Instances : Block_Instance_Acc_Array_Acc; - - -- Statement being executed. - Cur_Stmt : Iir; - -- Reference to the actuals, for copy-out when returning from a -- procedure. Actuals_Ref : Value_Array_Acc; @@ -83,10 +81,10 @@ package Elaboration is -- Note: this is generally the slot index of the next object to be -- elaborated (this may be wrong for dynamic objects due to execution -- branches). - Elab_Objects : Iir_Index32 := 0; + Elab_Objects : Object_Slot_Type := 0; -- Values of the objects in that frame. - Objects : Iir_Value_Literal_Array (1 .. Max_Objs); + Objects : Objects_Array (1 .. Max_Objs); end record; procedure Free is new Ada.Unchecked_Deallocation @@ -126,6 +124,10 @@ package Elaboration is Top_Instance: Block_Instance_Acc; + type Block_Instance_Acc_Array is array (Instance_Slot_Type range <>) of + Block_Instance_Acc; + type Block_Instance_Acc_Array_Acc is access Block_Instance_Acc_Array; + Package_Instances : Block_Instance_Acc_Array_Acc; -- Disconnections. For each disconnection specification, the elaborator diff --git a/simulate/execution.adb b/simulate/execution.adb index 5fa6d05..0d9e427 100644 --- a/simulate/execution.adb +++ b/simulate/execution.adb @@ -67,7 +67,7 @@ package body Execution is end loop; -- Global scope (packages) if Scope_Level < Scope_Level_Global then - return Package_Instances (Iir_Index32 (-Scope_Level)); + return Package_Instances (Instance_Slot_Type (-Scope_Level)); end if; if Current_Component /= null and then Current_Component.Scope_Level = Scope_Level @@ -2085,55 +2085,73 @@ package body Execution is return Res; end String_To_Iir_Value; - function Execute_Image_Attribute (Block: Block_Instance_Acc; Expr: Iir) - return Iir_Value_Literal_Acc + function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc; + Expr_Type : Iir) + return String is - Val : Iir_Value_Literal_Acc; - Res : Iir_Value_Literal_Acc; begin - Val := Execute_Expression (Block, Get_Parameter (Expr)); - case Val.Kind is - when Iir_Value_F64 => + case Get_Kind (Expr_Type) is + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Floating_Subtype_Definition => declare Str : String (1 .. 24); Last : Natural; begin Grt.Vstrings.To_String (Str, Last, Val.F64); - Res := String_To_Iir_Value (Str (Str'First .. Last)); + return Str (Str'First .. Last); end; - when Iir_Value_I64 => + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => declare Str : String (1 .. 21); First : Natural; begin Grt.Vstrings.To_String (Str, First, Val.I64); - Res := String_To_Iir_Value (Str (First .. Str'Last)); + return Str (First .. Str'Last); end; - when Iir_Value_B2 => + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => declare - Lits : constant Iir_List := Get_Enumeration_Literal_List - (Get_Type (Get_Prefix (Expr))); + Lits : constant Iir_List := + Get_Enumeration_Literal_List (Expr_Type); + Pos : Natural; begin - Res := String_To_Iir_Value - (Name_Table.Image - (Get_Identifier - (Get_Nth_Element (Lits, Ghdl_B2'Pos (Val.B2))))); + case Val.Kind is + when Iir_Value_B2 => + Pos := Ghdl_B2'Pos (Val.B2); + when Iir_Value_E32 => + Pos := Ghdl_E32'Pos (Val.E32); + when others => + raise Internal_Error; + end case; + return Name_Table.Image + (Get_Identifier (Get_Nth_Element (Lits, Pos))); end; - when Iir_Value_E32 => + when Iir_Kind_Physical_Type_Definition + | Iir_Kind_Physical_Subtype_Definition => declare - Lits : constant Iir_List := Get_Enumeration_Literal_List - (Get_Type (Get_Prefix (Expr))); + Str : String (1 .. 21); + First : Natural; + Id : constant Name_Id := + Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); begin - Res := String_To_Iir_Value - (Name_Table.Image - (Get_Identifier - (Get_Nth_Element (Lits, Ghdl_E32'Pos (Val.E32))))); + Grt.Vstrings.To_String (Str, First, Val.I64); + return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); end; when others => - Error_Kind ("image_attribute " & Iir_Value_Kind'Image (Val.Kind), - Expr); + Error_Kind ("execute_image_attribute", Expr_Type); end case; - return Res; + end Execute_Image_Attribute; + + function Execute_Image_Attribute (Block: Block_Instance_Acc; Expr: Iir) + return Iir_Value_Literal_Acc + is + Val : Iir_Value_Literal_Acc; + Attr_Type : constant Iir := Get_Type (Get_Prefix (Expr)); + begin + Val := Execute_Expression (Block, Get_Parameter (Expr)); + return String_To_Iir_Value + (Execute_Image_Attribute (Val, Attr_Type)); end Execute_Image_Attribute; function Execute_Value_Attribute (Block: Block_Instance_Acc; @@ -2279,27 +2297,31 @@ package body Execution is Is_Instance : constant Boolean := Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute; begin + if Name.Path_Instance = Null_Iir then + return String_To_Iir_Value (Name.Suffix); + end if; + Instance := Get_Instance_By_Scope_Level (Block, Get_Info (Name.Path_Instance).Frame_Scope_Level); loop - case Get_Kind (Instance.Name) is + case Get_Kind (Instance.Label) is when Iir_Kind_Entity_Declaration => if Instance.Parent = null then - Prepend (Rstr, Image (Get_Identifier (Instance.Name))); + Prepend (Rstr, Image (Get_Identifier (Instance.Label))); exit; end if; when Iir_Kind_Architecture_Declaration => if Is_Instance then Prepend (Rstr, ')'); - Prepend (Rstr, Image (Get_Identifier (Instance.Name))); + Prepend (Rstr, Image (Get_Identifier (Instance.Label))); Prepend (Rstr, '('); end if; if Is_Instance or else Instance.Parent = null then Prepend (Rstr, - Image (Get_Identifier (Get_Entity (Instance.Name)))); + Image (Get_Identifier (Get_Entity (Instance.Label)))); end if; if Instance.Parent = null then Prepend (Rstr, ':'); @@ -2307,22 +2329,35 @@ package body Execution is else Instance := Instance.Parent; end if; - when Iir_Kind_Generate_Statement => + when Iir_Kind_Block_Statement => + Prepend (Rstr, Image (Get_Label (Instance.Label))); + Prepend (Rstr, ':'); + Instance := Instance.Parent; + when Iir_Kind_Iterator_Declaration => declare - Scheme : constant Iir := - Get_Generation_Scheme (Instance.Name); + Val : Iir_Value_Literal_Acc; begin - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Prepend (Rstr, ')'); - Prepend (Rstr, 'X'); - Prepend (Rstr, '('); - Prepend (Rstr, Image (Get_Label (Instance.Name))); - end if; - Instance := Instance.Parent; + Val := Execute_Name (Instance, Instance.Label); + Prepend (Rstr, ')'); + Prepend (Rstr, Execute_Image_Attribute + (Val, Get_Type (Instance.Label))); + Prepend (Rstr, '('); end; + Instance := Instance.Parent; + when Iir_Kind_Generate_Statement => + Prepend (Rstr, Image (Get_Label (Instance.Label))); + Prepend (Rstr, ':'); + Instance := Instance.Parent; + when Iir_Kind_Component_Instantiation_Statement => + if Is_Instance then + Prepend (Rstr, '@'); + end if; + Prepend (Rstr, Image (Get_Label (Instance.Label))); + Prepend (Rstr, ':'); + Instance := Instance.Parent; when others => Error_Kind ("Execute_Path_Instance_Name_Attribute", - Instance.Name); + Instance.Label); end case; end loop; declare @@ -2749,17 +2784,15 @@ package body Execution is Block_Instance_Type'(Max_Objs => Func_Info.Nbr_Objects, Scope_Level => Func_Info.Frame_Scope_Level, Up_Block => Up_Block, - Name => Imp, + Label => Imp, + Stmt => Null_Iir, Parent => Instance, Children => null, Brother => null, - Configuration => Null_Iir, Marker => Empty_Marker, Objects => (others => null), Elab_Objects => 0, - Instances => null, In_Wait_Flag => False, - Cur_Stmt => Null_Iir, Actuals_Ref => null, Result => null))); return Res; @@ -2768,7 +2801,7 @@ package body Execution is -- Destroy a dynamic block_instance. procedure Execute_Subprogram_Call_Final (Instance : Block_Instance_Acc) is - Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Name); + Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label); begin Finalize_Declarative_Part (Instance, Get_Declaration_Chain (Subprg_Body)); @@ -2786,7 +2819,7 @@ package body Execution is (Instance, Get_Declaration_Chain (Subprg_Body)); -- execute statements - Instance.Cur_Stmt := Get_Sequential_Statement_Chain (Subprg_Body); + Instance.Stmt := Get_Sequential_Statement_Chain (Subprg_Body); Execute_Sequential_Statements (Current_Process); pragma Assert (Current_Process.Instance = Instance); @@ -2873,6 +2906,8 @@ package body Execution is while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); Inter := Get_Base_Name (Formal); + + -- Extract the actual value. case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => -- Not allowed in individual association. @@ -2896,6 +2931,7 @@ package body Execution is Error_Kind ("execute_association(1)", Assoc); end case; + -- Compute actual value. case Get_Kind (Inter) is when Iir_Kind_Constant_Interface_Declaration | Iir_Kind_File_Interface_Declaration => @@ -2942,13 +2978,19 @@ package body Execution is Unshare_Bounds (Val, Instance_Pool); end if; - if Mode = Iir_Out_Mode - and then Get_Out_Conversion (Assoc) /= Null_Iir - then - -- For an OUT variable using an out conversion, don't - -- associate with the actual, create a temporary value. - Val := Create_Value_For_Type - (Out_Block, Get_Type (Formal), True); + if Mode = Iir_Out_Mode then + if Get_Out_Conversion (Assoc) /= Null_Iir then + -- For an OUT variable using an out conversion, don't + -- associate with the actual, create a temporary value. + Val := Create_Value_For_Type + (Out_Block, Get_Type (Formal), True); + elsif Get_Kind (Get_Type (Formal)) in + Iir_Kinds_Scalar_Type_Definition + then + -- These are passed by value. Must be reset. + Val := Create_Value_For_Type + (Out_Block, Get_Type (Formal), True); + end if; else if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression @@ -2960,9 +3002,12 @@ package body Execution is end if; end if; - Implicit_Array_Conversion - (Subprg_Block, Val, Get_Type (Formal), Assoc); + -- FIXME: check constraints ? end if; + + Implicit_Array_Conversion + (Subprg_Block, Val, Get_Type (Formal), Assoc); + when others => Error_Kind ("execute_association(2)", Inter); end case; @@ -3010,7 +3055,7 @@ package body Execution is Formal : Iir; Assoc_Idx : Iir_Index32; begin - Proc := Get_Procedure_Call (Instance.Parent.Cur_Stmt); + Proc := Get_Procedure_Call (Instance.Parent.Stmt); Assoc := Get_Parameter_Association_Chain (Proc); Assoc_Idx := 1; while Assoc /= Null_Iir loop @@ -3761,7 +3806,7 @@ package body Execution is procedure Execute_For_Loop_Statement (Proc : Process_State_Acc) is Instance : constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir_For_Loop_Statement := Instance.Cur_Stmt; + Stmt : constant Iir_For_Loop_Statement := Instance.Stmt; Bounds : Iir_Value_Literal_Acc; Iterator : Iir; Index : Iir_Value_Literal_Acc; @@ -3793,7 +3838,7 @@ package body Execution is Finalize_For_Loop_Statement (Instance, Stmt); Update_Next_Statement (Proc); else - Instance.Cur_Stmt := Stmt_Chain; + Instance.Stmt := Stmt_Chain; end if; end if; end Execute_For_Loop_Statement; @@ -3804,7 +3849,7 @@ package body Execution is function Finish_For_Loop_Statement (Instance : Block_Instance_Acc) return Boolean is - Iterator : constant Iir := Get_Iterator_Scheme (Instance.Cur_Stmt); + Iterator : constant Iir := Get_Iterator_Scheme (Instance.Stmt); Bounds : Iir_Value_Literal_Acc; Index : Iir_Value_Literal_Acc; Marker : Mark_Type; @@ -3817,7 +3862,7 @@ package body Execution is if Is_Equal (Index, Bounds.Right) then -- Loop is complete. Release (Marker, Expr_Pool); - Finalize_For_Loop_Statement (Instance, Instance.Cur_Stmt); + Finalize_For_Loop_Statement (Instance, Instance.Stmt); return False; else -- Update the loop index. @@ -3826,8 +3871,7 @@ package body Execution is Release (Marker, Expr_Pool); -- start the loop again. - Instance.Cur_Stmt := - Get_Sequential_Statement_Chain (Instance.Cur_Stmt); + Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt); return True; end if; end Finish_For_Loop_Statement; @@ -3856,7 +3900,7 @@ package body Execution is procedure Execute_While_Loop_Statement (Proc : Process_State_Acc) is Instance: constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir := Instance.Cur_Stmt; + Stmt : constant Iir := Instance.Stmt; Cond : Boolean; begin Cond := Execute_Condition (Instance, Get_Condition (Stmt)); @@ -3875,12 +3919,11 @@ package body Execution is is Cond : Boolean; begin - Cond := Execute_Condition (Instance, Get_Condition (Instance.Cur_Stmt)); + Cond := Execute_Condition (Instance, Get_Condition (Instance.Stmt)); if Cond then -- start the loop again. - Instance.Cur_Stmt := - Get_Sequential_Statement_Chain (Instance.Cur_Stmt); + Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt); return True; else -- Loop is complete. @@ -3892,7 +3935,7 @@ package body Execution is function Finish_Loop_Statement (Instance : Block_Instance_Acc; Stmt : Iir) return Boolean is begin - Instance.Cur_Stmt := Stmt; + Instance.Stmt := Stmt; case Get_Kind (Stmt) is when Iir_Kind_While_Loop_Statement => return Finish_While_Loop_Statement (Instance); @@ -3909,7 +3952,7 @@ package body Execution is Is_Exit : Boolean) is Instance : constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir := Instance.Cur_Stmt; + Stmt : constant Iir := Instance.Stmt; Label : constant Iir := Get_Loop (Stmt); Cond : Boolean; Parent : Iir; @@ -3930,7 +3973,7 @@ package body Execution is -- Target is this statement. if Is_Exit then Finalize_Loop_Statement (Instance, Parent); - Instance.Cur_Stmt := Parent; + Instance.Stmt := Parent; Update_Next_Statement (Proc); elsif not Finish_Loop_Statement (Instance, Parent) then Update_Next_Statement (Proc); @@ -3950,7 +3993,7 @@ package body Execution is procedure Execute_Case_Statement (Proc : Process_State_Acc) is Instance : constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir := Instance.Cur_Stmt; + Stmt : constant Iir := Instance.Stmt; Value: Iir_Value_Literal_Acc; Assoc: Iir; Stmt_Chain : Iir; @@ -3970,7 +4013,7 @@ package body Execution is if Stmt_Chain = Null_Iir then Update_Next_Statement (Proc); else - Instance.Cur_Stmt := Stmt_Chain; + Instance.Stmt := Stmt_Chain; end if; Release (Marker, Expr_Pool); return; @@ -3986,7 +4029,7 @@ package body Execution is procedure Execute_Call_Statement (Proc : Process_State_Acc) is Instance : constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir := Instance.Cur_Stmt; + Stmt : constant Iir := Instance.Stmt; Call : constant Iir := Get_Procedure_Call (Stmt); Imp : constant Iir := Get_Implementation (Call); Subprg_Instance : Block_Instance_Acc; @@ -4094,7 +4137,7 @@ package body Execution is is Res : Iir_Value_Literal_Acc; Instance : constant Block_Instance_Acc := Proc.Instance; - Stmt : constant Iir := Instance.Cur_Stmt; + Stmt : constant Iir := Instance.Stmt; Expr : constant Iir := Get_Expression (Stmt); begin if Expr /= Null_Iir then @@ -4104,7 +4147,7 @@ package body Execution is Instance.Result := Res; end if; - case Get_Kind (Instance.Name) is + case Get_Kind (Instance.Label) is when Iir_Kind_Procedure_Declaration => Finish_Procedure_Frame (Proc); Update_Next_Statement (Proc); @@ -4124,7 +4167,7 @@ package body Execution is begin Stmt := Complex_Stmt; loop - Instance.Cur_Stmt := Stmt; + Instance.Stmt := Stmt; case Get_Kind (Stmt) is when Iir_Kind_For_Loop_Statement => if Finish_For_Loop_Statement (Instance) then @@ -4138,11 +4181,11 @@ package body Execution is | Iir_Kind_If_Statement => null; when Iir_Kind_Sensitized_Process_Statement => - Instance.Cur_Stmt := Null_Iir; + Instance.Stmt := Null_Iir; return; when Iir_Kind_Process_Statement => -- Start again. - Instance.Cur_Stmt := Get_Sequential_Statement_Chain (Stmt); + Instance.Stmt := Get_Sequential_Statement_Chain (Stmt); return; when Iir_Kind_Procedure_Body => Finish_Procedure_Frame (Proc); @@ -4152,12 +4195,12 @@ package body Execution is when others => Error_Kind ("execute_next_statement", Stmt); end case; - Stmt := Get_Chain (Instance.Cur_Stmt); + Stmt := Get_Chain (Instance.Stmt); if Stmt /= Null_Iir then - Instance.Cur_Stmt := Stmt; + Instance.Stmt := Stmt; return; end if; - Stmt := Get_Parent (Instance.Cur_Stmt); + Stmt := Get_Parent (Instance.Stmt); end loop; end Finish_Sequential_Statements; @@ -4168,7 +4211,7 @@ package body Execution is begin Stmt := Get_Sequential_Statement_Chain (Complex_Stmt); if Stmt /= Null_Iir then - Proc.Instance.Cur_Stmt := Stmt; + Proc.Instance.Stmt := Stmt; else Finish_Sequential_Statements (Proc, Complex_Stmt); end if; @@ -4179,12 +4222,12 @@ package body Execution is Instance : constant Block_Instance_Acc := Proc.Instance; Stmt : Iir; begin - Stmt := Get_Chain (Instance.Cur_Stmt); + Stmt := Get_Chain (Instance.Stmt); if Stmt /= Null_Iir then - Instance.Cur_Stmt := Stmt; + Instance.Stmt := Stmt; return; end if; - Finish_Sequential_Statements (Proc, Get_Parent (Instance.Cur_Stmt)); + Finish_Sequential_Statements (Proc, Get_Parent (Instance.Stmt)); end Update_Next_Statement; procedure Execute_Sequential_Statements (Proc : Process_State_Acc) @@ -4194,7 +4237,7 @@ package body Execution is begin loop Instance := Proc.Instance; - Stmt := Instance.Cur_Stmt; + Stmt := Instance.Stmt; -- End of process or subprogram. exit when Stmt = Null_Iir; diff --git a/simulate/execution.ads b/simulate/execution.ads index 79afd9c..e6ccd1e 100644 --- a/simulate/execution.ads +++ b/simulate/execution.ads @@ -177,4 +177,7 @@ package Execution is 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; end Execution; diff --git a/simulate/iir_values.adb b/simulate/iir_values.adb index 397875f..5e42f37 100644 --- a/simulate/iir_values.adb +++ b/simulate/iir_values.adb @@ -1028,7 +1028,7 @@ package body Iir_Values is when Iir_Value_Quantity => Put ("[quantity]"); when Iir_Value_Terminal => - Put ("[quantity]"); + Put ("[terminal]"); when Iir_Value_Signal => Put ("[signal]"); when Iir_Value_Protected => diff --git a/simulate/simulation.adb b/simulate/simulation.adb index 446d68a..3e04e38 100644 --- a/simulate/simulation.adb +++ b/simulate/simulation.adb @@ -132,8 +132,13 @@ package body Simulation is type Read_Signal_Value_Enum is (Read_Signal_Last_Value, + + -- For conversion functions. Read_Signal_Driving_Value, - Read_Signal_Effective_Value); + Read_Signal_Effective_Value, + + -- 'Driving_Value + Read_Signal_Driver_Value); function Execute_Read_Signal_Value (Sig: Iir_Value_Literal_Acc; Attr : Read_Signal_Value_Enum) @@ -161,12 +166,33 @@ package body Simulation is when Read_Signal_Last_Value => return Value_To_Iir_Value (Sig.Sig.Mode, Sig.Sig.Last_Value); - when Read_Signal_Driving_Value => - return Value_To_Iir_Value - (Sig.Sig.Mode, Sig.Sig.Driving_Value); + when Read_Signal_Driver_Value => + case Sig.Sig.Mode is + when Mode_F64 => + return Create_F64_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_F64 + (Sig.Sig)); + when Mode_I64 => + return Create_I64_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_I64 + (Sig.Sig)); + when Mode_E32 => + return Create_E32_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_E32 + (Sig.Sig)); + when Mode_B2 => + return Create_B2_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_B2 + (Sig.Sig)); + when others => + raise Internal_Error; + end case; when Read_Signal_Effective_Value => return Value_To_Iir_Value (Sig.Sig.Mode, Sig.Sig.Value); + when Read_Signal_Driving_Value => + return Value_To_Iir_Value + (Sig.Sig.Mode, Sig.Sig.Driving_Value); end case; when others => raise Internal_Error; @@ -218,7 +244,7 @@ package body Simulation is function Execute_Driving_Value_Attribute (Indirect: Iir_Value_Literal_Acc) return Iir_Value_Literal_Acc is begin - return Execute_Read_Signal_Value (Indirect, Read_Signal_Driving_Value); + return Execute_Read_Signal_Value (Indirect, Read_Signal_Driver_Value); end Execute_Driving_Value_Attribute; type Signal_Read_Last_Type is @@ -597,8 +623,8 @@ package body Simulation is if Process.Instance.In_Wait_Flag then raise Internal_Error; end if; - if Process.Instance.Cur_Stmt = Null_Iir then - Process.Instance.Cur_Stmt := + if Process.Instance.Stmt = Null_Iir then + Process.Instance.Stmt := Get_Sequential_Statement_Chain (Process.Proc); end if; when Iir_Kind_Process_Statement => @@ -888,10 +914,10 @@ package body Simulation is for I in Processes_Table.First .. Processes_Table.Last loop Instance := Processes_Table.Table (I); - El := Instance.Name; + El := Instance.Label; Instance_Pool := Processes_State (I).Pool'Access; - Instance.Cur_Stmt := Get_Sequential_Statement_Chain (El); + Instance.Stmt := Get_Sequential_Statement_Chain (El); Processes_State (I).Top_Instance := Instance; Processes_State (I).Proc := El; @@ -1555,69 +1581,6 @@ package body Simulation is end loop; end Create_Signals; - procedure Disp_Design_Stats - is - Proc : Iir; - Stmt : Iir; - Nbr_User_Sensitized_Processes : Natural := 0; - Nbr_User_If_Sensitized_Processes : Natural := 0; - Nbr_Conc_Sensitized_Processes : Natural := 0; - Nbr_User_Non_Sensitized_Processes : Natural := 0; - Nbr_Conc_Non_Sensitized_Processes : Natural := 0; - begin - for I in Processes_Table.First .. Processes_Table.Last loop - Proc := Processes_Table.Table (I).Name; - case Get_Kind (Proc) is - when Iir_Kind_Sensitized_Process_Statement => - if Get_Process_Origin (Proc) = Null_Iir then - Stmt := Get_Sequential_Statement_Chain (Proc); - if Stmt /= Null_Iir - and then Get_Kind (Stmt) = Iir_Kind_If_Statement - and then Get_Chain (Stmt) = Null_Iir - then - Nbr_User_If_Sensitized_Processes := - Nbr_User_If_Sensitized_Processes + 1; - else - Nbr_User_Sensitized_Processes := - Nbr_User_Sensitized_Processes + 1; - end if; - else - Nbr_Conc_Sensitized_Processes := - Nbr_Conc_Sensitized_Processes + 1; - end if; - when Iir_Kind_Process_Statement => - if Get_Process_Origin (Proc) = Null_Iir then - Nbr_User_Non_Sensitized_Processes := - Nbr_User_Non_Sensitized_Processes + 1; - else - Nbr_Conc_Non_Sensitized_Processes := - Nbr_Conc_Non_Sensitized_Processes + 1; - end if; - when others => - raise Internal_Error; - end case; - end loop; - - Put (Natural'Image (Nbr_User_If_Sensitized_Processes)); - Put_Line (" user sensitized processes with only a if stmt"); - Put (Natural'Image (Nbr_User_Sensitized_Processes)); - Put_Line (" user sensitized processes (others)"); - Put (Natural'Image (Nbr_User_Non_Sensitized_Processes)); - Put_Line (" user non sensitized processes"); - Put (Natural'Image (Nbr_Conc_Sensitized_Processes)); - Put_Line (" sensitized concurrent statements"); - Put (Natural'Image (Nbr_Conc_Non_Sensitized_Processes)); - Put_Line (" non sensitized concurrent statements"); - Put (Process_Index_Type'Image (Processes_Table.Last)); - Put_Line (" processes (total)"); - - Put (Integer'Image (Signals_Table.Last)); - Put_Line (" signals"); - - Put (Integer'Image (Connect_Table.Last)); - Put_Line (" connections"); - end Disp_Design_Stats; - procedure Ghdl_Elaborate is Entity: Iir_Entity_Declaration; |