diff options
Diffstat (limited to 'simulate/debugger.adb')
| -rw-r--r-- | simulate/debugger.adb | 378 |
1 files changed, 295 insertions, 83 deletions
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); |