aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/simulate/simul-debugger.adb192
-rw-r--r--src/vhdl/simulate/simul-environments.adb36
-rw-r--r--src/vhdl/simulate/simul-environments.ads6
3 files changed, 173 insertions, 61 deletions
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);
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-30 09:01:49 +0000