From 0836f191563eae6cd5ada9dbc2b8a871a522bc5c Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 18 Dec 2017 19:16:46 +0100 Subject: simul-debugger: improve info signals. --- src/grt/grt-disp_signals.adb | 29 +++-- src/grt/grt-disp_signals.ads | 3 + src/vhdl/simulate/simul-debugger.adb | 192 +++++++++++++++++++++++-------- src/vhdl/simulate/simul-environments.adb | 36 +++--- src/vhdl/simulate/simul-environments.ads | 6 +- 5 files changed, 196 insertions(+), 70 deletions(-) (limited to 'src') diff --git a/src/grt/grt-disp_signals.adb b/src/grt/grt-disp_signals.adb index f2e86572c..e4dadc578 100644 --- a/src/grt/grt-disp_signals.adb +++ b/src/grt/grt-disp_signals.adb @@ -96,6 +96,12 @@ package body Grt.Disp_Signals is Blk : Ghdl_Rtin_Block_Acc; Nctxt : Rti_Context; begin + -- Avoid fault. + if Ctxt = Null_Context then + Put ('?'); + return; + end if; + Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block); case Blk.Common.Kind is when Ghdl_Rtik_Block @@ -159,15 +165,8 @@ package body Grt.Disp_Signals is end loop; end Disp_Transaction; - procedure Disp_Simple_Signal - (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean) - is - function To_Address is new Ada.Unchecked_Conversion - (Source => Resolved_Signal_Acc, Target => Address); + procedure Disp_Single_Signal_Attributes (Sig : Ghdl_Signal_Ptr) is begin - Put (' '); - Put (stdout, Sig.all'Address); - Put (' '); Disp_Mode (Sig.Mode); Put (' '); if Sig.Active then @@ -196,6 +195,18 @@ package body Grt.Disp_Signals is Put (" last_active="); Put_Time (stdout, Sig.Last_Active); end if; + end Disp_Single_Signal_Attributes; + + procedure Disp_Simple_Signal + (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean) + is + function To_Address is new Ada.Unchecked_Conversion + (Source => Resolved_Signal_Acc, Target => Address); + begin + Put (' '); + Put (stdout, Sig.all'Address); + Put (' '); + Disp_Single_Signal_Attributes (Sig); Put (" val="); declare Val : constant Value_Union := Read_Value (Sig.Value_Ptr, Sig.Mode); @@ -221,7 +232,7 @@ package body Grt.Disp_Signals is case Sig.S.Mode_Sig is when Mode_Signal_User => if Sig.S.Resolv /= null then - Put (stdout, " res func "); + Put (stdout, " resolver="); Put (stdout, To_Address(Sig.S.Resolv)); end if; if Sig.S.Nbr_Drivers = 0 then diff --git a/src/grt/grt-disp_signals.ads b/src/grt/grt-disp_signals.ads index 73bd60d06..82905d5b8 100644 --- a/src/grt/grt-disp_signals.ads +++ b/src/grt/grt-disp_signals.ads @@ -37,6 +37,9 @@ package Grt.Disp_Signals is procedure Disp_Mode_Signal (Mode : Mode_Signal_Type); + -- Disp attributes of SIG. + procedure Disp_Single_Signal_Attributes (Sig : Ghdl_Signal_Ptr); + -- Disp informations on signal SIG. -- To be used inside the debugger. procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr); diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb index 80c8f7baa..4ddf1130c 100644 --- a/src/vhdl/simulate/simul-debugger.adb +++ b/src/vhdl/simulate/simul-debugger.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with System; -with Ada.Text_IO; use Ada.Text_IO; +-- with Ada.Text_IO; use Ada.Text_IO; with Tables; with Types; use Types; with Name_Table; @@ -34,18 +34,22 @@ with Libraries; with Std_Package; with Simul.Annotations; use Simul.Annotations; with Simul.Elaboration; use Simul.Elaboration; +with Simul.Execution; use Simul.Execution; with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; with Disp_Vhdl; -with Simul.Execution; use Simul.Execution; with Iirs_Walk; use Iirs_Walk; with Areapools; use Areapools; +with Grt.Types; use Grt.Types; with Grt.Disp; with Grt.Readline; with Grt.Errors; with Grt.Disp_Signals; +with Grt.Signals; use Grt.Signals; with Grt.Processes; with Grt.Options; +with Grt.Stdio; use Grt.Stdio; +with Grt.Astdio; use Grt.Astdio; package body Simul.Debugger is -- This exception can be raised by a debugger command to directly return @@ -126,26 +130,26 @@ package body Simul.Debugger is procedure Disp_Iir_Location (N : Iir) is begin if N = Null_Iir then - Put (Standard_Error, "??:??:??"); + Put (stderr, "??:??:??"); else - Put (Standard_Error, Disp_Location (N)); + Put (stderr, Disp_Location (N)); end if; - Put (Standard_Error, ": "); + Put (stderr, ": "); end Disp_Iir_Location; -- Disp a message during execution. procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is begin Disp_Iir_Location (Loc); - Put_Line (Standard_Error, Msg); + Put_Line (stderr, Msg); Grt.Errors.Fatal_Error; end Error_Msg_Exec; procedure Warning_Msg_Exec (Msg: String; Loc: Iir) is begin Disp_Iir_Location (Loc); - Put (Standard_Error, "warning: "); - Put_Line (Standard_Error, Msg); + Put (stderr, "warning: "); + Put_Line (stderr, Msg); end Warning_Msg_Exec; -- Disp a message for a constraint error. @@ -154,20 +158,20 @@ package body Simul.Debugger is if Expr /= Null_Iir then Disp_Iir_Location (Expr); end if; - Put (Standard_Error, "constraint violation"); + Put (stderr, "constraint violation"); if Expr /= Null_Iir then case Get_Kind (Expr) is when Iir_Kind_Addition_Operator => - Put_Line (Standard_Error, " in the ""+"" operation"); + Put_Line (stderr, " in the ""+"" operation"); when Iir_Kind_Substraction_Operator => - Put_Line (Standard_Error, " in the ""-"" operation"); + Put_Line (stderr, " in the ""-"" operation"); when Iir_Kind_Integer_Literal => - Put_Line (Standard_Error, ", literal out of range"); + Put_Line (stderr, ", literal out of range"); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration => - Put_Line (Standard_Error, " for " & Disp_Node (Expr)); + Put_Line (stderr, " for " & Disp_Node (Expr)); when others => - New_Line (Standard_Error); + New_Line (stderr); end case; end if; Grt.Errors.Fatal_Error; @@ -364,6 +368,54 @@ package body Simul.Debugger is Put (")"); end Disp_Signal_Record; + procedure Disp_Signal_Value + (Val : Value_Union; Mode : Mode_Type; Sig_Type : Iir) is + begin + case Mode is + when Mode_I64 => + Put (Ghdl_I64'Image (Val.I64)); + when Mode_I32 => + Put (Ghdl_I32'Image (Val.I32)); + when Mode_F64 => + Put (Ghdl_F64'Image (Val.F64)); + when Mode_E32 => + Disp_Iir_Value_Enum (Ghdl_E32'Pos (Val.E32), Sig_Type); + when Mode_E8 => + Disp_Iir_Value_Enum (Ghdl_E8'Pos (Val.E8), Sig_Type); + when Mode_B1 => + Disp_Iir_Value_Enum (Ghdl_B1'Pos (Val.B1), Sig_Type); + end case; + end Disp_Signal_Value; + + procedure Disp_Transaction + (Head : Transaction_Acc; Mode : Mode_Type; Sig_Type : Iir) + is + Trans : Transaction_Acc; + begin + Trans := Head; + loop + case Trans.Kind is + when Trans_Value => + Disp_Signal_Value (Trans.Val, Mode, Sig_Type); + when Trans_Direct => + Disp_Signal_Value (Trans.Val_Ptr.all, Mode, Sig_Type); + when Trans_Null => + Put ("NULL"); + when Trans_Error => + Put ("ERROR"); + end case; + if Trans.Kind = Trans_Direct then + Put ("[DIRECT]"); + else + Put ("@"); + Put_Time (stdout, Trans.Time); + end if; + Trans := Trans.Next; + exit when Trans = null; + Put (", "); + end loop; + end Disp_Transaction; + procedure Disp_Signal (Value : Iir_Value_Literal_Acc; A_Type : Iir) is begin if Value = null then @@ -382,7 +434,21 @@ package body Simul.Debugger is -- FIXME. raise Internal_Error; when Iir_Value_Signal => - Grt.Disp_Signals.Disp_A_Signal (Value.Sig); + declare + Sig : constant Ghdl_Signal_Ptr := Value.Sig; + begin + Disp_Signal_Value (Sig.Value_Ptr.all, Sig.Mode, A_Type); + Grt.Disp_Signals.Disp_Single_Signal_Attributes (Value.Sig); + New_Line; + if Sig.S.Mode_Sig in Mode_Signal_User then + for I in 1 .. Sig.S.Nbr_Drivers loop + Put (" "); + Disp_Transaction (Sig.S.Drivers (I - 1).First_Trans, + Sig.Mode, A_Type); + New_Line; + end loop; + end if; + end; when Iir_Value_File | Iir_Value_Protected | Iir_Value_Quantity @@ -437,12 +503,21 @@ package body Simul.Debugger is (Instance, Get_Port_Chain (Ent)); Disp_Instance_Signals_Of_Chain (Instance, Get_Declaration_Chain (Ent)); + Disp_Instance_Signals_Of_Chain + (Instance, Get_Declaration_Chain (Blk)); end; when Iir_Kind_Block_Statement => Disp_Instance_Name (Instance); Put_Line (" [block]:"); - -- FIXME: ports. + declare + Header : constant Iir := Get_Block_Header (Blk); + begin + if Header /= Null_Iir then + Disp_Instance_Signals_Of_Chain + (Instance, Get_Port_Chain (Header)); + end if; + end; Disp_Instance_Signals_Of_Chain (Instance, Get_Declaration_Chain (Blk)); @@ -639,7 +714,6 @@ package body Simul.Debugger is procedure Disp_Signals_Stats is - use Grt.Types; type Counters_Type is array (Mode_Signal_Type) of Natural; Counters : Counters_Type := (others => 0); Nbr_User_Signals : Natural := 0; @@ -1563,32 +1637,61 @@ package body Simul.Debugger is end case; end Disp_Declared_Signals; - procedure Info_Signals_Proc (Line : String) is - pragma Unreferenced (Line); + procedure Info_Signals_Proc (Line : String) + is + Verbose : Boolean; + P : Natural; + E : Natural; begin - if False then - Check_Current_Process; - Disp_Declared_Signals - (Current_Process.Proc, Current_Process.Top_Instance); - elsif True then - for I in Signals_Table.First .. Signals_Table.Last loop - declare - S : Signal_Entry renames Signals_Table.Table (I); - begin - Disp_Instance_Name (S.Instance, False); - Put ('.'); - if S.Kind in Grt.Types.Mode_Signal_User then - Put (Name_Table.Image (Get_Identifier (S.Decl))); - Disp_Value (S.Sig); - Disp_Value (S.Val); - else - Disp_Declaration_Object (S.Instance, S.Decl); + Verbose := False; + + P := Skip_Blanks (Line); + loop + E := Get_Word (Line (P .. Line'Last)); + exit when P > Line'Last; + if Line (P .. E) = "-v" then + Verbose := True; + elsif Line (P .. E) = "-l" then + -- Local signals + Check_Current_Process; + Disp_Declared_Signals + (Current_Process.Proc, Current_Process.Top_Instance); + return; + elsif Line (P .. E) = "-t" then + Disp_Signals_Value; + return; + elsif Line (P .. E) = "-T" then + Grt.Disp_Signals.Disp_Signals_Table; + return; + else + Put_Line ("options: -v(erbose) -l(ocal) -t(ree) -T(able)"); + return; + end if; + P := E + 1; + end loop; + + for I in Signals_Table.First .. Signals_Table.Last loop + declare + S : Signal_Entry renames Signals_Table.Table (I); + begin + Disp_Instance_Name (S.Instance, False); + Put ('.'); + if S.Kind in Grt.Types.Mode_Signal_User then + Put (Name_Table.Image (Get_Identifier (S.Decl))); + New_Line; + Put (" sig: "); + Disp_Value (S.Sig); + Put (" val: "); + Disp_Value (S.Val); + if Verbose then + -- Dummy to keep compiler happy. + Verbose := False; end if; - end; - end loop; - else - Disp_Signals_Value; - end if; + else + Disp_Declaration_Object (S.Instance, S.Decl); + end if; + end; + end loop; end Info_Signals_Proc; type Handle_Scope_Type is access procedure (N : Iir); @@ -1874,7 +1977,6 @@ package body Simul.Debugger is procedure Run_Proc (Line : String) is - use Grt.Types; Delta_Time : Std_Time; P : Positive; begin @@ -2181,7 +2283,7 @@ package body Simul.Debugger is end Breakpoint_Hit; Prompt_Debug : constant String := "debug> " & ASCII.NUL; - Prompt_Crash : constant String := "crash> " & ASCII.NUL; + Prompt_Error : constant String := "error> " & ASCII.NUL; Prompt_Init : constant String := "init> " & ASCII.NUL; Prompt_Elab : constant String := "elab> " & ASCII.NUL; @@ -2263,11 +2365,11 @@ package body Simul.Debugger is end; when Reason_Assert => Set_Top_Frame (Current_Process.Instance); - Prompt := Prompt_Crash'Address; + Prompt := Prompt_Error'Address; Put_Line ("assertion failure, enterring in debugger"); when Reason_Error => Set_Top_Frame (Current_Process.Instance); - Prompt := Prompt_Crash'Address; + Prompt := Prompt_Error'Address; Put_Line ("error occurred, enterring in debugger"); end case; diff --git a/src/vhdl/simulate/simul-environments.adb b/src/vhdl/simulate/simul-environments.adb index 4e8622da3..662fd1729 100644 --- a/src/vhdl/simulate/simul-environments.adb +++ b/src/vhdl/simulate/simul-environments.adb @@ -18,6 +18,7 @@ with System; with Ada.Unchecked_Conversion; +with Ada.Text_IO; with GNAT.Debug_Utilities; with Name_Table; with Simul.Debugger; use Simul.Debugger; @@ -808,13 +809,20 @@ package body Simul.Environments is end case; end Get_Enum_Pos; + procedure Put_Indent (Indent : Natural) + is + use Ada.Text_IO; + begin + Put ((1 .. 2 * Indent => ' ')); + end Put_Indent; + procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc; - Tab: Ada.Text_IO.Count) + Indent : Natural) is use Ada.Text_IO; use GNAT.Debug_Utilities; begin - Set_Col (Tab); + Put_Indent (Indent); if Value = null then Put_Line ("*NULL*"); return; @@ -851,51 +859,51 @@ package body Simul.Environments is Put_Line ("array, length: " & Iir_Index32'Image (Value.Val_Array.Len)); declare - Ntab: constant Count := Tab + Indentation; + Nindent: constant Natural := Indent + 1; begin - Set_Col (Ntab); + Put_Indent (Nindent); if Value.Bounds /= null then Put_Line ("bounds 1 .." & Iir_Index32'Image (Value.Bounds.Nbr_Dims) & ':'); for I in Value.Bounds.D'Range loop - Disp_Value_Tab (Value.Bounds.D (I), Ntab); + Disp_Value_Tab (Value.Bounds.D (I), Nindent); end loop; else Put_Line ("bounds = null"); end if; - Set_Col (Ntab); + Put_Indent (Nindent); Put_Line ("values 1 .." & Iir_Index32'Image (Value.Val_Array.Len) & ':'); for I in Value.Val_Array.V'Range loop - Disp_Value_Tab (Value.Val_Array.V (I), Ntab); + Disp_Value_Tab (Value.Val_Array.V (I), Nindent); end loop; end; end if; when Iir_Value_Range => Put_Line ("range:"); - Set_Col (Tab); + Put_Indent (Indent); Put (" direction: "); Put (Iir_Direction'Image (Value.Dir)); Put (", length:"); Put_Line (Iir_Index32'Image (Value.Length)); if Value.Left /= null then - Set_Col (Tab); + Put_Indent (Indent); Put (" left bound: "); - Disp_Value_Tab (Value.Left, Col); + Disp_Value_Tab (Value.Left, 0); end if; if Value.Right /= null then - Set_Col (Tab); + Put_Indent (Indent); Put (" right bound: "); - Disp_Value_Tab (Value.Right, Col); + Disp_Value_Tab (Value.Right, 0); end if; when Iir_Value_Record => Put_Line ("record:"); for I in Value.Val_Record.V'Range loop - Disp_Value_Tab (Value.Val_Record.V (I), Tab + Indentation); + Disp_Value_Tab (Value.Val_Record.V (I), Indent + 1); end loop; when Iir_Value_Signal => Put ("signal: "); @@ -920,7 +928,7 @@ package body Simul.Environments is procedure Disp_Value (Value: Iir_Value_Literal_Acc) is begin - Disp_Value_Tab (Value, 1); + Disp_Value_Tab (Value, 0); end Disp_Value; -- Return TRUE if VALUE has an indirect value. diff --git a/src/vhdl/simulate/simul-environments.ads b/src/vhdl/simulate/simul-environments.ads index a451ff5a7..f8104e096 100644 --- a/src/vhdl/simulate/simul-environments.ads +++ b/src/vhdl/simulate/simul-environments.ads @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Ada.Text_IO; with Ada.Unchecked_Deallocation; with Types; use Types; with Iirs; use Iirs; @@ -520,7 +519,10 @@ package Simul.Environments is -- Disp a value_literal in raw form. procedure Disp_Value (Value: Iir_Value_Literal_Acc); procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc; - Tab: Ada.Text_IO.Count); + Indent : Natural); + + -- Disp literal of an enumerated type. + procedure Disp_Iir_Value_Enum (Pos : Natural; A_Type : Iir); -- Disp a value_literal in readable form. procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir); -- cgit v1.2.3